emul/Makefile

@@ -103,7 +103,7 @@ updatebootstrap: $(ZASMBIN)
 # words and they write to HERE at initialization.
 .PHONY: fbootstrap
 fbootstrap: forth/stage2
-	cat ../forth/dummy.fs ../forth/z80c.fs forth/emul.fs ../forth/icore.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
+	cat ../forth/dummy.fs ../forth/z80c.fs forth/emul.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
 
 .PHONY: clean
 clean:

forth/dictionary.txt

@@ -54,7 +54,7 @@ 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
+                            C=cellWord L=compiledWord V=nativeWord N=next S=LIT
                             M=NUMBER Y=sysvarWord D=doesWord
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
 

forth/forth.asm

@@ -10,14 +10,6 @@
 ; self-hosts in a more compact manner. File include is a big part of the
 ; complexity in zasm. If we can get rid of it, we'll be more compact.
 
-; *** ABI STABILITY ***
-;
-; This unit needs to have some of its entry points stay at a stable offset.
-; These have a comment over them indicating the expected offset. These should
-; not move until the Grand Bootstrapping operation has been completed.
-;
-; When you see random ".fill" here and there, it's to ensure that stability.
-
 ; *** Defines ***
 ; GETC: address of a GetC routine
 ; PUTC: address of a PutC routine
@@ -66,8 +58,6 @@
 .equ	CINPTR		@+2
 ; Pointer to (emit) word
 .equ	EMITPTR		@+2
-; Pointer to (print) word
-.equ	PRINTPTR	@+2
 .equ	WORDBUF		@+2
 ; Sys Vars are variables with their value living in the system RAM segment. We
 ; need this mechanisms for core Forth source needing variables. Because core
@@ -115,17 +105,11 @@
 ; change bootstrap binaries have to be adjusted because they rely on them.
 ; We're at 0 here
 	jp	forthMain
-.fill 0x11-$
+.fill 0x17-$
 JUMPTBL:
-	jp	pushRS
-	jp	popRS
 	jp	nativeWord
 	jp	next
 	jp	chkPS
-NUMBER:
-	.dw	numberWord
-LIT:
-	.dw	litWord
 
 ; *** Code ***
 forthMain:
@@ -153,10 +137,6 @@ forthMain:
 	ld	hl, .emitName
 	call	find
 	ld	(EMITPTR), de
-	; Set up PRINTPTR
-	ld	hl, .printName
-	call	find
-	ld	(PRINTPTR), de
 	; Set up CINPTR
 	; do we have a (c<) impl?
 	ld	hl, .cinName
@@ -180,8 +160,6 @@ forthMain:
 	.db	"(c<)", 0
 .emitName:
 	.db	"(emit)", 0
-.printName:
-	.db	"(print)", 0
 .keyName:
 	.db	"KEY", 0
 
@@ -197,13 +175,31 @@ BEGIN:
 
 INTERPRET:
 	.dw	compiledWord
-	.dw	LIT
+	; BBR mark
-	.db	"INTERPRET", 0
+	.dw	WORD
 	.dw	FIND_
-	.dw	DROP
+	.dw	CSKIP
+	.dw	FBR
+	.db	22
+	; It's a word, execute it
+	; For now, we only have one flag, let's take advantage of
+	; this to keep code simple.
+	.dw	NUMBER			; Bit 0 on
+	.dw	1
+	.dw	FLAGS_
+	.dw	STORE
 	.dw	EXECUTE
-
+	.dw	NUMBER			; Bit 0 off
-.fill 13
+	.dw	0
+	.dw	FLAGS_
+	.dw	STORE
+	.dw	BBR
+	.db	29
+	; FBR mark, try number
+	.dw	PARSEI
+	.dw	BBR
+	.db	34
+	; infinite loop
 
 ; *** Collapse OS lib copy ***
 ; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
@@ -629,6 +625,9 @@ numberWord:
 	push	de
 	jp	next
 
