emul/forth/stage.c

@@ -29,7 +29,7 @@ trouble of compiling defs to binary.
 
 //#define DEBUG
 // in sync with glue.asm
-#define RAMSTART 0x840
+#define RAMSTART 0x890
 #define STDIO_PORT 0x00
 // To know which part of RAM to dump, we listen to port 2, which at the end of
 // its compilation process, spits its HERE addr to port 2 (MSB first)

forth/core.fs

@@ -2,7 +2,7 @@
 : -^ SWAP - ;
 : [ INTERPRET 1 FLAGS ! ; IMMEDIATE
 : ] R> DROP ;
-: LIT 34 , ;
+: LIT JTBL 26 + , ;
 : LITS LIT SCPY ;
 : LIT< WORD LITS ; IMMEDIATE
 : _err LIT< word-not-found (print) ABORT ;
@@ -22,7 +22,6 @@
   "_": words starting with "_" are meant to be "private",
   that is, only used by their immediate surrondings.
 
-  LIT: 34 == LIT
   COMPILE: Tough one. Get addr of caller word (example above
   (br)) and then call LITN on it. )
 
@@ -50,33 +49,11 @@
 
 : CREATE
     (entry)            ( empty header with name )
-    11                 ( 11 == cellWord )
+    [ JTBL 3 + LITN ]  ( push cellWord addr )
     ,                  ( write it )
 ;
-
-( We run this when we're in an entry creation context. Many
-  things we need to do.
-  1. Change the code link to doesWord
-  2. Leave 2 bytes for regular cell variable.
-  3. Write down RS' RTOS to entry.
-  4. exit parent definition
-)
-: DOES>
-    ( Overwrite cellWord in CURRENT )
-    ( 63 == doesWord )
-    63 CURRENT @ !
-    ( When we have a DOES>, we forcefully place HERE to 4
-      bytes after CURRENT. This allows a DOES word to use ","
-      and "C," without messing everything up. )
-    CURRENT @ 4 + HERE !
-    ( HERE points to where we should write R> )
-    R> ,
-    ( We're done. Because we've popped RS, we'll exit parent
-      definition )
-;
-
 : VARIABLE CREATE 2 ALLOT ;
-: CONSTANT CREATE , DOES> @ ;
+: CONSTANT CREATE H@ ! DOES> @ ;
 : = CMP NOT ;
 : < CMP 0 1 - = ;
 : > CMP 1 = ;
@@ -108,18 +85,17 @@
   in dictionary.txt )
 
 : (sysv)
+    (entry)
+    ( JTBL+0 == sysvarWord )
+    [ JTBL LITN ] ,
+    ( JTBL+42 == SYSVNXT )
+    [ JTBL 42 + @ LITN ] DUP    ( a a )
     ( Get new sysv addr )
-    ( 50 == SYSVNXT )
+    @ ,                         ( a )
-    50 @ @
-    CONSTANT
     ( increase current sysv counter )
-    2 50 @ +!
+    2 SWAP +!
 ;
 
-( Set up initial SYSVNXT value, which is 2 bytes after its
-  own address )
-50 @ DUP 2 + SWAP !
-
 : ."
     LIT
     BEGIN

forth/forth.asm

@@ -1,5 +1,34 @@
-; Collapse OS Forth's boot binary
+; Collapse OS' Forth
+;
+; Unlike other assembler parts of Collapse OS, this unit is one huge file.
+;
+; I do this because as Forth takes a bigger place, assembler is bound to take
+; less and less place. I am thus consolidating that assembler code in one
+; place so that I have a better visibility of what to minimize.
+;
+; I also want to reduce the featureset of the assembler so that Collapse OS
+; 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
+;
+; Those GetC/PutC routines are hooked through defines and have this API:
+;
+; GetC: Blocks until a character is read from the device and return that
+;       character in A.
+;
+; PutC: Write character specified in A onto the device.
+;
 ; *** Const ***
 ; Base of the Return Stack
 .equ	RS_ADDR		0xf000
@@ -36,25 +65,49 @@
 ; that we can't compile a regular variable in it. SYSVNXT points to the next
 ; free space in SYSVBUF. Then, at the word level, it's a regular sysvarWord.
 .equ	SYSVNXT		@+WORD_BUFSIZE
