forth: fix IF/THEN/ELSE in colon defs

This commit is contained in:
Virgil Dupras 2020-03-11 17:53:27 -04:00
parent 02b56c547a
commit 3996f0c825
3 changed files with 52 additions and 66 deletions

View File

@ -242,71 +242,35 @@ DEFINE:
; All we need to do is to know how many bytes to copy. To do so, we
; skip compwords until EXIT is reached.
ex de, hl ; DE is our dest
ld (HERE), de ; update HERE
ld l, (ix)
ld h, (ix+1)
.loop:
call HLPointsNUMBER
jr nz, .notNUMBER
; is number
ld bc, 4
ldir
call HLPointsEXIT
jr z, .loopend
call compSkip
jr .loop
.notNUMBER:
call HLPointsLIT
jr nz, .notLIT
; is lit
ldi
ldi
call strcpyM
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 (CMPDST), 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 HLPointsEXITQUIT
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
.loopend:
; skip EXIT
inc hl \ inc hl
; We have out end offset. Let's get our offset
ld e, (ix)
ld d, (ix+1)
or a ; clear carry
sbc hl, de
; HL is our copy count.
ld b, h
ld c, l
ld l, (ix)
ld h, (ix+1)
ld de, (CMPDST)
; continue!
jr .loop
ld de, (HERE) ; recall dest
; copy!
ldir
ld (ix), l
ld (ix+1), h
ld (HERE), de
jp exit
.db "DOES>"
.fill 3

View File

@ -123,7 +123,9 @@ forthInterpret:
.retRef:
.dw $+2
.dw forthInterpret
.dw $+2
call popRS
jr forthInterpret
msgOk:
.db " ok", 0

View File

@ -69,14 +69,28 @@ HLPointsLIT:
pop de
ret
HLPointsEXITQUIT:
HLPointsBRANCH:
push de
ld de, BRANCH
call HLPointsDE
jr z, .end
ld de, CBRANCH
call HLPointsDE
.end:
pop de
ret
HLPointsEXIT:
push de
ld de, EXIT
call HLPointsDE
jr z, .end
pop de
ret
HLPointsQUIT:
push de
ld de, QUIT
call HLPointsDE
.end:
pop de
ret
@ -85,7 +99,9 @@ HLPointsEXITQUIT:
; to after null-termination.
compSkip:
call HLPointsNUMBER
jr z, .isNum
jr z, .isNumOrBranch
call HLPointsBRANCH
jr z, .isNumOrBranch
call HLPointsLIT
jr nz, .isWord
; We have a literal
@ -93,7 +109,7 @@ compSkip:
call strskip
inc hl ; byte after word termination
ret
.isNum:
.isNumOrBranch:
; skip by 4
inc hl \ inc hl
; continue to isWord
@ -160,7 +176,11 @@ readLIT:
; it's a word.
call HLPointsNUMBER
jr z, .notWord
call HLPointsEXITQUIT
call HLPointsBRANCH
jr z, .notWord
call HLPointsEXIT
jr z, .notWord
call HLPointsQUIT
jr z, .notWord
; Not a number, then it's a word. Copy word to pad and point to it.
push hl ; --> lvl 1. we need it to set DE later