+NUMBER:
+	.dw	numberWord
+
 ; Similarly to numberWord, this is not a real word, but a string literal.
 ; Instead of being followed by a 2 bytes number, it's followed by a
 ; null-terminated string. When called, puts the string's address on PS
@@ -640,6 +639,9 @@ litWord:
 	ld	(IP), hl
 	jp	next
 
+LIT:
+	.dw	litWord
+
 ; Pop previous IP from Return stack and execute it.
 ; ( R:I -- )
 	.db	"EXIT"
@@ -689,11 +691,8 @@ abortUnderflow:
 .word:
 	.dw	compiledWord
 	.dw	LIT
-	.db	"stack underfl", 0
+	.db	"stack underflow", 0
-	.dw	NUMBER
+	.dw	PRINT
-	.dw	PRINTPTR
-	.dw	FETCH
-	.dw	EXECUTE
 	.dw	ABORT
 
 	.db "BYE"
@@ -703,9 +702,6 @@ BYE:
 	.dw nativeWord
 	halt
 
-; STABLE ABI
-; Offset: 02aa
-.out $
 ; ( c -- )
 	.db "EMIT"
 	.dw $-BYE
@@ -719,10 +715,43 @@ EMIT:
 	.dw	EXIT
 
 
-.fill 49
+	.db	"(print)"
+	.dw	$-EMIT
+	.db	7
+PRINT:
+	.dw	compiledWord	; a
+	; BBR mark
+	.dw	DUP		; a a
+	.dw	.getc		; a c
+	.dw	DUP		; a c f
+	.dw	CSKIP		; a c
+	; zero, end of string
+	.dw	FBR
+	.db	12
+	.dw	EMIT		; a
+	.dw	NUMBER		; a 1
+	.dw	1
+	.dw	PLUS		; a+1
+	.dw	BBR
+	.db	21
+	; FBR mark
+	.dw	DROP
+	.dw	DROP
+	.dw	EXIT
+
+; Yes, very much like C@, but it has already been Forth-ified...
+.getc:
+	.dw	nativeWord
+	pop	hl
+	call	chkPS
+	ld	l, (hl)
+	ld	h, 0
+	push	hl
+	jp	next
+
 
 	.db	"C,"
-	.dw	$-EMIT
+	.dw	$-PRINT
 	.db	2
 CWR:
 	.dw	nativeWord
@@ -765,13 +794,13 @@ ROUTINE:
 	ld	de, cellWord
 	cp	'C'
 	jr	z, .end
-	ld	de, JUMPTBL
+	ld	de, compiledWord
-	cp	'J'
+	cp	'L'
 	jr	z, .end
-	ld	de, JUMPTBL+6
+	ld	de, JUMPTBL
 	cp	'V'
 	jr	z, .end
-	ld	de, JUMPTBL+9
+	ld	de, JUMPTBL+3
 	cp	'N'
 	jr	z, .end
 	ld	de, sysvarWord
@@ -786,7 +815,7 @@ ROUTINE:
 	ld	de, NUMBER
 	cp	'M'
 	jr	z, .end
-	ld	de, JUMPTBL+12
+	ld	de, JUMPTBL+6
 	cp	'P'
 	jr	nz, .notgood
 	; continue to end on match
@@ -806,9 +835,6 @@ ROUTINE:
 	.db "EXECUTE"
 	.dw $-ROUTINE
 	.db 7
-; STABLE ABI
-; Offset: 0388
-.out $
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
@@ -822,10 +848,23 @@ EXECUTE:
 	jp	(hl)	; go!
 
 
-.fill 22
+	.db	";"
-	.db	":"
 	.dw	$-EXECUTE
 	.db	0x81		; IMMEDIATE
+ENDDEF:
+	.dw	compiledWord
+	.dw	NUMBER
+	.dw	EXIT
+	.dw	WR
+	.dw	R2P		; exit COMPILE
+	.dw	DROP
+	.dw	R2P		; exit DEFINE
+	.dw	DROP
+	.dw	EXIT
+
+	.db	":"
+	.dw	$-ENDDEF
+	.db	0x81		; IMMEDIATE
 DEFINE:
 	.dw	compiledWord
 	.dw	ENTRYHEAD