-.equ	RAMEND		@+SYSV_BUFSIZE+2
+.equ	SYSVBUF		@+2
+.equ	RAMEND		@+SYSV_BUFSIZE
 
 ; (HERE) usually starts at RAMEND, but in certain situations, such as in stage0,
 ; (HERE) will begin at a strategic place.
 .equ	HERE_INITIAL	RAMEND
 
+; EXECUTION MODEL
+; After having read a line through readline, we want to interpret it. As
+; a general rule, we go like this:
+;
+; 1. read single word from line
+; 2. Can we find the word in dict?
+; 3. If yes, execute that word, goto 1
+; 4. Is it a number?
+; 5. If yes, push that number to PS, goto 1
+; 6. Error: undefined word.
+;
+; EXECUTING A WORD
+;
+; At it's core, executing a word is having the wordref in IY and call
+; EXECUTE. Then, we let the word do its things. Some words are special,
+; but most of them are of the compiledWord type, and that's their execution that
+; we describe here.
+;
+; First of all, at all time during execution, the Interpreter Pointer (IP)
+; points to the wordref we're executing next.
+;
+; When we execute a compiledWord, the first thing we do is push IP to the Return
+; Stack (RS). Therefore, RS' top of stack will contain a wordref to execute
+; next, after we EXIT.
+;
+; At the end of every compiledWord is an EXIT. This pops RS, sets IP to it, and
+; continues.
+
 ; *** Stable ABI ***
 ; Those jumps below are supposed to stay at these offsets, always. If they
 ; change bootstrap binaries have to be adjusted because they rely on them.
-; Those entries are referenced directly by their offset in Forth code with a
-; comment indicating what that number refers to.
-;
 ; We're at 0 here
 	jp	forthMain
-; 3
+.fill 0x08-$
-	jp	find
+JUMPTBL:
-	nop \ nop	; unused
+	jp	sysvarWord
-	nop \ nop \ nop	; unused
-; 11
 	jp	cellWord
 	jp	compiledWord
 	jp	pushRS
@@ -62,105 +115,26 @@
 	jp	nativeWord
 	jp	next
 	jp	chkPS
-; 32
+; 24
+NUMBER:
 	.dw	numberWord
+LIT:
 	.dw	litWord
 	.dw	INITIAL_SP
 	.dw	WORDBUF
 	jp	flagsToBC
-; 43
+; 35
 	jp	strcmp
 	.dw	RS_ADDR
 	.dw	CINPTR
 	.dw	SYSVNXT
 	.dw	FLAGS
-; 54
+; 46
 	.dw	PARSEPTR
 	.dw	HERE
 	.dw	CURRENT
-	jp	parseDecimal
-	jp	doesWord
-
-; *** Boot dict ***
-; There are only 5 words in the boot dict, but these words' offset need to be
-; stable, so they're part of the "stable ABI"
-
-; Pop previous IP from Return stack and execute it.
-; ( R:I -- )
-	.db	"EXIT"
-	.dw	0
-	.db	4
-EXIT:
-	.dw nativeWord
-	call	popRSIP
-	jp	next
-
-	.db	"(br)"
-	.dw	$-EXIT
-	.db	4
-BR:
-	.dw	nativeWord
-	ld	hl, (IP)
-	ld	e, (hl)
-	inc	hl
-	ld	d, (hl)
-	dec	hl
-	add	hl, de
-	ld	(IP), hl
-	jp	next
-
-	.db	"(?br)"
-	.dw	$-BR
-	.db	5
-CBR:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	ld	a, h
-	or	l
-	jr	z, BR+2		; False, branch
-	; True, skip next 2 bytes and don't branch
-	ld	hl, (IP)
-	inc	hl
-	inc	hl
-	ld	(IP), hl
-	jp	next
-
-	.db	","
-	.dw	$-CBR
-	.db	1
-WR:
-	.dw	nativeWord
-	pop	de
-	call	chkPS
-	ld	hl, (HERE)
-	ld	(hl), e
-	inc	hl
-	ld	(hl), d
-	inc	hl
-	ld	(HERE), hl
-	jp	next
-
-; ( addr -- )
-	.db "EXECUTE"
-	.dw $-WR
-	.db 7
-EXECUTE:
-	.dw nativeWord
-	pop	iy	; is a wordref
-	call	chkPS
-	ld	l, (iy)
-	ld	h, (iy+1)
-	; HL points to code pointer
-	inc	iy
-	inc	iy
-	; IY points to PFA
-	jp	(hl)	; go!
-
-; Offset: 00b8
-.out $
-; *** End of stable ABI ***
 
