forth: allow DEFINE's ";" to be at the start of a newline

Previous to this commit, DEFINE's algo would miss a ";" right after a newline.

This allows for a much nicer formatting+comment of core.fs.

apps/forth/core.fs

@@ -0,0 +1,49 @@
+: H HERE @ ;
+: -^ SWAP - ;
+: +! SWAP OVER @ + SWAP ! ;
+: ALLOT HERE +! ;
+: , H ! 2 ALLOT ;
+: C, H C! 1 ALLOT ;
+: BEGIN H ; IMMEDIATE
+: COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE
+: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
+: NOT 1 SWAP SKIP? EXIT 0 * ;
+: ( BEGIN LITS ) WORD SCMP NOT SKIP? AGAIN ; 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
+
+  COMPILE; Tough one. Get addr of caller word (example above
+  (bbr)) and then call LITN on it. However, LITN is an
+  immediate and has to be indirectly executed. Then, write
+  a reference to "," so that this word is written to HERE.
+ 
+  NOT: a bit convulted because we don't have IF yet )
+
+: IF                ( -- a | a: br cell addr )
+    COMPILE SKIP?   ( if true, don't branch )
+    COMPILE (fbr)
+    H               ( push a )
+    1 ALLOT         ( br cell allot )
+; IMMEDIATE
+
+: THEN              ( a -- | a: br cell addr )
+    DUP H -^ SWAP   ( a-H a )
+    C!
+; IMMEDIATE
+
+: ELSE              ( a1 -- a2 | a1: IF cell a2: ELSE cell )
+    COMPILE (fbr)
+    1 ALLOT
+    DUP H -^ SWAP   ( a-H a )
+    C!
+    H 1 -           ( push a. -1 for allot offset )
+; IMMEDIATE
+
+: ? @ . ;
+: VARIABLE CREATE 2 ALLOT ;
+: CONSTANT CREATE H ! DOES> @ ;
+: = CMP NOT ;
+: < CMP 0 1 - = ;
+: > CMP 1 = ;

apps/forth/core.fth

@@ -1,29 +0,0 @@
-: H HERE @ ;
-: -^ SWAP - ;
-: +! SWAP OVER @ + SWAP ! ;
-: ALLOT HERE +! ;
-: , H ! 2 ALLOT ;
-: C, H C! 1 ALLOT ;
-: BEGIN H ; IMMEDIATE
-: AGAIN ['] (bbr) , H -^ C, ; IMMEDIATE
-: NOT 1 SWAP SKIP? EXIT 0 * ;
-: ( BEGIN LITS ) WORD SCMP NOT SKIP? AGAIN ; 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
-  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> @ ;
-: = CMP NOT ;
-: < CMP 0 1 - = ;
-: > CMP 1 = ;

apps/forth/dict.asm

@@ -225,7 +225,7 @@ EXECUTE:
 	jp	(hl)	; go!
 
 
-	.db	"COMPILE"
+	.db	"[COMPIL"
 	.dw	EXECUTE
 	.db	1		; IMMEDIATE
 COMPILE:
@@ -278,7 +278,7 @@ DEFINE:
 	ld	(HERE), hl
 .loop:
 	; did we reach ";"?
-	ld	hl, (INPUTPOS)
+	call	toword
 	ld	a, (hl)
 	cp	';'
 	jr	nz, .compile

apps/forth/dictionary.txt

@@ -42,13 +42,28 @@ directly, but as part of another word.
 ALLOT       n --            Move HERE by n bytes
 C,          b --            Write byte b in HERE and advance it.
 CREATE x    --              Create cell named x. Doesn't allocate a PF.
-COMPILE x   --              Compile word x and write it to HERE
+[COMPILE] x --              Compile word x and write it to HERE
+COMPILE x   --              Meta compiles. Kind of blows the mind. See below.
 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.
 LITN        n --            *I* Inserts number from TOS as a literal
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
 
+Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
+its straightforward: It writes down to HERE wither the address of the word or
+a number literal.
+
+When you *meta* compile, it's a bit more mind blowing. It fetches the address
+of the word specified by the caller, then writes that number as a literal,
+followed by a reference to ",".
+
+Example: ": foo [COMPILE] bar;" is the equivalent of ": foo bar ;" if bar is
+not an immediate. However, ": foo COMPILE bar ;" is the equivalent of
+": foo ['] bar , ;". Got it?
+
+Meta-compile only works with real words, not number literals.
+
 *** Flow ***
 Note about flow words: flow words can only be used in definitions. In the
 INTERPRET loop, they don't have the desired effect because each word from the

apps/forth/util.asm

@@ -4,25 +4,35 @@ pad:
 	ld	a, PADDING
 	jp	addHL
 
+; Advance (INPUTPOS) until a non-whitespace is met. If needed,
+; call fetchline.
+; Set HL to newly set (INPUTPOS)
+toword:
+	ld	hl, (INPUTPOS)
+	; skip leading whitespace
+	dec	hl	; offset leading "inc hl"
+.loop:
+	inc	hl
+	ld	a, (hl)
+	or	a
+	; When at EOL, fetch a new line directly
+	jr	z, .empty
+	cp	' '+1
+	jr	c, .loop
+	ret
+.empty:
+	call	fetchline
+	jr	toword
+
 ; Read word from (INPUTPOS) and return, in HL, a null-terminated word.
 ; Advance (INPUTPOS) to the character following the whitespace ending the
 ; word.
 ; When we're at EOL, we call fetchline directly, so this call always returns
 ; a word.
 readword:
-	ld	hl, (INPUTPOS)
-	; skip leading whitespace
-	dec	hl	; offset leading "inc hl"
-.loop1:
-	inc	hl
-	ld	a, (hl)
-	or	a
-	; When at EOL, fetch a new line directly
-	jr	z, .empty
-	cp	' '+1
-	jr	c, .loop1
+	call	toword
 	push	hl		; --> lvl 1. that's our result
-.loop2:
+.loop:
 	inc	hl
 	ld	a, (hl)
 	; special case: is A null? If yes, we will *not* inc A so that we don't
@@ -30,7 +40,7 @@ readword:
 	or	a
 	jr	z, .noinc
 	cp	' '+1
-	jr	nc, .loop2
+	jr	nc, .loop
 	; we've just read a whitespace, HL is pointing to it. Let's transform
 	; it into a null-termination, inc HL, then set (INPUTPOS).
 	xor	a
@@ -40,9 +50,6 @@ readword:
 	ld	(INPUTPOS), hl
 	pop	hl		; <-- lvl 1. our result
 	ret	; Z set from XOR A
-.empty:
-	call	fetchline
-	jr	readword
 
 ; Sets Z if (HL) == E and (HL+1) == D
 HLPointsDE:

emul/Makefile

@@ -36,8 +36,8 @@ forth/stage1: forth/stage1.c $(OBJS) forth/forth0-bin.h
 forth/stage1dbg: forth/stage1.c $(OBJS) forth/forth0-bin.h 
 	$(CC) -DDEBUG forth/stage1.c $(OBJS) -o $@
 
-forth/core.bin: $(APPS)/forth/core.fth forth/stage1
-	./forth/stage1 $(APPS)/forth/core.fth | tee $@ > /dev/null
+forth/core.bin: $(APPS)/forth/core.fs forth/stage1
+	./forth/stage1 $(APPS)/forth/core.fs | tee $@ > /dev/null
 
 forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN)
 	$(ZASMBIN) $(KERNEL) $(APPS) forth/core.bin < forth/glue1.asm | tee $@ > /dev/null