forth: make forth/forth.asm spit whole binary

emul/forth/stage{0,1}.asm now only configure constants and append
binaries.

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/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:

emul/forth/emul.fs

@@ -0,0 +1,17 @@
+( Implementation fo KEY and EMIT in the emulator
+  stdio port is 0
+)
+
+CODE (emit)
+    HL POPqq,
+    chkPS,
+    A L LDrr,
+    0 OUTnA,
+;CODE
+
+CODE KEY
+    0 INAn,
+    H 0 LDrn,
+    L A LDrr,
+    HL PUSHqq,
+;CODE

emul/forth/stage.c

@@ -29,7 +29,7 @@ trouble of compiling defs to binary.
 
 //#define DEBUG
 // in sync with glue.asm
-#define RAMSTART 0x900
+#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)

emul/forth/stage0.asm

@@ -1,5 +1,3 @@
-	jp	init
-
 .inc "stagec.asm"
 .inc "forth.asm"
 

emul/forth/stage1.asm

@@ -1,5 +1,3 @@
-	jp	init
-
 .inc "stagec.asm"
 .inc "forth.asm"
 

emul/forth/stagec.asm

@@ -2,23 +2,3 @@
 .equ	HERE_INITIAL	CODE_END	; override
 .equ	LATEST		CODE_END	; override
 .equ	STDIO_PORT	0x00
-
-init:
-	di
-	; setup stack
-	ld	sp, 0xffff
-	call	forthMain
-	halt
-
-emulGetC:
-	; Blocks until a char is returned
-	in	a, (STDIO_PORT)
-	cp	a		; ensure Z
-	ret
-
-emulPutC:
-	out	(STDIO_PORT), a
-	ret
-
-.equ	GETC	emulGetC
-.equ	PUTC	emulPutC

forth/dummy.fs

@@ -1,7 +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 )
-(entry) _______
+(entry) _
 
 ( 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

@@ -26,19 +26,14 @@
 .equ	RS_ADDR		0xf000
 ; Number of bytes we keep as a padding between HERE and the scratchpad
 .equ	PADDING		0x20
-; Max length of dict entry names
+; Buffer where WORD copies its read word to.
-.equ	NAMELEN		7
-; Offset of the code link relative to the beginning of the word
-.equ	CODELINK_OFFSET	NAMELEN+3
-; Buffer where WORD copies its read word to. It's significantly larger than
-; NAMELEN, but who knows, in a comment, we might have a very long word...
 .equ	WORD_BUFSIZE		0x20
 ; Allocated space for sysvars (see comment above SYSVCNT)
 .equ	SYSV_BUFSIZE		0x10
 
 ; Flags for the "flag field" of the word structure
 ; IMMEDIATE word
-.equ	FLAG_IMMED	0
+.equ	FLAG_IMMED	7
 
 ; *** Variables ***
 .equ	INITIAL_SP	RAMSTART
@@ -61,6 +56,8 @@
 ; interface in Forth, which we plug in during init. If "(c<)" exists in the
 ; dict, CINPTR is set to it. Otherwise, we set KEY
 .equ	CINPTR		@+2
+; Pointer to (emit) word
+.equ	EMITPTR		@+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
@@ -106,6 +103,8 @@
 ; *** 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.
+; We're at 0 here
+	jp	forthMain
 .fill 0x17-$
 JUMPTBL:
 	jp	nativeWord
@@ -131,16 +130,21 @@ forthMain:
 	ld	hl, HERE_INITIAL
 	ld	(HERE), hl
 	; Set up PARSEPTR
-	ld	hl, PARSE-CODELINK_OFFSET
+	ld	hl, .parseName
 	call	find
 	ld	(PARSEPTR), de
+	; Set up EMITPTR
+	ld	hl, .emitName
+	call	find
+	ld	(EMITPTR), de
 	; Set up CINPTR
 	; do we have a (c<) impl?
 	ld	hl, .cinName
 	call	find
 	jr	z, .skip
 	; no? then use KEY
-	ld	de, KEY
+	ld	hl, .keyName
+	call	find
 .skip:
 	ld	(CINPTR), de
 	; Set up SYSVNXT
@@ -150,8 +154,14 @@ forthMain:
 	push	hl
 	jp	EXECUTE+2
 
+.parseName:
+	.db	"(parse)", 0
 .cinName:
 	.db	"(c<)", 0
+.emitName:
+	.db	"(emit)", 0
+.keyName:
+	.db	"KEY", 0
 
 BEGIN:
 	.dw	compiledWord
@@ -170,23 +180,25 @@ INTERPRET:
 	.dw	FIND_
 	.dw	CSKIP
 	.dw	FBR
-	.db	18
+	.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	ONE			; Bit 0 on
+	.dw	NUMBER			; Bit 0 on
+	.dw	1
 	.dw	FLAGS_
 	.dw	STORE
 	.dw	EXECUTE
-	.dw	ZERO			; Bit 0 off
+	.dw	NUMBER			; Bit 0 off
+	.dw	0
 	.dw	FLAGS_
 	.dw	STORE
 	.dw	BBR
-	.db	25
+	.db	29
 	; FBR mark, try number
 	.dw	PARSEI
 	.dw	BBR
-	.db	30
+	.db	34
 	; infinite loop
 
 ; *** Collapse OS lib copy ***
@@ -221,13 +233,17 @@ addHL:
 ; 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, strcpy
+	jr	nz, .loop
 	ret
 
 ; Compares strings pointed to by HL and DE until one of them hits its null char.
@@ -254,38 +270,6 @@ strcmp:
 	; early, set otherwise)
 	ret
 