+; *** Code ***
 forthMain:
 	; STACK OVERFLOW PROTECTION:
 	; To avoid having to check for stack underflow after each pop operation
@@ -178,6 +152,9 @@ forthMain:
 	ld	(CURRENT), hl
 	ld	hl, HERE_INITIAL
 	ld	(HERE), hl
+	; Set up SYSVNXT
+	ld	hl, SYSVBUF
+	ld	(SYSVNXT), hl
 	ld	hl, .bootName
 	call	find
 	push	de
@@ -186,6 +163,48 @@ forthMain:
 .bootName:
 	.db	"BOOT", 0
 
+.fill 101
+
+; STABLE ABI
+; Offset: 00cd
+.out $
+; copy (HL) into DE, then exchange the two, utilising the optimised HL instructions.
+; ld must be done little endian, so least significant byte first.
+intoHL:
+	push 	de
+	ld 	e, (hl)
+	inc 	hl
+	ld 	d, (hl)
+	ex 	de, hl
+	pop 	de
+	ret
+
+; add the value of A into HL
+; affects carry flag according to the 16-bit addition, Z, S and P untouched.
+addHL:
+	push	de
+	ld 	d, 0
+	ld	e, a
+	add	hl, de
+	pop	de
+	ret
+
+; Copy string from (HL) in (DE), that is, copy bytes until a null char is
+; encountered. The null char is also copied.
+; HL and DE point to the char right after the null char.
+; B indicates the length of the copied string, including null-termination.
+strcpy:
+	ld	b, 0
+.loop:
+	ld	a, (hl)
+	ld	(de), a
+	inc	hl
+	inc	de
+	inc	b
+	or	a
+	jr	nz, .loop
+	ret
+
 ; Compares strings pointed to by HL and DE until one of them hits its null char.
 ; If equal, Z is set. If not equal, Z is reset. C is set if HL > DE
 strcmp:
@@ -210,6 +229,19 @@ strcmp:
 	; early, set otherwise)
 	ret
 
+; Given a string at (HL), move HL until it points to the end of that string.
+strskip:
+	push	bc
+	ex	af, af'
+	xor	a	; look for null char
+	ld	b, a
+	ld	c, a
+	cpir	; advances HL regardless of comparison, so goes one too far
+	dec	hl
+	ex	af, af'
+	pop	bc
+	ret
+
 ; Parse string at (HL) as a decimal value and return value in DE.
 ; Reads as many digits as it can and stop when:
 ; 1 - A non-digit character is read
@@ -291,6 +323,7 @@ parseDecimal:
 	xor	a	; set Z
 	ret
 
+; *** Support routines ***
 ; Find the entry corresponding to word where (HL) points to and sets DE to
 ; point to that entry.
 ; Z if found, NZ if not.
@@ -348,10 +381,8 @@ find:
 	dec	de \ dec de \ dec de	; prev field
 	push	de			; --> lvl 2
 	ex 	de, hl
-	ld 	e, (hl)
+	call 	intoHL
-	inc 	hl
+	ex 	de, hl			; DE contains prev offset
-	ld 	d, (hl)
-	; DE contains prev offset
 	pop	hl			; <-- lvl 2
 	; HL is prev field's addr
 	; Is offset zero?
@@ -385,6 +416,26 @@ flagsToBC:
 	dec	bc
 	ret
 
+; Write DE in (HL), advancing HL by 2.
+DEinHL:
+	ld	(hl), e
+	inc	hl
+	ld	(hl), d
+	inc	hl
+	ret
+
+; *** Stack management ***
+; The Parameter stack (PS) is maintained by SP and the Return stack (RS) is
+; maintained by IX. This allows us to generally use push and pop freely because
+; PS is the most frequently used. However, this causes a problem with routine
+; calls: because in Forth, the stack isn't balanced within each call, our return
+; offset, when placed by a CALL, messes everything up. This is one of the
+; reasons why we need stack management routines below. IX always points to RS'
+; Top Of Stack (TOS)
+;
+; This return stack contain "Interpreter pointers", that is a pointer to the
+; address of a word, as seen in a compiled list of words.
+
 ; Push value HL to RS
 pushRS:
 	inc	ix
