mirror of https://github.com/hsoft/collapseos.git
forth: add support for IMMEDIATE words
This commit is contained in:
Virgil Dupras
parent
03bd9ee39b
commit
0b3f6253e4
|
|
@ -243,34 +243,75 @@ DEFINE:
|
|||
; been compiled by INTERPRET*. All those bytes will be copied as-is.
|
||||
; All we need to do is to know how many bytes to copy. To do so, we
|
||||
; skip compwords until EXIT is reached.
|
||||
ld (HERE), hl ; where we write compwords.
|
||||
ex de, hl ; DE is our dest
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
.loop:
|
||||
call HLPointsEXIT
|
||||
jr z, .loopend
|
||||
call compSkip
|
||||
call HLPointsNUMBER
|
||||
jr nz, .notNUMBER
|
||||
; is number
|
||||
ld bc, 4
|
||||
ldir
|
||||
jr .loop
|
||||
.loopend:
|
||||
; At this point, HL points to EXIT compword. We'll copy it too.
|
||||
; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2
|
||||
ld e, (ix)
|
||||
ld d, (ix+1)
|
||||
inc hl \ inc hl ; our +2
|
||||
or a ; clear carry
|
||||
sbc hl, de
|
||||
ld b, h
|
||||
ld c, l
|
||||
; BC has proper count
|
||||
ex de, hl ; HL is our source (old RS' TOS)
|
||||
ld de, (HERE) ; and DE is our dest
|
||||
ldir ; go!
|
||||
.notNUMBER:
|
||||
call HLPointsLIT
|
||||
jr nz, .notLIT
|
||||
; is lit
|
||||
ldi
|
||||
ldi
|
||||
inc hl \ inc hl
|
||||
call strcpyM
|
||||
inc hl ; byte after word termination
|
||||
jr .loop
|
||||
.notLIT:
|
||||
; it's a word
|
||||
call HLPointsIMMED
|
||||
jr nz, .notIMMED
|
||||
; Immediate word, we'll have to call it.
|
||||
; Before we make our call, let's save our current HL/DE position
|
||||
ld (HERE), de
|
||||
ld e, (hl)
|
||||
inc hl
|
||||
ld d, (hl)
|
||||
inc hl ; point to next word
|
||||
push de \ pop iy ; prepare for executeCodeLink
|
||||
ld (ix), l
|
||||
ld (ix+1), h
|
||||
; Push return address
|
||||
ld hl, .retList
|
||||
call pushRS
|
||||
; Ready!
|
||||
jp executeCodeLink
|
||||
.notIMMED:
|
||||
; a good old regular word. We have 2 bytes to copy. But before we do,
|
||||
; let's check whether it's an EXIT. LDI doesn't affect Z, so we can
|
||||
; make our jump later.
|
||||
call HLPointsEXIT
|
||||
ldi
|
||||
ldi
|
||||
jr nz, .loop
|
||||
; HL has our new RS' TOS
|
||||
ld (ix), l
|
||||
ld (ix+1), h
|
||||
ld (HERE), de ; update HERE
|
||||
jp exit
|
||||
|
||||
; This label is pushed to RS when an IMMED word is called. When that word calls
|
||||
; exit, this is where it returns. When we return, RS will need to be popped so
|
||||
; that we stay on the proper RS level.
|
||||
.retList:
|
||||
.dw .retWord
|
||||
.retWord:
|
||||
.dw .retEntry
|
||||
.retEntry:
|
||||
call popRS ; unwind stack
|
||||
; recall old HL / DE values
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
ld de, (HERE)
|
||||
; continue!
|
||||
jr .loop
|
||||
|
||||
.db "DOES>"
|
||||
.fill 3
|
||||
.dw DEFINE
|
||||
|
|
@ -293,10 +334,43 @@ DOES:
|
|||
ld (HERE), iy
|
||||
jp exit
|
||||
|
||||
|
||||
.db "IMMEDIA"
|
||||
.db 0
|
||||
.dw DOES
|
||||
IMMEDIATE:
|
||||
.dw nativeWord
|
||||
ld hl, (CURRENT)
|
||||
dec hl
|
||||
dec hl
|
||||
dec hl
|
||||
inc (hl)
|
||||
jp exit
|
||||
|
||||
; ( n -- )
|
||||
.db "LITERAL"
|
||||
.db 1 ; IMMEDIATE
|
||||
.dw IMMEDIATE
|
||||
LITERAL:
|
||||
.dw nativeWord
|
||||
ld hl, (HERE)
|
||||
ld de, NUMBER
|
||||
ld (hl), e
|
||||
inc hl
|
||||
ld (hl), d
|
||||
inc hl
|
||||
pop de ; number from stack
|
||||
ld (hl), e
|
||||
inc hl
|
||||
ld (hl), d
|
||||
inc hl
|
||||
ld (HERE), hl
|
||||
jp exit
|
||||
|
||||
; ( -- c )
|
||||
.db "KEY"
|
||||
.fill 5
|
||||
.dw DOES
|
||||
.dw LITERAL
|
||||
KEY:
|
||||
.dw nativeWord
|
||||
call stdioGetC
|
||||
|
|
|
|||
|
|
@ -25,39 +25,49 @@ Atom: A word of the type compiledWord contains, in its PF, a list of what we
|
|||
call "atoms". Those atoms are most of the time word references, but they can
|
||||
also be references to NUMBER and LIT.
|
||||
|
||||
*** Native Words ***
|
||||
|
||||
*** Defining words ***
|
||||
: x ... -- Define a new word
|
||||
; R:I -- Exit a colon definition
|
||||
. n -- Print n in its decimal form
|
||||
ALLOT n -- Move HERE by n bytes
|
||||
CREATE x -- Create cell named x. Doesn't allocate a PF.
|
||||
CONSTANT x n -- Creates cell x that when called pushes its value
|
||||
DOES> -- See description at top of file
|
||||
IMMEDIATE -- Flag the latest defined word as immediate.
|
||||
LITERAL n -- Inserts number from TOS as a literal
|
||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||
|
||||
*** Flow ***
|
||||
ELSE -- Branch to THEN
|
||||
EXECUTE a -- Execute wordref at addr a
|
||||
IF n -- Branch to ELSE or THEN if n is zero
|
||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||
then execute the compiled contents.
|
||||
QUIT R:drop -- Return to interpreter promp immediately
|
||||
THEN -- Does nothing. Serves as a branching merker for IF
|
||||
and ELSE.
|
||||
|
||||
*** Stack ***
|
||||
DUP a -- a a
|
||||
OVER a b -- a b a
|
||||
SWAP a b -- b a
|
||||
|
||||
*** Memory ***
|
||||
@ a -- n Set n to value at address a
|
||||
! n a -- Store n in address a
|
||||
? a -- Print value of addr a
|
||||
+! n a -- Increase value of addr a by n
|
||||
CURRENT -- n Set n to wordref of last added entry.
|
||||
HERE -- a Push HERE's address
|
||||
|
||||
*** Arithmetic ***
|
||||
|
||||
+ a b -- c a + b -> c
|
||||
- a b -- c a - b -> c
|
||||
* a b -- c a * b -> c
|
||||
/ a b -- c a / b -> c
|
||||
CREATE x -- Create cell named x. Doesn't allocate a PF.
|
||||
CURRENT -- n Set n to wordref of last added entry.
|
||||
DOES> -- See description at top of file
|
||||
DUP a -- a a
|
||||
ELSE -- Branch to THEN
|
||||
|
||||
*** I/O ***
|
||||
. n -- Print n in its decimal form
|
||||
EMIT c -- Spit char c to stdout
|
||||
EXECUTE a -- Execute wordref at addr a
|
||||
HERE -- a Push HERE's address
|
||||
IF n -- Branch to ELSE or THEN if n is zero
|
||||
QUIT R:drop -- Return to interpreter promp immediately
|
||||
KEY -- c Get char c from stdin
|
||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||
then execute the compiled contents.
|
||||
OVER a b -- a b a
|
||||
SWAP a b -- b a
|
||||
THEN -- Does nothing. Serves as a branching merker for IF
|
||||
and ELSE.
|
||||
|
||||
*** Core-but-Forth Words ***
|
||||
|
||||
? a -- Print value of addr a
|
||||
+! n a -- Increase value of addr a by n
|
||||
ALLOT n -- Move HERE by n bytes
|
||||
CONSTANT x n -- Creates cell x that when called pushes its value
|
||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||
|
|
|
|||
|
|
@ -274,3 +274,20 @@ entryhead:
|
|||
ld (HERE), hl
|
||||
xor a ; set Z
|
||||
ret
|
||||
|
||||
; Sets Z if wordref at (HL) is of the IMMEDIATE type
|
||||
HLPointsIMMED:
|
||||
push hl
|
||||
call intoHL
|
||||
dec hl
|
||||
dec hl
|
||||
dec hl
|
||||
; We need an invert flag. We want to Z to be set when flag is non-zero.
|
||||
ld a, 1
|
||||
and (hl)
|
||||
dec a ; if A was 1, Z is set. Otherwise, Z is unset
|
||||
inc hl
|
||||
inc hl
|
||||
inc hl
|
||||
pop hl
|
||||
ret
|
||||
|
|
|
|||
Loading…
Reference in New Issue