-; Compares strings pointed to by HL and DE up to NAMELEN count of characters. If
-; equal, Z is set. If not equal, Z is reset.
-strncmp:
-	push	bc
-	push	hl
-	push	de
-
-	ld	b, NAMELEN
-.loop:
-	ld	a, (de)
-	cp	(hl)
-	jr	nz, .end	; not equal? break early. NZ is carried out
-				; to the called
-	or	a		; If our chars are null, stop the cmp
-	jr	z, .end		; The positive result will be carried to the
-	                        ; caller
-	inc	hl
-	inc	de
-	djnz	.loop
-	; We went through all chars with success, but our current Z flag is
-	; unset because of the cp 0. Let's do a dummy CP to set the Z flag.
-	cp	a
-
-.end:
-	pop	de
-	pop	hl
-	pop	bc
-	; Because we don't call anything else than CP that modify the Z flag,
-	; our Z value will be that of the last cp (reset if we broke the loop
-	; early, set otherwise)
-	ret
-
 ; Given a string at (HL), move HL until it points to the end of that string.
 strskip:
 	push	bc
@@ -370,51 +354,82 @@ parseDecimal:
 ; point to that entry.
 ; Z if found, NZ if not.
 find:
-	push	hl
 	push	bc
-	ld	de, (CURRENT)
+	push	hl
-	ld	bc, CODELINK_OFFSET
+	; First, figure out string len
-.inner:
+	ld	bc, 0
-	; DE is a wordref, let's go to beginning of struct
-	push	de		; --> lvl 1
-	or	a		; clear carry
-	ex	de, hl
-	sbc	hl, bc
-	ex	de, hl		; We're good, DE points to word name
-	call	strncmp
-	pop	de		; <-- lvl 1, return to wordref
-	jr	z, .end		; found
-	push	hl		; .prev destroys HL
-	call	.prev
-	pop	hl
-	jr	nz, .inner
-	; Z set? end of dict unset Z
 	xor	a
