forth: Forth-ify "IMMED?"

Because icore.fs defines it in a "not-for-runtime" manner, dummy.fs
executing it had ill effects. We use a workaround instead.

forth/core.fs

@@ -1,7 +1,8 @@
 : H@ HERE @ ;
 : -^ SWAP - ;
-: [LITN] LITN ; IMMEDIATE
+: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
-: LIT ROUTINE S [LITN] , ;
+: ] R> DROP ;
+: LIT [ JTBL 26 + LITN ] , ;
 : LITS LIT SCPY ;
 : LIT< WORD LITS ; IMMEDIATE
 : _err LIT< word-not-found (print) ABORT ;
@@ -48,9 +49,9 @@
 ; IMMEDIATE
 
 : CREATE
-    (entry)          ( empty header with name )
+    (entry)            ( empty header with name )
-    ROUTINE C [LITN] ( push cellWord addr )
+    [ JTBL 3 + LITN ]  ( push cellWord addr )
-    ,                ( write it )
+    ,                  ( write it )
 ;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE H@ ! DOES> @ ;
@@ -86,7 +87,7 @@
 
 : (sysv)
     (entry)
-    ROUTINE Y [LITN] ,
+    [ JTBL LITN ] ,
     SYSVNXT @ ,
     2 SYSVNXT +!
 ;

forth/dictionary.txt

@@ -52,10 +52,6 @@ DOES>       --              See description at top of file
 IMMED?      a -- f          Checks whether wordref at a is immediate.
 IMMEDIATE   --              Flag the latest defined word as immediate.
 LITN        n --            Write number n as a literal.
-[LITN]      n --            *I* Immediate version of LITN.
-ROUTINE x   -- a            Push the addr of the specified core routine
-                            C=cellWord J=JUMPTBL V=nativeWord N=next S=LIT
-                            M=NUMBER Y=sysvarWord D=doesWord
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
 
 Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
@@ -81,6 +77,10 @@ input stream is executed immediately. In this context, branching doesn't work.
                             atom's cell.
 (bbr)       --              Branches backward by the number specified in its
                             atom's cell.
+[           --              Begin interetative mode. In a definition, words
+                            between here and "]" will be executed instead of
+                            compiled.
+]           --              End interpretative mode.
 ABORT       --              Resets PS and RS and returns to interpreter
 ABORT" x"   --              *I* Compiles a ." followed by a ABORT.
 AGAIN       I:a --          *I* Jump backwards to preceeding BEGIN.

forth/dummy.fs

