forth/core.fs

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

forth/dictionary.txt

@@ -52,6 +52,10 @@ 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",
@@ -77,10 +81,6 @@ 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,9 +1,7 @@
 ( When building a compiled dict, always include this unit at
   the end of it so that Forth knows how to hook LATEST into
-  it. We don't use the word "(entry)" to avoid messing up
+  it )
-  with icore setup. )
+(entry) _
-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,11 +115,8 @@
 ; change bootstrap binaries have to be adjusted because they rely on them.
 ; We're at 0 here
 	jp	forthMain
-.fill 0x08-$
+.fill 0x11-$
 JUMPTBL:
-	jp	sysvarWord
-	jp	cellWord
-	jp	compiledWord
 	jp	pushRS
 	jp	popRS
 	jp	nativeWord
@@ -722,10 +719,24 @@ EMIT:
 	.dw	EXIT
 
 
-.fill 71
+.fill 49
+
+	.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	$-EMIT
+	.dw	$-CWR
 	.db	1
 WR:
 	.dw	nativeWord
@@ -736,11 +747,64 @@ 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 $-WR
+	.dw $-ROUTINE
 	.db 7
 ; STABLE ABI
 ; Offset: 0388
@@ -758,10 +822,52 @@ EXECUTE:
 	jp	(hl)	; go!
 
 
-.fill 77
+.fill 22
+	.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 $-EXECUTE
+	.dw $-DEFINE
 	.db 5
 DOES:
 	.dw nativeWord
@@ -781,11 +887,36 @@ DOES:
 	jp	EXIT+2
 
 
-.fill 51
+	.db "IMMEDIATE"
+	.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	$-DOES
+	.dw	$-ISIMMED
 	.db	4
 LITN:
 	.dw nativeWord
@@ -973,20 +1104,60 @@ PARSED:
 	jp	next
 
 
-.fill 96
+.fill 41
 
-	.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	4
+	.db	7
-JTBL:
+ENTRYHEAD:
-	.dw	sysvarWord
+	.dw	compiledWord
-	.dw	JUMPTBL
+	.dw	WORD
+	.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 $-JTBL
+	.dw $-ENTRYHEAD
 	.db 4
 HERE_:	; Caution: conflicts with actual variable name
 	.dw sysvarWord

forth/icore.fs

@@ -29,21 +29,13 @@
 
   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! )
@@ -81,50 +73,13 @@
     AGAIN
 ;
 
-: C,
+( ; has to be defined last because it can't be executed now )
-    HERE @ _c C!
+: X             ( can't have its real name now )
-    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 ":" and ";" their real name )
+( Give ";" its real name )
-':' ' X 4 - C!
+';' CURRENT @ 4 - C!
-';' ' Y 4 - C!
 

forth/z80a.fs

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

forth/z80c.fs

@@ -12,6 +12,8 @@
   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.
@@ -171,13 +173,13 @@ CODE C!
     HL POPqq,
     DE POPqq,
     chkPS,
-    (HL) E LDrr,
+    E LD(HL)r,
 ;CODE
 
 CODE C@
     HL POPqq,
     chkPS,
-    L (HL) LDrr,
+    L LDr(HL),
     H 0 LDrn,
     HL PUSHqq,
 ;CODE
@@ -218,30 +220,12 @@ CODE J
 CODE >R
     HL POPqq,
     chkPS,
-    ( JTBL+9 == pushRS )
+    ( JUMPTBL+0 == pushRS )
-    JTBL 9 + CALLnn,
+    ROUTINE J CALLnn,
 ;CODE
 
 CODE R>
-    ( JTBL+12 == popRS )
+    ( JUMPTBL+3 == popRS )
-    JTBL 12 + CALLnn,
+    ROUTINE J 3 + 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