-	inc	a
+	cpir
-.end:
+	; C has our length, negative, -1
-	pop	bc
+	ld	a, c
-	pop	hl
+	neg
-	ret
+	dec	a
-
+	; special case. zero len? we never find anything.
-; For DE being a wordref, move DE to the previous wordref.
+	jr	z, .fail
-; Z is set if DE point to 0 (no entry). NZ if not.
+	ld	c, a		; C holds our length
-.prev:
+	; Let's do something weird: We'll hold HL by the *tail*. Because of our
+	; dict structure and because we know our lengths, it's easier to
+	; compare starting from the end. Currently, after CPIR, HL points to
+	; char after null. Let's adjust
+	; Because the compare loop pre-decrements, instead of DECing HL twice,
+	; we DEC it once.
+	dec	hl
+	ld	de, (CURRENT)
+.inner:
+	; DE is a wordref. First step, do our len correspond?
+	push	hl		; --> lvl 1
+	push	de		; --> lvl 2
+	dec	de
+	ld	a, (de)
+	and	0x7f		; remove IMMEDIATE flag
+	cp	c
+	jr	nz, .loopend
+	; match, let's compare the string then
+	dec	de \ dec de	; skip prev field. One less because we
+				; pre-decrement
+	ld	b, c		; loop C times
+.loop:
+	; pre-decrement for easier Z matching
+	dec	de
+	dec	hl
+	ld	a, (de)
+	cp	(hl)
+	jr	nz, .loopend
+	djnz	.loop
+.loopend:
+	; At this point, Z is set if we have a match. In all cases, we want
+	; to pop HL and DE
+	pop	de		; <-- lvl 2
+	pop	hl		; <-- lvl 1
+	jr	z, .end		; match? we're done!
+	; no match, go to prev and continue
+	push	hl			; --> lvl 1
 	dec	de \ dec de \ dec de	; prev field
-	push	de			; --> lvl 1
+	push	de			; --> lvl 2
 	ex 	de, hl
 	call 	intoHL
 	ex 	de, hl			; DE contains prev offset
-	pop	hl			; <-- lvl 1
+	pop	hl			; <-- lvl 2
 	; HL is prev field's addr
 	; Is offset zero?
 	ld	a, d
 	or	e
-	ret	z			; no prev entry
+	jr	z, .noprev		; no prev entry
 	; get absolute addr from offset
 	; carry cleared from "or e"
 	sbc	hl, de
 	ex	de, hl			; result in DE
-	ret				; NZ set from SBC
+.noprev:
+	pop	hl			; <-- lvl 1
+	jr	nz, .inner		; try to match again
+	; Z set? end of dict unset Z
+.fail:
+	xor	a
+	inc	a
+.end:
+	pop	hl
+	pop	bc
+	ret
 
 ; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
 flagsToBC:
@@ -495,15 +510,19 @@ chkPS:
 ; *** Dictionary ***
 ; It's important that this part is at the end of the resulting binary.
 ; A dictionary entry has this structure:
-; - 7b name (zero-padded)
+; - Xb name. Arbitrary long number of character (but can't be bigger than
+;   input buffer, of course). not null-terminated
 ; - 2b prev offset
-; - 1b flags (bit 0: IMMEDIATE)
+; - 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".
@@ -611,9 +630,8 @@ LIT:
 ; Pop previous IP from Return stack and execute it.
 ; ( R:I -- )
 	.db	"EXIT"
-	.fill	3
 	.dw	0
-	.db	0
+	.db	4
 EXIT:
 	.dw nativeWord
 	call	popRSIP
@@ -621,12 +639,12 @@ EXIT:
 
 ; ( R:I -- )
 	.db "QUIT"
-	.fill 3
 	.dw $-EXIT
-	.db 0
+	.db 4
 QUIT:
 	.dw compiledWord
-	.dw	ZERO
+	.dw	NUMBER
+	.dw	0
 	.dw	FLAGS_
 	.dw	STORE
 	.dw	.private
@@ -638,9 +656,8 @@ QUIT:
 	jp	next
 
 	.db "ABORT"
-	.fill 2
 	.dw $-QUIT
-	.db 0
+	.db 5
 ABORT:
 	.dw	compiledWord
 	.dw	.private
@@ -664,51 +681,63 @@ abortUnderflow:
 	.dw	ABORT
 
 	.db "BYE"
-	.fill 4
 	.dw $-ABORT
-	.db 0
+	.db 3
 BYE:
 	.dw nativeWord
-	; Goodbye Forth! Before we go, let's restore the stack
+	halt
-	ld	sp, (INITIAL_SP)
-	; unwind stack underflow buffer
-	pop	af \ pop af \ pop af
-	; success
-	xor	a
-	ret
 
 ; ( c -- )
 	.db "EMIT"
