mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-30 20:18:06 +11:00
forth: make readCompWord read from RS' BOS instead of TOS
Previous approach was broken with regards to defined word using CREATE. Also, reduce name length by one to make space for a new flags field for "immediate" (which isn't used yet).
This commit is contained in:
Virgil Dupras
parent
0e8af3cea4
commit
03bd9ee39b
@ -1,5 +1,6 @@
|
||||
; A dictionary entry has this structure:
|
||||
; - 8b name (zero-padded)
|
||||
; - 7b name (zero-padded)
|
||||
; - 1b flags (bit 0: IMMEDIATE)
|
||||
; - 2b prev pointer
|
||||
; - 2b code pointer
|
||||
; - Parameter field (PF)
|
||||
@ -168,14 +169,16 @@ exit:
|
||||
jp compiledWord
|
||||
|
||||
; ( R:I -- )
|
||||
.db "QUIT", 0, 0, 0, 0
|
||||
.db "QUIT"
|
||||
.fill 4
|
||||
.dw EXIT
|
||||
QUIT:
|
||||
.dw nativeWord
|
||||
quit:
|
||||
jp forthRdLine
|
||||
|
||||
.db "ABORT", 0, 0, 0
|
||||
.db "ABORT"
|
||||
.fill 3
|
||||
.dw QUIT
|
||||
ABORT:
|
||||
.dw nativeWord
|
||||
@ -198,7 +201,8 @@ BYE:
|
||||
ret
|
||||
|
||||
; ( c -- )
|
||||
.db "EMIT", 0, 0, 0, 0
|
||||
.db "EMIT"
|
||||
.fill 4
|
||||
.dw BYE
|
||||
EMIT:
|
||||
.dw nativeWord
|
||||
@ -208,7 +212,8 @@ EMIT:
|
||||
jp exit
|
||||
|
||||
; ( addr -- )
|
||||
.db "EXECUTE", 0
|
||||
.db "EXECUTE"
|
||||
.db 0
|
||||
.dw EMIT
|
||||
EXECUTE:
|
||||
.dw nativeWord
|
||||
@ -239,19 +244,18 @@ DEFINE:
|
||||
; 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.
|
||||
; Let's save old RS TOS
|
||||
ld e, (ix)
|
||||
ld d, (ix+1)
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
.loop:
|
||||
call RSIsEXIT
|
||||
call HLPointsEXIT
|
||||
jr z, .loopend
|
||||
call compSkip
|
||||
jr .loop
|
||||
.loopend:
|
||||
; At this point, RS' TOS points to EXIT compword. We'll copy it too.
|
||||
; At this point, HL points to EXIT compword. We'll copy it too.
|
||||
; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
ld e, (ix)
|
||||
ld d, (ix+1)
|
||||
inc hl \ inc hl ; our +2
|
||||
or a ; clear carry
|
||||
sbc hl, de
|
||||
@ -267,7 +271,8 @@ DEFINE:
|
||||
ld (HERE), de ; update HERE
|
||||
jp exit
|
||||
|
||||
.db "DOES>", 0, 0, 0
|
||||
.db "DOES>"
|
||||
.fill 3
|
||||
.dw DEFINE
|
||||
DOES:
|
||||
.dw nativeWord
|
||||
@ -300,7 +305,8 @@ KEY:
|
||||
push hl
|
||||
jp exit
|
||||
|
||||
.db "INTERPRE"
|
||||
.db "INTERPR"
|
||||
.db 0
|
||||
.dw KEY
|
||||
INTERPRET:
|
||||
.dw nativeWord
|
||||
@ -317,7 +323,8 @@ interpret:
|
||||
ld iy, COMPBUF
|
||||
jp compiledWord
|
||||
|
||||
.db "CREATE", 0, 0
|
||||
.db "CREATE"
|
||||
.fill 2
|
||||
.dw INTERPRET
|
||||
CREATE:
|
||||
.dw nativeWord
|
||||
@ -338,7 +345,8 @@ HERE_: ; Caution: conflicts with actual variable name
|
||||
.dw sysvarWord
|
||||
.dw HERE
|
||||
|
||||
.db "CURRENT", 0
|
||||
.db "CURRENT"
|
||||
.db 0
|
||||
.dw HERE_
|
||||
CURRENT_:
|
||||
.dw sysvarWord
|
||||
@ -514,7 +522,8 @@ STOREINC:
|
||||
|
||||
; ( n -- )
|
||||
; HERE +!
|
||||
.db "ALLOT", 0, 0, 0
|
||||
.db "ALLOT"
|
||||
.fill 3
|
||||
.dw STOREINC
|
||||
ALLOT:
|
||||
.dw compiledWord
|
||||
@ -523,7 +532,8 @@ ALLOT:
|
||||
.dw EXIT
|
||||
|
||||
; CREATE 2 ALLOT
|
||||
.db "VARIABLE"
|
||||
.db "VARIABL"
|
||||
.db 0
|
||||
.dw ALLOT
|
||||
VARIABLE:
|
||||
.dw compiledWord
|
||||
@ -535,7 +545,8 @@ VARIABLE:
|
||||
|
||||
; ( n -- )
|
||||
; CREATE HERE @ ! DOES> @
|
||||
.db "CONSTANT"
|
||||
.db "CONSTAN"
|
||||
.db 0
|
||||
.dw VARIABLE
|
||||
CONSTANT:
|
||||
.dw compiledWord
|
||||
|
||||
@ -4,9 +4,9 @@
|
||||
; Number of bytes we keep as a padding between HERE and the scratchpad
|
||||
.equ PADDING 0x20
|
||||
; Max length of dict entry names
|
||||
.equ NAMELEN 8
|
||||
.equ NAMELEN 7
|
||||
; Offset of the code link relative to the beginning of the word
|
||||
.equ CODELINK_OFFSET NAMELEN+2
|
||||
.equ CODELINK_OFFSET NAMELEN+3
|
||||
|
||||
; *** Variables ***
|
||||
.equ INITIAL_SP FORTH_RAMSTART
|
||||
|
||||
@ -43,78 +43,78 @@ readword:
|
||||
inc a ; unset Z
|
||||
ret
|
||||
|
||||
RSIsDE:
|
||||
push hl
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
; Sets Z if (HL) == E and (HL+1) == D
|
||||
HLPointsDE:
|
||||
ld a, (hl)
|
||||
cp e
|
||||
jr nz, .end ; no
|
||||
ret nz ; no
|
||||
inc hl
|
||||
ld a, (hl)
|
||||
dec hl
|
||||
cp d ; Z has our answer
|
||||
.end:
|
||||
pop hl
|
||||
ret
|
||||
|
||||
|
||||
; Is RS' TOS pointing to a NUMBER word?
|
||||
; Z if yes, NZ if no.
|
||||
RSIsNUMBER:
|
||||
HLPointsNUMBER:
|
||||
push de
|
||||
ld de, NUMBER
|
||||
call RSIsDE
|
||||
call HLPointsDE
|
||||
pop de
|
||||
ret
|
||||
|
||||
; Is RS' TOS pointing to a LIT word?
|
||||
; Z if yes, NZ if no.
|
||||
RSIsLIT:
|
||||
HLPointsLIT:
|
||||
push de
|
||||
ld de, LIT
|
||||
call RSIsDE
|
||||
call HLPointsDE
|
||||
pop de
|
||||
ret
|
||||
|
||||
; Is RS' TOS pointing to EXIT?
|
||||
; Z if yes, NZ if no.
|
||||
RSIsEXIT:
|
||||
HLPointsEXIT:
|
||||
push de
|
||||
ld de, EXIT
|
||||
call RSIsDE
|
||||
call HLPointsDE
|
||||
pop de
|
||||
ret
|
||||
|
||||
; Skip the compword where RS' TOS is currently pointing. If it's a regular word,
|
||||
; Skip the compword where HL is currently pointing. If it's a regular word,
|
||||
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
|
||||
; to after null-termination.
|
||||
compSkip:
|
||||
push hl
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
; At the minimum, we skip by 2
|
||||
inc hl \ inc hl
|
||||
call RSIsNUMBER
|
||||
call HLPointsNUMBER
|
||||
jr z, .isNum
|
||||
call RSIsLIT
|
||||
jr nz, .end ; A word
|
||||
call HLPointsLIT
|
||||
jr nz, .isWord
|
||||
; We have a literal
|
||||
inc hl \ inc hl
|
||||
call strskip
|
||||
inc hl ; byte after word termination
|
||||
jr .end
|
||||
ret
|
||||
.isNum:
|
||||
; skip by 4
|
||||
inc hl \ inc hl
|
||||
.end:
|
||||
; HL is good, write it to RS
|
||||
ld (ix), l
|
||||
ld (ix+1), h
|
||||
pop hl
|
||||
; continue to isWord
|
||||
.isWord:
|
||||
; skip by 2
|
||||
inc hl \ inc hl
|
||||
ret
|
||||
|
||||
; Checks RS' TOS and, if it points to a string literal (LIT), makes HL point
|
||||
; to it and advance IP to byte following null-termination.
|
||||
; If it doesn't, things get interesting: If it's a word reference, then it's
|
||||
; The goal of this routine is to read a string literal following the currently
|
||||
; executed words. For example, CREATE and DEFINE need this. Things are a little
|
||||
; twisted, so bear with me while I explain how it works.
|
||||
;
|
||||
; When we call this routine, everything has been compiled. We're on an atom and
|
||||
; we're executing it. Now, we're looking for a string literal or a word-with-a
|
||||
; name that follows our readCompWord caller. We could think that this word is
|
||||
; right there on RS' TOS, but no! You have to account for words wrapping the
|
||||
; caller. For example, "VARIABLE" calls "CREATE". If you call "VARIABLE foo",
|
||||
; if CREATE looks at what follows in RS' TOS, it will only find the "2" in
|
||||
; "CREATE 2 ALLOT".
|
||||
;
|
||||
; Therefore, we actually need to check in RS' *bottom of stack* for our answer.
|
||||
; If that atom is a LIT, we're good. We make HL point to it and advance IP to
|
||||
; byte following null-termination.
|
||||
;
|
||||
; If it isn't, things get interesting: If it's a word reference, then it's
|
||||
; not an invalid literal. For example, one could want to redefine an existing
|
||||
; word. So in that case, we'll copy the word's name on the pad (it might not be
|
||||
; null-terminated) and set HL to point to it.
|
||||
@ -124,18 +124,22 @@ compSkip:
|
||||
; word. Yeah, it means that ";" can't be overridden...
|
||||
; If name can't be read, we abort
|
||||
readCompWord:
|
||||
; In all cases, we want RS' TOS in HL. Let's get it now.
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
call RSIsLIT
|
||||
; In all cases, we want RS' BOS in HL. Let's get it now.
|
||||
ld hl, (RS_ADDR)
|
||||
call HLPointsLIT
|
||||
jr nz, .notLIT
|
||||
; RS TOS is a LIT, make HL point to string, then skip this RS compword.
|
||||
; RS BOS is a LIT, make HL point to string, then skip this RS compword.
|
||||
inc hl \ inc hl ; HL now points to string itself
|
||||
jr compSkip
|
||||
push hl ; --> lvl 1, our result
|
||||
call strskip
|
||||
inc hl ; byte after word termination
|
||||
ld (RS_ADDR), hl
|
||||
pop hl ; <-- lvl 1, our result
|
||||
ret
|
||||
.notLIT:
|
||||
; Alright, not a literal, but is it a word? If it's not a number, then
|
||||
; it's a word.
|
||||
call RSIsNUMBER
|
||||
call HLPointsNUMBER
|
||||
jr z, .notWord
|
||||
; Not a number, then it's a word. Copy word to pad and point to it.
|
||||
call intoHL
|
||||
@ -153,7 +157,9 @@ readCompWord:
|
||||
; null-terminate
|
||||
xor a
|
||||
ld (de), a
|
||||
call compSkip
|
||||
; Advance RS' BOS by 2
|
||||
ld hl, RS_ADDR
|
||||
inc (hl) \ inc (hl)
|
||||
pop hl ; <-- lvl 1
|
||||
ret
|
||||
.notWord:
|
||||
@ -251,13 +257,15 @@ compile:
|
||||
; HL points to new (HERE)
|
||||
entryhead:
|
||||
call readCompWord
|
||||
call printstr
|
||||
ld de, (HERE)
|
||||
call strcpy
|
||||
ex de, hl ; (HERE) now in HL
|
||||
ld de, (CURRENT)
|
||||
ld a, NAMELEN
|
||||
call addHL
|
||||
xor a ; IMMED
|
||||
ld (hl), a
|
||||
inc hl
|
||||
ld (hl), e
|
||||
inc hl
|
||||
ld (hl), d
|
||||
|
||||
Loading…
Reference in New Issue
Block a user