forth: improve input flow

Readline, instead of being triggered by the end of execution of the last compiled line is now triggered "just in time", by "WORD". This allows IMMEDIATE words reading input buffer to span multiple lines ( comments for example, but colon definitions will soon follow ).
forth: Forth-ify main loop a bit
2024-11-02 10:30:55 +11:00 · 2020-03-14 19:10:39 -04:00 · 2020-03-14 17:48:24 -04:00 · 2020-03-14 09:23:58 -04:00
5 changed files with 180 additions and 116 deletions
--- a/apps/forth/core.fth
+++ b/apps/forth/core.fth
@ -4,20 +4,24 @@
 : ALLOT HERE +! ;
 : , H ! 2 ALLOT ;
 : C, H C! 1 ALLOT ;
-: IF ['] (fbr?) , H 1 ALLOT ; IMMEDIATE
-: THEN DUP H -^ SWAP C! ; IMMEDIATE
-: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
+: NOT 1 SWAP SKIP? EXIT 0 * ;
 : RECURSE R> R> 2 - >R >R EXIT ;
-: ( LIT@ ) WORD SCMP IF RECURSE THEN ; IMMEDIATE
-( Hello, hello, krkrkrkr... do you hear me? )
-( Ah, voice at last! Some lines above need comments )
-( IF: write (fbr?) addr, push HERE, create cell )
-( THEN: Subtract TOS from H to get offset to write to cell )
-( in that same TOS's addr )
-( ELSE: write (fbr) addr, allot, then same as THEN )
-( RECURSE: RS TOS is for RECURSE itself, then we have to dig )
-( one more level to get to RECURSE's parent's caller. )
-: NOT IF 0 ELSE 1 THEN ;
+: ( LIT@ ) WORD SCMP NOT SKIP? RECURSE ; IMMEDIATE
+( Hello, hello, krkrkrkr... do you hear me?
+  Ah, voice at last! Some lines above need comments
+  BTW: Forth lines limited to 64 cols because of default
+  input buffer size in Collapse OS
+  NOT: a bit convulted because we don't have IF yet
+  RECURSE: RS TOS is for RECURSE itself, then we have to dig
+  one more level to get to RECURSE's parent's caller.
+  IF true, skip following (fbr). Also, push br cell ref H,
+  to PS )
+: IF ['] SKIP? , ['] (fbr) , H 1 ALLOT ; IMMEDIATE
+( Subtract TOS from H to get offset to write to IF or ELSE's
+  br cell )
+: THEN DUP H -^ SWAP C! ; IMMEDIATE
+( write (fbr) addr, allot, then same as THEN )
+: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
 : ? @ . ;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE H ! DOES> @ ;
--- a/apps/forth/dict.asm
+++ b/apps/forth/dict.asm
@ -206,7 +206,6 @@ PFETCH:
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
-executeCodeLink:
 	ld	l, (iy)
 	ld	h, (iy+1)
 	; HL points to code pointer
@ -216,9 +215,68 @@ executeCodeLink:
 	jp	(hl)	; go!


+	.db	"COMPILE"
+	.dw	EXECUTE
+	.db	1		; IMMEDIATE
+COMPILE:
+	.dw	nativeWord
+	pop	hl		; word addr
+	call	find
+	jr	nz, .maybeNum
+	ex	de, hl
+	call	HLisIMMED
+	jr	z, .immed
+	ex	de, hl
+	call	.writeDE
+	jp	next
+.maybeNum:
+	push	hl		; --> lvl 1. save string addr
+	call	parseLiteral
+	pop	hl		; <-- lvl 1
+	jr	nz, .undef
+	; a valid number in DE!
+	ex	de, hl
+	ld	de, NUMBER
+	call	.writeDE
+	ex	de, hl		; number in DE
+	call	.writeDE
+	jp	next
+.undef:
+	; When encountering an undefined word during compilation, we spit a
+	; reference to litWord, followed by the null-terminated word.
+	; This way, if a preceding word expect a string literal, it will read it
+	; by calling readLIT, and if it doesn't, the routine will be
+	; called, triggering an abort.
+	ld	de, LIT
+	call	.writeDE
+	ld	de, (HERE)
+	call	strcpyM
+	ld	(HERE), de
+	jp	next
+.immed:
+	; For this IMMEDIATE word to be compatible with regular execution model,
+	; it needs to be compiled as an atom somewhere in memory.
+	; For example, RECURSE backtracks in RS and steps back 2 bytes. This
+	; can only work with our compiled atom being next to an EXIT atom.
+	ex	de, hl		; atom to write in DE
+	ld	hl, (OLDHERE)
+	push	hl \ pop iy
+	call	DEinHL
+	ld	de, EXIT
+	call	DEinHL
+	jp	compiledWord
+.writeDE:
+	push	hl
+	ld	hl, (HERE)
+	call	DEinHL
+	ld	(HERE), hl
+	pop	hl
+	ret
+
+
 	.db	";"
 	.fill	6
-	.dw	EXECUTE
+	.dw	COMPILE
 	.db	0
 ENDDEF:
 	.dw	nativeWord
@ -377,7 +435,6 @@ KEY:
 WORD:
 	.dw nativeWord
 	call	readword
-	jp	nz, abort
 	push	hl
 	jp	next

@ -411,10 +468,18 @@ CURRENT_:
 	.dw sysvarWord
 	.dw CURRENT

+	.db	"IN>"
+	.fill	4
+	.dw	CURRENT_
+	.db	0
+INP:
+	.dw	sysvarWord
+	.dw	INPUTPOS
+
 ; ( n -- )
 	.db "."
 	.fill 6
-	.dw CURRENT_
+	.dw INP
 	.db 0
 DOT:
 	.dw nativeWord
@ -487,10 +552,20 @@ LITFETCH:
 	push	hl
 	jp	next

+; ( a -- )
+	.db "DROP"
+	.fill 3
+	.dw LITFETCH
+	.db 0
+DROP:
+	.dw nativeWord
+	pop	hl
+	jp	next
+
 ; ( a b -- b a )
 	.db "SWAP"
 	.fill 3
-	.dw LITFETCH
+	.dw DROP
 	.db 0
 SWAP:
 	.dw nativeWord
@ -711,12 +786,27 @@ CMP:
 	push	bc
 	jp	next

+	.db	"SKIP?"
+	.fill	2
+	.dw	CMP
+	.db	0
+CSKIP:
+	.dw	nativeWord
+	pop	hl
+	ld	a, h
+	or	l
+	jp	z, next		; False, do nothing.
+	ld	hl, (IP)
+	call	compSkip
+	ld	(IP), hl
+	jp	next
+
 ; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
 ; where to branch to. For example, The branching cell of "IF THEN" would
 ; contain 3. Add this value to RS.
 	.db	"(fbr)"
 	.fill	2
-	.dw	CMP
+	.dw	CSKIP
 	.db	0
 FBR:
 	.dw	nativeWord
@ -728,23 +818,6 @@ FBR:
 	pop	de
 	jp	next

-; Conditional branch, only branch if TOS is zero
-	.db	"(fbr?)"
-	.fill	1
-	.dw	FBR
-	.db	0
-FBRC:
-	.dw	nativeWord
-	pop	hl
-	ld	a, h
-	or	l
-	jr	z, FBR+2
-	; skip next byte in RS
-	ld	hl, (IP)
-	inc	hl
-	ld	(IP), hl
-	jp	next
-
 LATEST:
-	.dw FBRC
+	.dw FBR

--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@ -49,10 +49,9 @@ LITERAL     n --            *I* Inserts number from TOS as a literal
 VARIABLE c  --              Creates cell x with 2 bytes allocation.

 *** Flow ***
-(fbr?)      f --            Conditionally branches forward by the number
-                            specified in its atom's cell.
 (fbr)       --              Branches forward by the number specified in its
                            atom's cell.
+COMPILE     a --            Compile string word at addr a and spit it to HERE.
 ELSE        I:a --          *I* Compiles a (fbr) and set branching cell at a.
 EXECUTE     a --            Execute wordref at addr a
 IF          -- I:a          *I* Compiles a (fbr?) and pushes its cell's addr
@ -60,9 +59,13 @@ INTERPRET   --              Get a line from stdin, compile it in tmp memory,
                            then execute the compiled contents.
 QUIT        R:drop --       Return to interpreter promp immediately
 RECURSE     R:I -- R:I-2    Run the current word again.
+SKIP?       f --            If f is true, skip the execution of the next atom.
+                            Use this right before ";" and you're gonna have a
+                            bad time.
 THEN        I:a --          *I* Set branching cell at a.

 *** Parameter Stack ***
+DROP        a --
 DUP         a -- a a
 OVER        a b -- a b a
 SWAP        a b -- b a
@ -109,10 +112,21 @@ LIT@ x      -- a            Read following LIT and push its addr to a
 SCMP        a1 a2 -- n      Compare strings a1 and a2. See CMP

 *** I/O ***
+
+A little word about inputs. There are two kind of inputs: direct and buffered.
+As a general rule, we read line in a buffer, then feed words in it to the
+interpreter. That's what "WORD" does. If it's at the End Of Line, it blocks and
+wait until another line is entered.
+
+KEY input, however, is direct. Regardless of the input buffer's state, KEY will
+return the next typed key.
+
 .           n --            Print n in its decimal form
-EMIT        c --            Spit char c to stdout
-KEY         -- c            Get char c from stdin
+EMIT        c --            Spit char c to output stream
+IN>         -- a            Address of variable containing current pos in input
+                            buffer.
+KEY         -- c            Get char c from direct input
 PC!         c a --          Spit c to port a
 PC@         a -- c          Fetch c from port a
-WORD        -- a            Read one word from stdin and push its addr
+WORD        -- a            Read one word from buffered input and push its addr

--- a/apps/forth/main.asm
+++ b/apps/forth/main.asm
@ -69,7 +69,7 @@
 ; EXECUTING A WORD
 ;
 ; At it's core, executing a word is having the wordref in IY and call
-; executeCodeLink. Then, we let the word do its things. Some words are special,
+; EXECUTE. Then, we let the word do its things. Some words are special,
 ; but most of them are of the compiledWord type, and that's their execution that
 ; we describe here.
 ;
@ -102,16 +102,16 @@ forthMain:
 	ld	(CURRENT), hl
 	ld	hl, HERE_INITIAL
 	ld	(HERE), hl
+	; Set (INPUTPOS) to somewhere where there's a NULL so we consider
+	; ourselves EOL.
+	ld	(INPUTPOS), hl
+	xor	a
+	ld	(hl), a
 forthRdLine:
 	ld	hl, msgOk
 	call	printstr
 forthRdLineNoOk:
-	call	printcrlf
-	call	stdioReadLine
-	ld	(INPUTPOS), hl
-	; Setup return stack. As a safety net, we set its bottom to ABORTREF.
-	ld	hl, ABORTREF
-	ld	(RS_ADDR), hl
+	; Setup return stack. After INTERPRET, we run forthExecLine
 	ld	ix, RS_ADDR
 	; We're about to compile the line and possibly execute IMMEDIATE words.
 	; Let's save current (HERE) and temporarily set it to COMPBUF.
@ -119,61 +119,24 @@ forthRdLineNoOk:
 	ld	(OLDHERE), hl
 	ld	hl, COMPBUF
 	ld	(HERE), hl
-forthInterpret:
-	call	readword
-	jr	nz, .execute
-	call	find
-	jr	nz, .maybeNum
-	ex	de, hl
-	call	HLisIMMED
-	jr	z, .immed
-	ex	de, hl
-	call	.writeDE
-	jr	forthInterpret
-.maybeNum:
-	push	hl		; --> lvl 1. save string addr
-	call	parseLiteral
-	pop	hl		; <-- lvl 1
-	jr	nz, .undef
-	; a valid number in DE!
-	ex	de, hl
-	ld	de, NUMBER
-	call	.writeDE
-	ex	de, hl		; number in DE
-	call	.writeDE
-	jr	forthInterpret
-.undef:
-	; When encountering an undefined word during compilation, we spit a
-	; reference to litWord, followed by the null-terminated word.
-	; This way, if a preceding word expect a string literal, it will read it
-	; by calling readLIT, and if it doesn't, the routine will be
-	; called, triggering an abort.
-	ld	de, LIT
-	call	.writeDE
-	ld	de, (HERE)
-	call	strcpyM
-	ld	(HERE), de
-	jr	forthInterpret
-.immed:
-	; For this IMMEDIATE word to be compatible with regular execution model,
-	; it needs to be compiled as an atom list. We need a temporary space for
-	; this, let's use (OLDHERE) while it isn't used.
-	ex	de, hl		; atom to write in DE
-	ld	hl, (OLDHERE)
-	call	DEinHL
-	; Now, let's write the .retRef
-	ld	de, .retRef
-	call	DEinHL
-	ld	iy, (OLDHERE)
-	jr	.execIY
-.execute:
+	ld	hl, .retRef
+	ld	(IP), hl
+	ld	hl, INTERPRET
+	push	hl
+	jp	EXECUTE+2
+.retRef:
+	.dw	$+2
+	.dw	forthExecLine
+
+forthExecLine:
 	ld	de, QUIT
-	call	.writeDE
+	ld	hl, (HERE)
+	call	DEinHL
+	ld	(HERE), hl
 	; Compilation done, let's restore (HERE) and execute!
 	ld	hl, (OLDHERE)
 	ld	(HERE), hl
 	ld	iy, COMPBUF
-.execIY:
 	; before we execute, let's play with our RS a bit: compiledWord is
 	; going to push (IP) on the RS, but we don't expect our compiled words
 	; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and
@ -182,16 +145,22 @@ forthInterpret:
 	ld	(IP), hl
 	ld	ix, RS_ADDR-2
 	jp	compiledWord
-.writeDE:
-	push	hl
-	ld	hl, (HERE)
-	call	DEinHL
-	ld	(HERE), hl
-	pop	hl
-	ret

-.retRef:
-	.dw	forthInterpret
+; (we don't have RECURSE here. Calling interpret makes us needlessly use our
+; RS stack, but it can take it, can't it? )
+; WORD COMPILE IN> @ C@ (to check if null) SKIP? (skip if not null) EXIT INTERPRET
+	.db	0b10		; UNWORD
+INTERPRET:
+	.dw	compiledWord
+	.dw	WORD
+	.dw	COMPILE
+	.dw	INP
+	.dw	FETCH
+	.dw	CFETCH
+	.dw	CSKIP
+	.dw	EXIT
+	.dw	INTERPRET
+	.dw	EXIT

 msgOk:
 	.db	" ok", 0
--- a/apps/forth/util.asm
+++ b/apps/forth/util.asm
@ -7,7 +7,8 @@ pad:
 ; Read word from (INPUTPOS) and return, in HL, a null-terminated word.
 ; Advance (INPUTPOS) to the character following the whitespace ending the
 ; word.
-; Z set of word was read, unset if end of line.
+; When we're at EOL, we call fetchline directly, so this call always returns
+; a word.
 readword:
 	ld	hl, (INPUTPOS)
 	; skip leading whitespace
@ -16,6 +17,7 @@ readword:
 	inc	hl
 	ld	a, (hl)
 	or	a
+	; When at EOL, fetch a new line directly
 	jr	z, .empty
 	cp	' '+1
 	jr	c, .loop1
@ -39,9 +41,8 @@ readword:
 	pop	hl		; <-- lvl 1. our result
 	ret	; Z set from XOR A
 .empty:
-	ld	(hl), a
-	inc	a	; unset Z
-	ret
+	call	fetchline
+	jr	readword

 ; Sets Z if (HL) == E and (HL+1) == D
 HLPointsDE:
@ -73,10 +74,6 @@ HLPointsBR:
 	push	de
 	ld	de, FBR
 	call	HLPointsDE
-	jr	z, .end
-	ld	de, FBRC
-	call	HLPointsDE
-.end:
 	pop	de
 	ret

@ -340,3 +337,10 @@ DEinHL:
 	ld	(hl), d
 	inc	hl
 	ret
+
+fetchline:
+	call	printcrlf
+	call	stdioReadLine
+	ld	(INPUTPOS), hl
+	ret
+