@@ -944,9 +983,6 @@ SCPY:
 	.db	"(find)"
 	.dw	$-SCPY
 	.db	6
-; STABLE ABI
-; Offset: 047c
-.out $
 FIND_:
 	.dw	nativeWord
 	pop	hl
@@ -1034,9 +1070,6 @@ TOWORD:
 	.db "WORD"
 	.dw $-TOWORD
 	.db 4
-; STABLE ABI
-; Offset: 04f7
-.out $
 WORD:
 	.dw	compiledWord
 	.dw	NUMBER		; ( a )
@@ -1104,7 +1137,23 @@ PARSED:
 	jp	next
 
 
-.fill 41
+	.db	"(parse)"
+	.dw	$-PARSED
+	.db	7
+PARSE:
+	.dw	compiledWord
+	.dw	PARSED
+	.dw	CSKIP
+	.dw	.error
+	; success, stack is already good, we can exit
+	.dw	EXIT
+
+.error:
+	.dw	compiledWord
+	.dw	LIT
+	.db	"unknown word", 0
+	.dw	PRINT
+	.dw	ABORT
 
 
 ; Indirect parse caller. Reads PARSEPTR and calls
@@ -1119,7 +1168,7 @@ PARSEI:
 ; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
 ; HL points to new (HERE)
 	.db	"(entry)"
-	.dw	$-PARSED
+	.dw	$-PARSE
 	.db	7
 ENTRYHEAD:
 	.dw	compiledWord
@@ -1153,9 +1202,6 @@ ENTRYHEAD:
 	jp	next
 
 
-; STABLE ABI (every sysvars)
-; Offset: 05ca
-.out $
 	.db "HERE"
 	.dw $-ENTRYHEAD
 	.db 4
@@ -1195,9 +1241,6 @@ SYSVNXT_:
 	.db "!"
 	.dw $-SYSVNXT_
 	.db 1
-; STABLE ABI
-; Offset: 0610
-.out $
 STORE:
 	.dw nativeWord
 	pop	iy
@@ -1223,7 +1266,6 @@ FETCH:
 	.db "DROP"
 	.dw $-FETCH
 	.db 4
-; STABLE ABI
 DROP:
 	.dw nativeWord
 	pop	hl
@@ -1267,12 +1309,28 @@ OVER:
 	push	de
 	jp	next
 
+	.db	">R"
+	.dw	$-OVER
+	.db	2
+P2R:
+	.dw	nativeWord
+	pop	hl
+	call	chkPS
+	call	pushRS
+	jp	next
 
-.fill 31
+	.db	"R>"
+	.dw	$-P2R
+	.db	2
+R2P:
+	.dw	nativeWord
+	call	popRS
+	push	hl
+	jp	next
 
 ; ( a b -- c ) A + B
 	.db "+"
-	.dw $-OVER
+	.dw $-R2P
 	.db 1
 PLUS:
 	.dw nativeWord
@@ -1283,11 +1341,23 @@ PLUS:
 	push	hl
 	jp	next
 
-.fill 18
+; ( a b -- c ) A - B
+	.db "-"
+	.dw $-PLUS
+	.db 1
+MINUS:
+	.dw nativeWord
+	pop	de		; B
+	pop	hl		; A
+	call	chkPS
+	or	a		; reset carry
+	sbc	hl, de
+	push	hl
+	jp	next
 
 ; ( a1 a2 -- b )
 	.db "SCMP"
-	.dw $-PLUS
+	.dw $-MINUS
 	.db 4
 SCMP:
 	.dw nativeWord
@@ -1320,9 +1390,6 @@ CMP:
 	.db	"SKIP?"
 	.dw	$-CMP
 	.db	5
-; STABLE ABI
-; Offset: 06ee
-.out $
 CSKIP:
 	.dw	nativeWord
 	pop	hl
@@ -1380,9 +1447,6 @@ CSKIP:
 	.db	"(fbr)"
 	.dw	$-CSKIP
 	.db	5