-	.fill 3
 	.dw $-BYE
-	.db 0
+	.db 4
 EMIT:
-	.dw nativeWord
+	.dw	compiledWord
-	pop	hl
+	.dw	NUMBER
-	call	chkPS
+	.dw	EMITPTR
-	ld	a, l
+	.dw	FETCH
-	call	PUTC
+	.dw	EXECUTE
-	jp	next
+	.dw	EXIT
+
 
 	.db	"(print)"
 	.dw	$-EMIT
-	.db	0
+	.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
-.loop:
+	ld	l, (hl)
-	ld	a, (hl)		; load character to send
+	ld	h, 0
-	or	a		; is it zero?
+	push	hl
-	jp	z, next		; if yes, we're finished
+	jp	next
-	call	PUTC
+
-	inc	hl
-	jr	.loop
 
 	.db	"C,"
-	.fill	5
 	.dw	$-PRINT
-	.db	0
+	.db	2
 CWR:
 	.dw	nativeWord
 	pop	de
@@ -721,9 +750,8 @@ CWR:
 
 
 	.db	","
-	.fill	6
 	.dw	$-CWR
-	.db	0
+	.db	1
 WR:
 	.dw	nativeWord
 	pop	de
@@ -736,7 +764,7 @@ WR:
 
 	.db	"ROUTINE"
 	.dw	$-WR
-	.db	1			; IMMEDIATE
+	.db	0x87			; IMMEDIATE
 ROUTINE:
 	.dw	compiledWord
 	.dw	WORD
@@ -791,7 +819,7 @@ ROUTINE:
 ; ( addr -- )
 	.db "EXECUTE"
 	.dw $-ROUTINE
-	.db 0
+	.db 7
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
@@ -806,9 +834,8 @@ EXECUTE:
 
 
 	.db	";"
-	.fill	6
 	.dw	$-EXECUTE
-	.db	1		; IMMEDIATE
+	.db	0x81		; IMMEDIATE
 ENDDEF:
 	.dw	compiledWord
 	.dw	NUMBER
@@ -821,9 +848,8 @@ ENDDEF:
 	.dw	EXIT
 
 	.db	":"
-	.fill	6
 	.dw	$-ENDDEF
-	.db	1		; IMMEDIATE
+	.db	0x81		; IMMEDIATE
 DEFINE:
 	.dw	compiledWord
 	.dw	ENTRYHEAD
@@ -865,9 +891,8 @@ DEFINE:
 
 
 	.db "DOES>"
-	.fill 2
 	.dw $-DEFINE
-	.db 0
+	.db 5
 DOES:
 	.dw nativeWord
 	; We run this when we're in an entry creation context. Many things we
@@ -886,9 +911,9 @@ DOES:
 	jp	EXIT+2
 
 
-	.db "IMMEDIA"
+	.db "IMMEDIATE"
 	.dw $-DOES
-	.db 0
+	.db 9
 IMMEDIATE:
 	.dw nativeWord
 	ld	hl, (CURRENT)
@@ -898,9 +923,8 @@ IMMEDIATE:
 
 
 	.db	"IMMED?"
-	.fill	1
 	.dw	$-IMMEDIATE
-	.db	0
+	.db	6
 ISIMMED:
 	.dw	nativeWord
 	pop	hl
@@ -916,9 +940,8 @@ ISIMMED:
 
 ; ( n -- )
 	.db	"LITN"
-	.fill	3
 	.dw	$-ISIMMED
-	.db	0
+	.db	4
 LITN:
 	.dw nativeWord
 	ld	hl, (HERE)
@@ -931,9 +954,8 @@ LITN:
 	jp	next
 
 	.db	"SCPY"
-	.fill	3
 	.dw	$-LITN
-	.db	0
+	.db	4
 SCPY:
 	.dw	nativeWord
 	pop	hl
@@ -944,9 +966,8 @@ SCPY:
 
 
 	.db	"(find)"