@@ -430,13 +481,30 @@ chkPS:
 	ret	nc		; (INITIAL_SP) >= SP? good
 	jp	abortUnderflow
 
-abortUnderflow:
+; *** Dictionary ***
-	ld	hl, .name
+; It's important that this part is at the end of the resulting binary.
-	call	find
+; A dictionary entry has this structure:
-	push	de
+; - Xb name. Arbitrary long number of character (but can't be bigger than
-	jp	EXECUTE+2
+;   input buffer, of course). not null-terminated
-.name:
+; - 2b prev offset
-	.db "(uflw)", 0
+; - 1b size + IMMEDIATE flag
+; - 2b code pointer
+; - Parameter field (PF)
+;
+; The prev offset is the number of bytes between the prev field and the
+; previous word's code pointer.
+;
+; The size + flag indicate the size of the name field, with the 7th bit
+; being the IMMEDIATE flag.
+;
+; The code pointer point to "word routines". These routines expect to be called
+; with IY pointing to the PF. They themselves are expected to end by jumping
+; to the address at (IP). They will usually do so with "jp next".
+;
+; That's for "regular" words (words that are part of the dict chain). There are
+; also "special words", for example NUMBER, LIT, FBR, that have a slightly
+; different structure. They're also a pointer to an executable, but as for the
+; other fields, the only one they have is the "flags" field.
 
 ; This routine is jumped to at the end of every word. In it, we jump to current
 ; IP, but we also take care of increasing it my 2 before jumping
@@ -457,8 +525,6 @@ next:
 	jp	EXECUTE+2
 
 
-; *** Word routines ***
-
 ; Execute a word containing native code at its PF address (PFA)
 nativeWord:
 	jp	(iy)
@@ -486,6 +552,13 @@ cellWord:
 	push	iy
 	jp	next
 
+; Pushes the address in the first word of the PF
+sysvarWord:
+	ld	l, (iy)
+	ld	h, (iy+1)
+	push	hl
+	jp	next
+
 ; The word was spawned from a definition word that has a DOES>. PFA+2 (right
 ; after the actual cell) is a link to the slot right after that DOES>.
 ; Therefore, what we need to do push the cell addr like a regular cell, then
@@ -517,26 +590,206 @@ numberWord:
 litWord:
 	ld	hl, (IP)
 	push	hl
-	; Skip to null char
+	call	strskip
-	xor	a	; look for null char
+	inc	hl		; after null termination
-	ld	b, a
-	ld	c, a
-	cpir
-	; CPIR advances HL regardless of comparison, so goes one char after
-	; NULL. This is good, because that's what we want...
 	ld	(IP), hl
 	jp	next
 
-.fill 6
+; Pop previous IP from Return stack and execute it.
-; *** Dict hook ***
+; ( R:I -- )
-; This dummy dictionary entry serves two purposes:
+	.db	"EXIT"
-; 1. Allow binary grafting. Because each binary dict always end with a dummy
+	.dw	0
-;    entry, we always have a predictable prev offset for the grafter's first
+	.db	4
-;    entry.
+EXIT:
-; 2. Tell icore's "_c" routine where the boot binary ends. See comment there.
+	.dw nativeWord
-	.db	"_bend"
+	call	popRSIP
-	.dw	$-EXECUTE
+	jp	next
-	.db	5
 
