forth: Forth-ify "WORD"

forth/forth.asm

@@ -121,6 +121,7 @@ NUMBER:
 LIT:
 	.dw	litWord
 	.dw	INITIAL_SP
+	.dw	WORDBUF
 
 ; *** Code ***
 forthMain:
@@ -179,7 +180,7 @@ INTERPRET:
 	.dw	DROP
 	.dw	EXECUTE
 
-.fill 58
+.fill 56
 
 ; STABLE ABI
 ; Offset: 00cd
@@ -890,65 +891,10 @@ TOWORD:
 	.dw	TOWORD
 	.dw	EXIT
 
-; Read word from C<, copy to WORDBUF, null-terminate, and return, make
-; HL point to WORDBUF.
-	.db "WORD"
-	.dw $-TOWORD
-	.db 4
-; STABLE ABI
-; Offset: 04f7
-.out $
-WORD:
-	.dw	compiledWord
-	.dw	NUMBER		; ( a )
-	.dw	WORDBUF
-	.dw	TOWORD		; ( a c )
-	; branch mark
-	.dw	OVER		; ( a c a )
-	.dw	STORE		; ( a )
-	.dw	NUMBER		; ( a 1 )
-	.dw	1
-	.dw	PLUS		; ( a+1 )
-	.dw	CIN		; ( a c )
-	.dw	DUP		; ( a c c )
-	.dw	ISWS		; ( a c f )
-	.dw	CSKIP		; ( a c )
-	; I'm not sure why, I can't seem to successfully change this into
-	; a (br). I'll get rid of the (fbr) and (bbr) words when I'm done
-	; Forth-ifying "WORD"
-	.dw	BBR
-	.db	20	; here - mark
-	; at this point, we have ( a WS )
-	.dw	DROP
-	.dw	NUMBER
-	.dw	0
-	.dw	SWAP		; ( 0 a )
-	.dw	STORE		; ()
-	.dw	NUMBER
-	.dw	WORDBUF
-	.dw	EXIT
-
-.wcpy:
-	.dw	nativeWord
-	ld	de, WORDBUF
-	push	de		; we already have our result
-.loop:
-	ld	a, (hl)
-	cp	' '+1
-	jr	c, .loopend
-	ld	(de), a
-	inc	hl
-	inc	de
-	jr	.loop
-.loopend:
-	; null-terminate the string.
-	xor	a
-	ld	(de), a
-	jp	next
-
+.fill 73
 
 	.db	"(parsed)"
-	.dw	$-WORD
+	.dw	$-TOWORD
 	.db	8
 PARSED:
 	.dw	nativeWord

forth/icore.fs

@@ -51,25 +51,6 @@
 
 : ABORT _c (resSP) QUIT ;
 
-: INTERPRET
-    BEGIN
-    WORD
-    (find)
-    IF
-        1 FLAGS !
-        EXECUTE
-        0 FLAGS !
-    ELSE
-        (parse*) @ EXECUTE
-    THEN
-    AGAIN
-;
-
-: BOOT
-    LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN
-    _c INTERPRET
-;
-
 ( This is only the "early parser" in earlier stages. No need
   for an abort message )
 : (parse)
@@ -97,6 +78,26 @@
     HERE @ 1 + HERE !
 ;
 
+( Read word from C<, copy to WORDBUF, null-terminate, and
+  return, make HL point to WORDBUF. )
+: WORD
+    ( JTBL+30 == WORDBUF )
+    [ JTBL 30 + @ LITN ]        ( a )
+    TOWORD                      ( a c )
+    BEGIN
+        ( We take advantage of the fact that char MSB is
+          always zero to pre-write our null-termination )
+        OVER !                  ( a )
+        1 +                     ( a+1 )
+        C<                      ( a c )
+        DUP WS?
+    UNTIL
+    ( a this point, PS is: a WS )
+    ( null-termination is already written )
+    DROP DROP
+    [ JTBL 30 + @ LITN ]
+;
+
 : LITN
     ( JTBL+24 == NUMBER )
     JTBL 24 + ,
@@ -105,7 +106,7 @@
 
 : (entry)
     HERE @          ( h )
-    WORD            ( h s )
+    _c WORD         ( h s )
     SCPY            ( h )
     ( Adjust HERE -1 because SCPY copies the null )
     HERE @ 1 _c -   ( h h' )
@@ -118,6 +119,25 @@
     HERE @ CURRENT !
 ;
 
+: INTERPRET
+    BEGIN
+    _c WORD
+    (find)
+    IF
+        1 FLAGS !
+        EXECUTE
+        0 FLAGS !
+    ELSE
+        (parse*) @ EXECUTE
+    THEN
+    AGAIN
+;
+
+: BOOT
+    LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN
+    _c INTERPRET
+;
+
 ( : and ; have to be defined last because it can't be
   executed now also, they can't have their real name
   right away )
@@ -128,7 +148,7 @@
       issues. JTBL+24 == NUMBER JTBL+6 == compiledWord )
     [ JTBL 24 + , JTBL 6 + , ] ,
     BEGIN
-    WORD
+    _c WORD
     (find)
     ( is word )
     IF DUP _c IMMED? IF EXECUTE ELSE , THEN