-; STABLE ABI
-; Offset: 073e
-.out $
 FBR:
 	.dw	nativeWord
 	push	de
@@ -1396,9 +1460,6 @@ FBR:
 	.db	"(bbr)"
 	.dw	$-FBR
 	.db	5
-; STABLE ABI
-; Offset: 0757
-.out $
 BBR:
 	.dw	nativeWord
 	ld	hl, (IP)
@@ -1412,6 +1473,5 @@ BBR:
 ; To allow dict binaries to "hook themselves up", we always end such binary
 ; with a dummy, *empty* entry. Therefore, we can have a predictable place for
 ; getting a prev label.
-	.db	"_bend"
 	.dw	$-BBR
-	.db	5
+	.db	0

forth/icore.fs

@@ -1,85 +0,0 @@
-( Inner core. This unit represents core definitions that
-  happen right after native definitions. Before core.fs.
-
-  Unlike core.fs and its followers, this unit isn't self-
-  sustained. Like native defs it uses the machinery of a
-  full Forth interpreter, notably for flow structures.
-
-  Because of that, it has to obey specific rules:
-
-  1. It cannot compile a word from higher layers. Using
-     immediates is fine though.
-  2. If it references a word from this unit or from native
-     definitions, these need to be properly offsetted
-     because their offset at compile time are not the same
-     as their runtime offsets.
-  3. Anything they refer to in the boot binary has to be
-     properly stabilized.
-  4. Make sure that the words you compile are not overridden
-     by the full interpreter.
-)
-
-( When referencing words from native defs or this very unit,
-  use this compiling word, which subtract the proper offset
-  from the compiled word. That proper offset is:
-  1. Take ROT-header addr, the first native def.
-  2. Subtract _bend, boot's last word.
-  3. That will give us the offset to subtract to get the addr
-     of our word at runtime.
-
-  This means, of course, that any word compiling a _c word
-  can't be executed immediately.
-)
-
-: _c
-    ['] ROT
-    6 -         ( header )
-    ['] _bend
-    -           ( our offset )
-    '           ( get word )
-    -^          ( apply offset )
-    ,           ( write! )
-; IMMEDIATE
-
-: INTERPRET
-    BEGIN
-    WORD
-    (find)
-    IF
-        1 FLAGS !
-        EXECUTE
-        0 FLAGS !
-    ELSE
-        (parse*) @ EXECUTE
-    THEN
-    AGAIN
-;
-
-( This is only the "early parser" in earlier stages. No need
-  for an abort message )
-: (parse)
-    (parsed) SKIP? ABORT
-;
-
-( a -- )
-: (print)
-    BEGIN
-    DUP         ( a a )
-    _c C@       ( a c )
-    ( exit if null )
-    DUP NOT IF DROP DROP EXIT THEN
-    EMIT        ( a )
-    1 +         ( a+1 )
-    AGAIN
-;
-
-( ; has to be defined last because it can't be executed now )
-: X             ( can't have its real name now )
-    ['] EXIT ,
-    _c R> DROP     ( exit COMPILE )
-    _c R> DROP     ( exit : )
-; IMMEDIATE
-
-( Give ";" its real name )
-';' CURRENT @ 4 - C!
-

forth/z80c.fs

@@ -113,15 +113,6 @@ CODE XOR
     HL PUSHqq,
 ;CODE
 
-CODE -
-    DE POPqq,
-    HL POPqq,
-    chkPS,
-    A ORr,
-    DE SBCHLss,
-    HL PUSHqq,
-;CODE
-
 CODE *
     DE POPqq,
     BC POPqq,
@@ -216,16 +207,3 @@ CODE J
     H 3 IX- LDrIXY,
     HL PUSHqq,
 ;CODE
-
-CODE >R
-    HL POPqq,
-    chkPS,
-    ( JUMPTBL+0 == pushRS )
-    ROUTINE J CALLnn,
-;CODE
-
-CODE R>
-    ( JUMPTBL+3 == popRS )
-    ROUTINE J 3 + CALLnn,
-    HL PUSHqq,
-;CODE