-	.fill	1
 	.dw	$-SCPY
-	.db	0
+	.db	6
 FIND_:
 	.dw	nativeWord
 	pop	hl
@@ -963,25 +984,11 @@ FIND_:
 	push	de
 	jp	next
 
-; ( -- c )
-	.db "KEY"
-	.fill 4
-	.dw $-FIND_
-	.db 0
-KEY:
-	.dw nativeWord
-	call	GETC
-	ld	h, 0
-	ld	l, a
-	push	hl
-	jp	next
-
 ; This is an indirect word that can be redirected through "CINPTR"
 ; code: it is replaced in readln.fs.
 	.db "C<"
-	.fill 5
+	.dw $-FIND_
-	.dw $-KEY
+	.db 2
-	.db 0
 CIN:
 	.dw	compiledWord
 	.dw	NUMBER
@@ -997,23 +1004,22 @@ CIN:
 ; Hadn't we wanted to normalize, we'd have written:
 ; 32 CMP 1 -
 	.db	"WS?"
-	.fill	4
 	.dw	$-CIN
-	.db	0
+	.db	3
 ISWS:
 	.dw	compiledWord
 	.dw	NUMBER
 	.dw	33
 	.dw	CMP
-	.dw	ONE
+	.dw	NUMBER
+	.dw	1
 	.dw	PLUS
 	.dw	NOT
 	.dw	EXIT
 
 	.db	"NOT"
-	.fill	4
 	.dw	$-ISWS
-	.db	0
+	.db	3
 NOT:
 	.dw	nativeWord
 	pop	hl
@@ -1031,9 +1037,8 @@ NOT:
 ; ( -- c )
 ; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
 	.db	"TOWORD"
-	.fill	1
 	.dw	$-NOT
-	.db	0
+	.db	6
 TOWORD:
 	.dw	compiledWord
 	.dw	CIN
@@ -1048,9 +1053,8 @@ TOWORD:
 ; Read word from C<, copy to WORDBUF, null-terminate, and return, make
 ; HL point to WORDBUF.
 	.db "WORD"
-	.fill 3
 	.dw $-TOWORD
-	.db 0
+	.db 4
 WORD:
 	.dw	compiledWord
 	.dw	NUMBER		; ( a )
@@ -1059,17 +1063,19 @@ WORD:
 	; branch mark
 	.dw	OVER		; ( a c a )
 	.dw	STORE		; ( a )
-	.dw	ONE		; ( a 1 )
+	.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 )
 	.dw	BBR
-	.db	18	; here - mark
+	.db	20	; here - mark
 	; at this point, we have ( a WS )
 	.dw	DROP
-	.dw	ZERO
+	.dw	NUMBER
+	.dw	0
 	.dw	SWAP		; ( 0 a )
 	.dw	STORE		; ()
 	.dw	NUMBER
@@ -1095,9 +1101,9 @@ WORD:
 	jp	next
 
 
-	.db	"(parsed"
+	.db	"(parsed)"
 	.dw	$-WORD
-	.db	0
+	.db	8
 PARSED:
 	.dw	nativeWord
 	pop	hl
@@ -1118,7 +1124,7 @@ PARSED:
 
 	.db	"(parse)"
 	.dw	$-PARSED
-	.db	0
+	.db	7
 PARSE:
 	.dw	compiledWord
 	.dw	PARSED
@@ -1148,7 +1154,7 @@ PARSEI:
 ; HL points to new (HERE)
 	.db	"(entry)"
 	.dw	$-PARSE
-	.db	0
+	.db	7
 ENTRYHEAD:
 	.dw	compiledWord
 	.dw	WORD
@@ -1160,19 +1166,21 @@ ENTRYHEAD:
 	pop	hl
 	ld	de, (HERE)
 	call	strcpy
-	ld	hl, (HERE)
+	; 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)
-	ld	a, NAMELEN
-	call	addHL
 	push	hl		; --> lvl 1
 	or	a	; clear carry
 	sbc	hl, de
 	ex	de, hl
 	pop	hl		; <-- lvl 1
 	call	DEinHL