@@ -1,7 +1,9 @@
 ( When building a compiled dict, always include this unit at
   the end of it so that Forth knows how to hook LATEST into
-  it )
+  it. We don't use the word "(entry)" to avoid messing up
-(entry) _
+  with icore setup. )
+CREATE _
+H@ 2 - HERE !
 
 ( After each dummy word like this, we poke IO port 2 with our
   current HERE value. The staging executable needs it to know

forth/forth.asm

@@ -115,8 +115,11 @@
 ; change bootstrap binaries have to be adjusted because they rely on them.
 ; We're at 0 here
 	jp	forthMain
-.fill 0x11-$
+.fill 0x08-$
 JUMPTBL:
+	jp	sysvarWord
+	jp	cellWord
+	jp	compiledWord
 	jp	pushRS
 	jp	popRS
 	jp	nativeWord
@@ -719,24 +722,10 @@ EMIT:
 	.dw	EXIT
 
 
-.fill 49
+.fill 71
-
-	.db	"C,"
-	.dw	$-EMIT
-	.db	2
-CWR:
-	.dw	nativeWord
-	pop	de
-	call	chkPS
-	ld	hl, (HERE)
-	ld	(hl), e
-	inc	hl
-	ld	(HERE), hl
-	jp	next
-
 
 	.db	","
-	.dw	$-CWR
+	.dw	$-EMIT
 	.db	1
 WR:
 	.dw	nativeWord
@@ -747,64 +736,11 @@ WR:
 	ld	(HERE), hl
 	jp	next
 
-
+.fill 100
-	.db	"ROUTINE"
-	.dw	$-WR
-	.db	0x87			; IMMEDIATE
-ROUTINE:
-	.dw	compiledWord
-	.dw	WORD
-	.dw	.private
-	.dw	EXIT
-
-.private:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	ld	a, (hl)
-	ld	de, cellWord
-	cp	'C'
-	jr	z, .end
-	ld	de, JUMPTBL
-	cp	'J'
-	jr	z, .end
-	ld	de, JUMPTBL+6
-	cp	'V'
-	jr	z, .end
-	ld	de, JUMPTBL+9
-	cp	'N'
-	jr	z, .end
-	ld	de, sysvarWord
-	cp	'Y'
-	jr	z, .end
-	ld	de, doesWord
-	cp	'D'
-	jr	z, .end
-	ld	de, LIT
-	cp	'S'
-	jr	z, .end
-	ld	de, NUMBER
-	cp	'M'
-	jr	z, .end
-	ld	de, JUMPTBL+12
-	cp	'P'
-	jr	nz, .notgood
-	; continue to end on match
-.end:
-	; is our slen 1?
-	inc	hl
-	ld	a, (hl)
-	or	a
-	jr	z, .good
-.notgood:
-	ld	de, 0
-.good:
-	push	de
-	jp	next
 
 ; ( addr -- )
 	.db "EXECUTE"
-	.dw $-ROUTINE
+	.dw $-WR
 	.db 7
 ; STABLE ABI
 ; Offset: 0388
@@ -822,52 +758,10 @@ EXECUTE:
 	jp	(hl)	; go!
 
 
-.fill 22
+.fill 77
-	.db	":"
-	.dw	$-EXECUTE
-	.db	0x81		; IMMEDIATE
-DEFINE:
-	.dw	compiledWord
-	.dw	ENTRYHEAD
-	.dw	NUMBER
-	.dw	compiledWord
-	.dw	WR
-	; BBR branch mark
-	.dw	.compile
-	.dw	BBR
-	.db	4
-	; no need for EXIT, ENDDEF takes care of taking us out
-
-.compile:
-	.dw	compiledWord
-	.dw	WORD
-	.dw	FIND_
-	.dw	NOT
-	.dw	CSKIP
-	.dw	FBR
-	.db	7
-	; Maybe number
-	.dw	PARSEI
-	.dw	LITN
-	.dw	EXIT
-	; FBR mark
-	.dw	DUP
-	.dw	ISIMMED
-	.dw	CSKIP
-	.dw	FBR
-	.db	5
-	; is immediate. just execute.
-	.dw	EXECUTE
-	.dw	EXIT
-	; FBR mark
-	; just a word, write
-	.dw	WR
-	.dw	EXIT
-
-
 
 	.db "DOES>"
-	.dw $-DEFINE
+	.dw $-EXECUTE
 	.db 5
 DOES:
 	.dw nativeWord
@@ -887,36 +781,11 @@ DOES:
 	jp	EXIT+2
 
 
-	.db "IMMEDIATE"
+.fill 51
-	.dw $-DOES
-	.db 9
-IMMEDIATE:
-	.dw nativeWord
-	ld	hl, (CURRENT)
-	dec	hl
-	set	FLAG_IMMED, (hl)
-	jp	next
-
-
-	.db	"IMMED?"
-	.dw	$-IMMEDIATE
-	.db	6
-ISIMMED:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	dec	hl
-	ld	de, 0
-	bit	FLAG_IMMED, (hl)
-	jr	z, .notset
-	inc	de
-.notset:
-	push	de
-	jp	next
 
 ; ( n -- )
 	.db	"LITN"
-	.dw	$-ISIMMED
+	.dw	$-DOES
 	.db	4
 LITN:
 	.dw nativeWord
@@ -1104,60 +973,20 @@ PARSED:
 	jp	next
 
 
-.fill 41
+.fill 96
 
-
+	.db	"JTBL"
-; Indirect parse caller. Reads PARSEPTR and calls
-PARSEI:
-	.dw	compiledWord
-	.dw	PARSEPTR_
-	.dw	FETCH
-	.dw	EXECUTE
-	.dw	EXIT
-
-
-; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
-; HL points to new (HERE)
-	.db	"(entry)"
 	.dw	$-PARSED
-	.db	7
+	.db	4
-ENTRYHEAD:
+JTBL:
-	.dw	compiledWord
+	.dw	sysvarWord
-	.dw	WORD
+	.dw	JUMPTBL
-	.dw	.private
-	.dw	EXIT
-
-.private:
-	.dw	nativeWord
-	pop	hl
-	ld	de, (HERE)
-	call	strcpy
-	; DE point to char after null, rewind.
-	dec	de
-	; B counts the null, adjust
-	dec	b
-	ld	a, b
-	ex	de, hl		; HL points to new HERE
-	ld	de, (CURRENT)
-	push	hl		; --> lvl 1
-	or	a	; clear carry
-	sbc	hl, de
-	ex	de, hl
-	pop	hl		; <-- lvl 1
-	call	DEinHL
-	; Save size
-	ld	(hl), b
-	inc	hl
-	ld	(CURRENT), hl
-	ld	(HERE), hl
-	jp	next
-
 
 ; STABLE ABI (every sysvars)
 ; Offset: 05ca
 .out $
 	.db "HERE"
-	.dw $-ENTRYHEAD
+	.dw $-JTBL
 	.db 4
 HERE_:	; Caution: conflicts with actual variable name
 	.dw sysvarWord

forth/icore.fs

@@ -29,13 +29,21 @@
 
   This means, of course, that any word compiling a _c word
   can't be executed immediately.
+
+  Also note that because of that "_c" mechanism, it might
+  take two rounds of bootstrapping before the compiled
+  z80c.bin file is "stabilized". That's because the 2nd time
+  around, the recorded offset will have changed.
 )
 
 : _c