-; Offset: 0237
+.fill 30
+
+abortUnderflow:
+	ld	hl, .name
+	call	find
+	push	de
+	jp	EXECUTE+2
+.name:
+	.db "(uflw)", 0
+
+	.db	"(br)"
+	.dw	$-EXIT
+	.db	4
+BR:
+	.dw	nativeWord
+	ld	hl, (IP)
+	ld	e, (hl)
+	inc	hl
+	ld	d, (hl)
+	dec	hl
+	add	hl, de
+	ld	(IP), hl
+	jp	next
+
+.fill 72
+
+	.db	"(?br)"
+	.dw	$-BR
+	.db	5
+CBR:
+	.dw	nativeWord
+	pop	hl
+	call	chkPS
+	ld	a, h
+	or	l
+	jp	z, BR+2		; False, branch
+	; True, skip next 2 bytes and don't branch
+	ld	hl, (IP)
+	inc	hl
+	inc	hl
+	ld	(IP), hl
+	jp	next
+
+.fill 15
+
+	.db	","
+	.dw	$-CBR
+	.db	1
+WR:
+	.dw	nativeWord
+	pop	de
+	call	chkPS
+	ld	hl, (HERE)
+	call	DEinHL
+	ld	(HERE), hl
+	jp	next
+
+.fill 100
+
+; ( addr -- )
+	.db "EXECUTE"
+	.dw $-WR
+	.db 7
+; STABLE ABI
+; Offset: 0388
+.out $
+EXECUTE:
+	.dw nativeWord
+	pop	iy	; is a wordref
+	call	chkPS
+	ld	l, (iy)
+	ld	h, (iy+1)
+	; HL points to code pointer
+	inc	iy
+	inc	iy
+	; IY points to PFA
+	jp	(hl)	; go!
+
+
+.fill 77
+
+	.db "DOES>"
+	.dw $-EXECUTE
+	.db 5
+DOES:
+	.dw nativeWord
+	; We run this when we're in an entry creation context. Many things we
+	; need to do.
+	; 1. Change the code link to doesWord
+	; 2. Leave 2 bytes for regular cell variable.
+	; 3. Write down IP+2 to entry.
+	; 3. exit. we're done here.
+	ld	hl, (CURRENT)
+	ld	de, doesWord
+	call	DEinHL
+	inc	hl \ inc hl		; cell variable space
+	ld	de, (IP)
+	call	DEinHL
+	ld	(HERE), hl
+	jp	EXIT+2
+
+
+.fill 82
+
+	.db	"SCPY"
+	.dw	$-DOES
+	.db	4
+SCPY:
+	.dw	nativeWord
+	pop	hl
+	ld	de, (HERE)
+	call	strcpy
+	ld	(HERE), de
+	jp	next
+
+
+	.db	"(find)"
+	.dw	$-SCPY
+	.db	6
+; STABLE ABI
+; Offset: 047c
+.out $
+FIND_:
+	.dw	nativeWord
+	pop	hl
+	call	find
+	jr	z, .found
+	; not found
+	push	hl
+	ld	de, 0
+	push	de
+	jp	next
+.found:
+	push	de
+	ld	de, 1
+	push	de
+	jp	next
+
+.fill 41
+
+	.db	"NOT"
+	.dw	$-FIND_
+	.db	3
+NOT:
+	.dw	nativeWord
+	pop	hl
+	call	chkPS
+	ld	a, l
+	or	h
+	ld	hl, 0
+	jr	nz, .skip	; true, keep at 0
+	; false, make 1
+	inc	hl
+.skip:
+	push	hl
+	jp	next
+
+
+.fill 100
+
+	.db	"(parsed)"
+	.dw	$-NOT
+	.db	8
+PARSED:
+	.dw	nativeWord
+	pop	hl
+	call	chkPS
+	call	parseDecimal
+	jr	z, .success
+	; error
+	ld	de, 0
+	push	de	; dummy
+	push	de	; flag
+	jp	next
+.success:
+	push	de
+	ld	de, 1		; flag
+	push	de
+	jp	next
+
+
+.fill 224
+
+	.db	"_bend"
+	.dw	$-PARSED
+	.db	5
+; Offset: 0647
 .out $

forth/icore.fs

@@ -55,29 +55,31 @@
     ,           ( write! )
 ; IMMEDIATE
 
+: JTBL 0x08 ;
+
 : FLAGS
-    ( 52 == FLAGS )
+    ( JTBL+44 == FLAGS )
-    [ 52 @ LITN ]
+    [ JTBL 44 + @ LITN ]
 ;
 
 : (parse*)
-    ( 54 == PARSEPTR )
+    ( JTBL+46 == PARSEPTR )
-    [ 54 @ LITN ]
+    [ JTBL 46 + @ LITN ]
 ;
 
 : HERE