-	; Set word flags: not IMMED, so it's 0
+	; Save size
-	xor	a
+	ld	(hl), b
-	ld	(hl), a
 	inc	hl
 	ld	(CURRENT), hl
 	ld	(HERE), hl
@@ -1180,47 +1188,44 @@ ENTRYHEAD:
 
 
 	.db "HERE"
-	.fill 3
 	.dw $-ENTRYHEAD
-	.db 0
+	.db 4
 HERE_:	; Caution: conflicts with actual variable name
 	.dw sysvarWord
 	.dw HERE
 
 	.db "CURRENT"
 	.dw $-HERE_
-	.db 0
+	.db 7
 CURRENT_:
 	.dw sysvarWord
 	.dw CURRENT
 
-	.db "(parse*"
+	.db "(parse*)"
 	.dw $-CURRENT_
-	.db 0
+	.db 8
 PARSEPTR_:
 	.dw sysvarWord
 	.dw PARSEPTR
 
 	.db	"FLAGS"
-	.fill	2
 	.dw	$-PARSEPTR_
-	.db	0
+	.db	5
 FLAGS_:
 	.dw	sysvarWord
 	.dw	FLAGS
 
 	.db	"SYSVNXT"
 	.dw	$-FLAGS_
-	.db	0
+	.db	7
 SYSVNXT_:
 	.dw	sysvarWord
 	.dw	SYSVNXT
 
 ; ( n a -- )
 	.db "!"
-	.fill 6
 	.dw $-SYSVNXT_
-	.db 0
+	.db 1
 STORE:
 	.dw nativeWord
 	pop	iy
@@ -1232,9 +1237,8 @@ STORE:
 
 ; ( a -- n )
 	.db "@"
-	.fill 6
 	.dw $-STORE
-	.db 0
+	.db 1
 FETCH:
 	.dw nativeWord
 	pop	hl
@@ -1245,9 +1249,8 @@ FETCH:
 
 ; ( a -- )
 	.db "DROP"
-	.fill 3
 	.dw $-FETCH
-	.db 0
+	.db 4
 DROP:
 	.dw nativeWord
 	pop	hl
@@ -1255,9 +1258,8 @@ DROP:
 
 ; ( a b -- b a )
 	.db "SWAP"
-	.fill 3
 	.dw $-DROP
-	.db 0
+	.db 4
 SWAP:
 	.dw nativeWord
 	pop	hl
@@ -1268,9 +1270,8 @@ SWAP:
 
 ; ( a -- a a )
 	.db "DUP"
-	.fill 4
 	.dw $-SWAP
-	.db 0
+	.db 3
 DUP:
 	.dw nativeWord
 	pop	hl
@@ -1281,9 +1282,8 @@ DUP:
 
 ; ( a b -- a b a )
 	.db "OVER"
-	.fill 3
 	.dw $-DUP
-	.db 0
+	.db 4
 OVER:
 	.dw nativeWord
 	pop	hl	; B
@@ -1295,9 +1295,8 @@ OVER:
 	jp	next
 
 	.db	">R"
-	.fill	5
 	.dw	$-OVER
-	.db	0
+	.db	2
 P2R:
 	.dw	nativeWord
 	pop	hl
@@ -1306,9 +1305,8 @@ P2R:
 	jp	next
 
 	.db	"R>"
-	.fill	5
 	.dw	$-P2R
-	.db	0
+	.db	2
 R2P:
 	.dw	nativeWord
 	call	popRS
@@ -1316,9 +1314,8 @@ R2P:
 	jp	next
 
 	.db	"I"
-	.fill	6
 	.dw	$-R2P
-	.db	0
+	.db	1
 I:
 	.dw	nativeWord
 	ld	l, (ix)
@@ -1327,9 +1324,8 @@ I:
 	jp	next
 
 	.db	"I'"
-	.fill	5
 	.dw	$-I
-	.db	0
+	.db	2
 IPRIME:
 	.dw	nativeWord
 	ld	l, (ix-2)
@@ -1338,9 +1334,8 @@ IPRIME:
 	jp	next
 
 	.db	"J"