-    ['] ROT
+    [
+    ' ROT
     6 -         ( header )
-    ['] _bend
+    ' _bend
     -           ( our offset )
+    LITN
+    ]
     '           ( get word )
     -^          ( apply offset )
     ,           ( write! )
@@ -73,13 +81,50 @@
     AGAIN
 ;
 
-( ; has to be defined last because it can't be executed now )
+: C,
-: X             ( can't have its real name now )
+    HERE @ _c C!
+    HERE @ 1 + HERE !
+;
+
+: (entry)
+    HERE @          ( h )
+    WORD            ( h s )
+    SCPY            ( h )
+    ( Adjust HERE -1 because SCPY copies the null )
+    HERE @ 1 _c -   ( h h' )
+    DUP HERE !      ( h h' )
+    SWAP _c -       ( sz )
+    ( write prev value )
+    HERE @ CURRENT @ _c - ,
+    ( write size )
+    _c C,
+    HERE @ CURRENT !
+;
+
+( : and ; have to be defined last because it can't be
+  executed now also, they can't have their real name
+  right away )
+
+: X
+    _c (entry)
+    ( JTBL+6 == compiledWord )
+    [ JTBL 6 + LITN ] ,
+    BEGIN
+    WORD
+    (find)
+    ( is word )
+    IF DUP _c IMMED? IF EXECUTE ELSE , THEN
+    ( maybe number )
+    ELSE (parse*) @ EXECUTE LITN THEN
+    AGAIN
+; IMMEDIATE
+
+: Y
     ['] EXIT ,
-    _c R> DROP     ( exit COMPILE )
     _c R> DROP     ( exit : )
 ; IMMEDIATE
 
-( Give ";" its real name )
+( Give ":" and ";" their real name )
-';' CURRENT @ 4 - C!
+':' ' X 4 - C!
+';' ' Y 4 - C!
 

forth/z80a.fs

@@ -54,7 +54,6 @@
 ;
 0x04 OP1r INCr,
 0x05 OP1r DECr,
-0x46 OP1r LDr(HL),
 
 ( r -- )
 : OP1r0
@@ -63,7 +62,6 @@
     C@              ( r op )
     OR A,
 ;
-0x70 OP1r0 LD(HL)r,
 0xa0 OP1r0 ANDr,
 0xb0 OP1r0 ORr,
 0xa8 OP1r0 XORr,
@@ -81,6 +79,7 @@
 0xc5 OP1qq PUSHqq,
 0xc1 OP1qq POPqq,
 0x03 OP1qq INCss,
+0x0b OP1qq DECss,
 0x09 OP1qq ADDHLss,
 
 : _1rr
@@ -208,6 +207,8 @@
 ;
 0xcd OP3nn CALLnn,
 0xc3 OP3nn JPnn,
+0x22 OP3nn LD(nn)HL,
+0x2a OP3nn LDHL(nn),
 
 : OPJR
     CREATE C,
@@ -222,16 +223,19 @@
 0x10 OPJR DJNZe,
 
 ( Specials )
-: JPNEXT, ROUTINE N [LITN] JPnn, ;
+( JTBL+18 == next )
+: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
 
 : CODE
-    ( same as CREATE, but with ROUTINE V )
+    ( same as CREATE, but with native word )
     (entry)
-    ROUTINE V [LITN] ,
+    ( JTBL+15 == next )
+    [ JTBL 15 + LITN ] ,
 ;
 
 : ;CODE JPNEXT, ;
 
 
 ( Routines )
-: chkPS, ROUTINE P [LITN] CALLnn, ;
+( JTBL+21 == next )
+: chkPS, [ JTBL 21 + LITN ] CALLnn, ;

forth/z80c.fs

@@ -12,8 +12,6 @@
   any word from our high level Forth, as long as it doesn't
   spit word references.
 
-  ROUTINE stuff is fine. It's not supposed to change.
-
   These restrictions are temporary, I'll figure something out
   so that we can end up fully bootstrap Forth from within
   itself.
@@ -173,13 +171,13 @@ CODE C!
     HL POPqq,
     DE POPqq,
     chkPS,
-    E LD(HL)r,
+    (HL) E LDrr,
 ;CODE
 
 CODE C@
     HL POPqq,
     chkPS,
-    L LDr(HL),
+    L (HL) LDrr,
     H 0 LDrn,
     HL PUSHqq,
 ;CODE
@@ -220,12 +218,30 @@ CODE J
 CODE >R
     HL POPqq,
     chkPS,
-    ( JUMPTBL+0 == pushRS )
+    ( JTBL+9 == pushRS )
-    ROUTINE J CALLnn,
+    JTBL 9 + CALLnn,
 ;CODE
 
 CODE R>
-    ( JUMPTBL+3 == popRS )
+    ( JTBL+12 == popRS )
-    ROUTINE J 3 + CALLnn,
+    JTBL 12 + CALLnn,
     HL PUSHqq,
 ;CODE
+
+CODE IMMEDIATE
+    CURRENT LDHL(nn),
+    HL DECss,
+    7 (HL) SETbr,
+;CODE
+
+CODE IMMED?
+    HL POPqq,
+    chkPS,
+    HL DECss,
+    DE 0 LDddnn,
+    7 (HL) BITbr,
+    3 JRZe, ( notset )
+    DE INCss,
+( notset )
+    DE PUSHqq,
+;CODE