-    ( 56 == HERE )
+    ( JTBL+48 == HERE )
-    [ 56 @ LITN ]
+    [ JTBL 48 + @ LITN ]
 ;
 
 : CURRENT
-    ( 58 == CURRENT )
+    ( JTBL+50 == CURRENT )
-    [ 58 @ LITN ]
+    [ JTBL 50 + @ LITN ]
 ;
 
 : QUIT
     0 _c FLAGS _c ! _c (resRS)
-    LIT< INTERPRET _c (find) _c DROP EXECUTE
+    LIT< INTERPRET (find) _c DROP EXECUTE
 ;
 
 : ABORT _c (resSP) _c QUIT ;
@@ -85,7 +87,7 @@
 ( This is only the "early parser" in earlier stages. No need
   for an abort message )
 : (parse)
-    _c (parsed) _c NOT IF _c ABORT THEN
+    (parsed) NOT IF _c ABORT THEN
 ;
 
 ( a -- )
@@ -94,7 +96,7 @@
     _c DUP      ( a a )
     _c C@       ( a c )
     ( exit if null )
-    _c DUP _c NOT IF _c 2DROP EXIT THEN
+    _c DUP NOT IF _c 2DROP EXIT THEN
     _c EMIT     ( a )
     1 _c +         ( a+1 )
     AGAIN
@@ -105,8 +107,8 @@
 ;
 
 : C<
-    ( 48 == CINPTR )
+    ( JTBL+40 == CINPTR )
-    [ 48 @ LITN ] _c @ EXECUTE
+    [ JTBL 40 + @ LITN ] _c @ EXECUTE
 ;
 
 : C,
@@ -117,19 +119,19 @@
 ( The NOT is to normalize the negative/positive numbers to 1
   or 0. Hadn't we wanted to normalize, we'd have written:
   32 CMP 1 - )
-: WS? 33 _c CMP 1 _c + _c NOT ;
+: WS? 33 _c CMP 1 _c + NOT ;
 
 : TOWORD
     BEGIN
-    _c C< _c DUP _c WS? _c NOT IF EXIT THEN _c DROP
+    _c C< _c DUP _c WS? NOT IF EXIT THEN _c DROP
     AGAIN
 ;
 
 ( Read word from C<, copy to WORDBUF, null-terminate, and
   return, make HL point to WORDBUF. )
 : WORD
