forth: fix IF/THEN/ELSE in colon defs

apps/forth/dict.asm

@@ -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

apps/forth/main.asm

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

apps/forth/util.asm

@@ -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