forth: add support for IMMEDIATE words

apps/forth/dict.asm

@@ -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
+	call	HLPointsNUMBER
-	jr	z, .loopend
+	jr	nz, .notNUMBER
-	call	compSkip
+	; is number
+	ld	bc, 4
+	ldir
 	jr	.loop
-.loopend:
+.notNUMBER:
-	; At this point, HL points to EXIT compword. We'll copy it too.
+	call	HLPointsLIT
-	; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2
+	jr	nz, .notLIT
-	ld	e, (ix)
+	; is lit
-	ld	d, (ix+1)
+	ldi
-	inc	hl \ inc hl	; our +2
+	ldi
-	or	a		; clear carry
+	inc	hl \ inc hl
-	sbc	hl, de
+	call	strcpyM
-	ld	b, h
+	inc	hl		; byte after word termination
-	ld	c, l
+	jr	.loop
-	; BC has proper count
+.notLIT:
-	ex	de, hl		; HL is our source (old RS' TOS)
+	; it's a word
-	ld	de, (HERE)	; and DE is our dest
+	call	HLPointsIMMED
-	ldir			; go!
+	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

apps/forth/dictionary.txt

@@ -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.
+*** I/O ***
-DOES>       --              See description at top of file
+.           n --            Print n in its decimal form
-DUP         a -- a a
-ELSE        --              Branch to THEN
 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.

apps/forth/util.asm

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