-    ( 38 == WORDBUF )
+    ( JTBL+30 == WORDBUF )
-    [ 38 @ LITN ]        ( a )
+    [ JTBL 30 + @ LITN ]        ( a )
     _c TOWORD                   ( a c )
     BEGIN
         ( We take advantage of the fact that char MSB is
@@ -142,13 +144,13 @@
     ( a this point, PS is: a WS )
     ( null-termination is already written )
     _c 2DROP
-    [ 38 @ LITN ]
+    [ JTBL 30 + @ LITN ]
 ;
 
 : (entry)
-    _c HERE _c @    ( h )
+    _c HERE _c @       ( h )
     _c WORD         ( h s )
-    _c SCPY         ( h )
+    SCPY            ( h )
     ( Adjust HERE -1 because SCPY copies the null )
     _c HERE _c @ 1 _c - ( h h' )
     _c DUP _c HERE _c ! ( h h' )
@@ -163,7 +165,7 @@
 : INTERPRET
     BEGIN
     _c WORD
-    _c (find)
+    (find)
     IF
         1 _c FLAGS _c !
         EXECUTE
@@ -175,20 +177,20 @@
 ;
 
 : BOOT
-    LIT< (parse) _c (find) _c DROP _c (parse*) _c !
+    LIT< (parse) (find) _c DROP _c (parse*) _c !
-    LIT< (c<) _c (find) _c
+    LIT< (c<) (find) NOT IF LIT< KEY (find) _c DROP THEN
-    NOT IF LIT< KEY _c (find) _c DROP THEN
+    ( JTBL+40 == CINPTR )
-    ( 48 == CINPTR )
+    [ JTBL 40 + @ LITN ] _c !
-    [ 48 @ LITN ] _c !
+    LIT< (c<$) (find) IF EXECUTE ELSE _c DROP THEN
-    LIT< (c<$) _c (find) IF EXECUTE ELSE _c DROP THEN
     _c INTERPRET
 ;
 
 ( LITN has to be defined after the last immediate usage of
   it to avoid bootstrapping issues )
 : LITN
-    ( 32 == NUMBER )
+    ( JTBL+24 == NUMBER )
-    32 , ,
+    _c JTBL 24 _c + ,
+    ,
 ;
 
 ( : and ; have to be defined last because it can't be
@@ -198,11 +200,11 @@
 : X
     _c (entry)
     ( We cannot use LITN as IMMEDIATE because of bootstrapping
-      issues. 32 == NUMBER 14 == compiledWord )
+      issues. JTBL+24 == NUMBER JTBL+6 == compiledWord )
-    [ 32 , 14 , ] ,
+    [ JTBL 24 + , JTBL 6 + , ] ,
     BEGIN
     _c WORD
-    _c (find)
+    (find)
     ( is word )
     IF _c DUP _c IMMED? IF EXECUTE ELSE , THEN
     ( maybe number )

forth/notes.txt

@@ -1,68 +0,0 @@
-Collapse OS' Forth implementation notes
-
-*** EXECUTION MODEL
-
-After having read a line through readln, we want to interpret it. As a general
-rule, we go like this:
-
-1. read single word from line
-2. Can we find the word in dict?
-3. If yes, execute that word, goto 1
-4. Is it a number?
-5. If yes, push that number to PS, goto 1
-6. Error: undefined word.
-
-*** EXECUTING A WORD
-
-At it's core, executing a word is pushing the wordref on PS and calling EXECUTE.
-Then, we let the word do its things. Some words are special, but most of them
-are of the compiledWord type, and that's their execution that we describe here.
-
-First of all, at all time during execution, the Interpreter Pointer (IP) points
-to the wordref we're executing next.
-
-When we execute a compiledWord, the first thing we do is push IP to the Return
-Stack (RS). Therefore, RS' top of stack will contain a wordref to execute next,
-after we EXIT.
-
-At the end of every compiledWord is an EXIT. This pops RS, sets IP to it, and
-continues.
-
-*** Stack management
-
-The Parameter stack (PS) is maintained by SP and the Return stack (RS) is
-maintained by IX. This allows us to generally use push and pop freely because PS
-is the most frequently used. However, this causes a problem with routine calls:
-because in Forth, the stack isn't balanced within each call, our return offset,
-when placed by a CALL, messes everything up. This is one of the reasons why we
-need stack management routines below. IX always points to RS' Top Of Stack (TOS)
-
-This return stack contain "Interpreter pointers", that is a pointer to the
-address of a word, as seen in a compiled list of words.
-
-*** Dictionary
-
-A dictionary entry has this structure:
-
-- Xb name. Arbitrary long number of character (but can't be bigger than
-  input buffer, of course). not null-terminated
-- 2b prev offset
-- 1b size + IMMEDIATE flag
-- 2b code pointer
-- Parameter field (PF)
-
-The prev offset is the number of bytes between the prev field and the previous
-word's code pointer.
-
-The size + flag indicate the size of the name field, with the 7th bit being the
-IMMEDIATE flag.
-
-The code pointer point to "word routines". These routines expect to be called
-with IY pointing to the PF. They themselves are expected to end by jumping to
-the address at (IP). They will usually do so with "jp next".
-
-That's for "regular" words (words that are part of the dict chain). There are
-also "special words", for example NUMBER, LIT, FBR, that have a slightly
-different structure. They're also a pointer to an executable, but as for the
-other fields, the only one they have is the "flags" field.
-

forth/z80a.fs

@@ -39,9 +39,6 @@
 : OP1 CREATE C, DOES> C@ A, ;
 0xeb OP1 EXDEHL,
 0x76 OP1 HALT,
-0xe9 OP1 JP(HL),
-0x12 OP1 LD(DE)A,
-0x1a OP1 LDA(DE),
 0xc9 OP1 RET,
 0x17 OP1 RLA,
 0x07 OP1 RLCA,
@@ -244,19 +241,19 @@
     SPLITB A, A,
 ;
 
-( 26 == next )
+( JTBL+18 == next )
-: JPNEXT, 26 JPnn, ;
+: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
 
 : CODE
     ( same as CREATE, but with native word )
     (entry)
-    ( 23 == nativeWord )
+    ( JTBL+15 == next )
-    23 ,
+    [ JTBL 15 + LITN ] ,
 ;
 
 : ;CODE JPNEXT, ;
 
 
 ( Routines )
-( 29 == chkPS )
+( JTBL+21 == next )
-: chkPS, 29 CALLnn, ;
+: chkPS, [ JTBL 21 + LITN ] CALLnn, ;

forth/z80c.fs

@@ -149,19 +149,6 @@ CODE XOR
     HL PUSHqq,
 ;CODE
 
-CODE NOT
-    HL POPqq,
-    chkPS,
-    A L LDrr,
-    H ORr,
-    HL 0 LDddnn,
-    3 JRNZe, ( skip)
-    ( false, make 1 )
-    HL INCss,
-( skip )
-    HL PUSHqq,
-;CODE
-
 CODE +
     HL POPqq,
     DE POPqq,
@@ -296,13 +283,13 @@ CODE J
 CODE >R
     HL POPqq,
     chkPS,
-    ( 17 == pushRS )
+    ( JTBL+9 == pushRS )
-    17 CALLnn,
+    JTBL 9 + CALLnn,
 ;CODE
 
 CODE R>
-    ( 20 == popRS )
+    ( JTBL+12 == popRS )
-    20 CALLnn,
+    JTBL 12 + CALLnn,
     HL PUSHqq,
 ;CODE
 
@@ -329,23 +316,23 @@ CODE BYE
 ;CODE
 
 CODE (resSP)
-    ( INITIAL_SP == 36 )
+    ( INITIAL_SP == JTBL+28 )
-    SP 36 @ LDdd(nn),
+    SP JTBL 28 + @ LDdd(nn),
 ;CODE
 
 CODE (resRS)
-    ( RS_ADDR == 46 )
+    ( RS_ADDR == JTBL+38 )
-    IX 46 @ LDddnn,
+    IX JTBL 38 + @ LDddnn,
 ;CODE
 
 CODE SCMP
     DE  POPqq,
     HL  POPqq,
     chkPS,
-    ( 43 == strcmp )
+    ( JTBL+35 == strcmp )
-    43 CALLnn,
+    JTBL 35 + CALLnn,
-    ( 40 == flagsToBC )
+    ( JTBL+32 == flagsToBC )
-    40 CALLnn,
+    JTBL 32 + CALLnn,
     BC PUSHqq,
 ;CODE
 
@@ -355,58 +342,8 @@ CODE CMP
     chkPS,
     A ORr,      ( clear carry )
     DE SBCHLss,
-    ( 40 == flagsToBC )
+    ( JTBL+32 == flagsToBC )
-    40 CALLnn,
+    JTBL 32 + CALLnn,
     BC PUSHqq,
 ;CODE
 
-CODE (parsed)
-    HL POPqq,
-    chkPS,
-    ( 60 == parseDecimal )
-    60 CALLnn,
-    10 JRZe, ( success )
-    ( error )
-    DE 0 LDddnn,
-    DE PUSHqq,  ( dummy )
-    DE PUSHqq,  ( flag )
-    JPNEXT,
-( success )
-    DE PUSHqq,
-    DE 1 LDddnn,
-    DE PUSHqq,
-;CODE
-
-CODE (find)
-    HL POPqq,
-    chkPS,
-    ( 3 == find )
-    3 CALLnn,
-    10 JRZe, ( found )
-    ( not found )
-    HL PUSHqq,
-    DE 0 LDddnn,
-    DE PUSHqq,
-    JPNEXT,
-( found )
-    DE PUSHqq,
-    DE 1 LDddnn,
-    DE PUSHqq,
-;CODE
-
-CODE SCPY
-    HL POPqq,
-    chkPS,
-    DE HERE LDdd(nn),
-    B 0 LDrn,
-( loop )
-    A (HL) LDrr,
-    LD(DE)A,
-    HL INCss,
-    DE INCss,
-    B INCr,
-    A ORr,
-    -6 JRNZe, ( loop )
-    DE A LD(dd)r
-    HERE DE LD(nn)dd,
-;CODE