-	.fill	6
 	.dw	$-IPRIME
-	.db	0
+	.db	1
 J:
 	.dw	nativeWord
 	ld	l, (ix-4)
@@ -1350,9 +1345,8 @@ J:
 
 ; ( a b -- c ) A + B
 	.db "+"
-	.fill 6
 	.dw $-J
-	.db 0
+	.db 1
 PLUS:
 	.dw nativeWord
 	pop	hl
@@ -1364,9 +1358,8 @@ PLUS:
 
 ; ( a b -- c ) A - B
 	.db "-"
-	.fill 6
 	.dw $-PLUS
-	.db 0
+	.db 1
 MINUS:
 	.dw nativeWord
 	pop	de		; B
@@ -1379,9 +1372,8 @@ MINUS:
 
 ; ( a b -- c ) A * B
 	.db "*"
-	.fill 6
 	.dw $-MINUS
-	.db 0
+	.db 1
 MULT:
 	.dw nativeWord
 	pop	de
@@ -1404,36 +1396,10 @@ MULT:
 	push	hl
 	jp	next
 
-
-; It might look peculiar to have specific words for "0" and "1", but although
-; it slightly beefs ups the ASM part of the binary, this one-byte-save-per-use
-; really adds up when we compare total size.
-
-	.db	"0"
-	.fill	6
-	.dw	$-MULT
-	.db	0
-ZERO:
-	.dw	nativeWord
-	ld	hl, 0
-	push	hl
-	jp	next
-
-	.db	"1"
-	.fill	6
-	.dw	$-ZERO
-	.db	0
-ONE:
-	.dw	nativeWord
-	ld	hl, 1
-	push	hl
-	jp	next
-
 ; ( a1 a2 -- b )
 	.db "SCMP"
-	.fill 3
+	.dw $-MULT
-	.dw $-ONE
+	.db 4
-	.db 0
 SCMP:
 	.dw nativeWord
 	pop	de
@@ -1446,9 +1412,8 @@ SCMP:
 
 ; ( n1 n2 -- f )
 	.db "CMP"
-	.fill 4
 	.dw $-SCMP
-	.db 0
+	.db 3
 CMP:
 	.dw nativeWord
 	pop	hl
@@ -1464,9 +1429,8 @@ CMP:
 ; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
 ; to after null-termination.
 	.db	"SKIP?"
-	.fill	2
 	.dw	$-CMP
-	.db	0
+	.db	5
 CSKIP:
 	.dw	nativeWord
 	pop	hl
@@ -1522,9 +1486,8 @@ CSKIP:
 ; where to branch to. For example, The branching cell of "IF THEN" would
 ; contain 3. Add this value to RS.
 	.db	"(fbr)"
-	.fill	2
 	.dw	$-CSKIP
-	.db	0
+	.db	5
 FBR:
 	.dw	nativeWord
 	push	de
@@ -1536,9 +1499,8 @@ FBR:
 	jp	next
 
 	.db	"(bbr)"
-	.fill	2
 	.dw	$-FBR
-	.db	0
+	.db	5
 BBR:
 	.dw	nativeWord
 	ld	hl, (IP)
@@ -1552,7 +1514,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	"_______"
 	.dw	$-BBR
 	.db	0

forth/z80a.fs

@@ -61,6 +61,7 @@
 0xa0 OP1r0 ANDr,
 0xb0 OP1r0 ORr,
 0xa8 OP1r0 XORr,
+0xb8 OP1r0 CPr,
 
 ( qq -- also works for ss )
 : OP1qq
@@ -93,7 +94,7 @@
     DOES>
     C@ A, A,
 ;
-0xd3 OP2n OUTAn,
+0xd3 OP2n OUTnA,
 0xdb OP2n INAn,
 
 ( r n -- )

forth/z80c.fs

@@ -17,6 +17,9 @@
   These restrictions are temporary, I'll figure something out
   so that we can end up fully bootstrap Forth from within
   itself.
+
+  Oh, also: KEY and EMIT are not defined here. There're
+  expected to be defined in platform-specific code.
 )
 
 ( a b c -- b c a )