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/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
+	cat ../forth/dummy.fs ../forth/z80c.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
 
 .PHONY: clean
 clean:

emul/forth/emul.fs

@@ -1,17 +0,0 @@
-( 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 0x890
+#define RAMSTART 0x900
 #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,3 +1,5 @@
+	jp	init
+
 .inc "stagec.asm"
 .inc "forth.asm"
 

emul/forth/stage1.asm

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

emul/forth/stagec.asm

@@ -2,3 +2,23 @@
 .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,14 +26,19 @@
 .equ	RS_ADDR		0xf000
 ; Number of bytes we keep as a padding between HERE and the scratchpad
 .equ	PADDING		0x20
-; Buffer where WORD copies its read word to.
+; Max length of dict entry names
+.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	7
+.equ	FLAG_IMMED	0
 
 ; *** Variables ***
 .equ	INITIAL_SP	RAMSTART
@@ -56,8 +61,6 @@
 ; 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
@@ -103,8 +106,6 @@
 ; *** 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
@@ -130,21 +131,16 @@ forthMain:
 	ld	hl, HERE_INITIAL
 	ld	(HERE), hl
 	; Set up PARSEPTR
-	ld	hl, .parseName
+	ld	hl, PARSE-CODELINK_OFFSET
 	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	hl, .keyName
+	ld	de, KEY
-	call	find
 .skip:
 	ld	(CINPTR), de
 	; Set up SYSVNXT
@@ -154,14 +150,8 @@ 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
@@ -180,25 +170,23 @@ INTERPRET:
 	.dw	FIND_
 	.dw	CSKIP
 	.dw	FBR
-	.db	22
+	.db	18
 	; 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	ONE			; Bit 0 on
-	.dw	1
 	.dw	FLAGS_
 	.dw	STORE
 	.dw	EXECUTE
-	.dw	NUMBER			; Bit 0 off
+	.dw	ZERO			; Bit 0 off
-	.dw	0
 	.dw	FLAGS_
 	.dw	STORE
 	.dw	BBR
-	.db	29
+	.db	25
 	; FBR mark, try number
 	.dw	PARSEI
 	.dw	BBR
-	.db	34
+	.db	30
 	; infinite loop
 
 ; *** Collapse OS lib copy ***
@@ -233,17 +221,13 @@ 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, .loop
+	jr	nz, strcpy
 	ret
 
 ; Compares strings pointed to by HL and DE until one of them hits its null char.
@@ -270,6 +254,38 @@ 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
@@ -354,82 +370,51 @@ parseDecimal:
 ; point to that entry.
 ; Z if found, NZ if not.
 find:
-	push	bc
 	push	hl
-	; First, figure out string len
+	push	bc
-	ld	bc, 0
-	xor	a
-	cpir
-	; C has our length, negative, -1
-	ld	a, c
-	neg
-	dec	a
-	; special case. zero len? we never find anything.
-	jr	z, .fail
-	ld	c, a		; C holds our length
-	; 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)
+	ld	bc, CODELINK_OFFSET
 .inner:
-	; DE is a wordref. First step, do our len correspond?
+	; DE is a wordref, let's go to beginning of struct
-	push	hl		; --> lvl 1
+	push	de		; --> lvl 1
-	push	de		; --> lvl 2
+	or	a		; clear carry
-	dec	de
+	ex	de, hl
-	ld	a, (de)
+	sbc	hl, bc
-	and	0x7f		; remove IMMEDIATE flag
+	ex	de, hl		; We're good, DE points to word name
-	cp	c
+	call	strncmp
-	jr	nz, .loopend
+	pop	de		; <-- lvl 1, return to wordref
-	; match, let's compare the string then
+	jr	z, .end		; found
-	dec	de \ dec de	; skip prev field. One less because we
+	push	hl		; .prev destroys HL
-				; pre-decrement
+	call	.prev
-	ld	b, c		; loop C times
+	pop	hl
-.loop:
+	jr	nz, .inner
-	; pre-decrement for easier Z matching
+	; Z set? end of dict unset Z
-	dec	de
+	xor	a
-	dec	hl
+	inc	a
-	ld	a, (de)
+.end:
-	cp	(hl)
+	pop	bc
-	jr	nz, .loopend
+	pop	hl
-	djnz	.loop
+	ret
-.loopend:
+
-	; At this point, Z is set if we have a match. In all cases, we want
+; For DE being a wordref, move DE to the previous wordref.
-	; to pop HL and DE
+; Z is set if DE point to 0 (no entry). NZ if not.
-	pop	de		; <-- lvl 2
+.prev:
-	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 2
+	push	de			; --> lvl 1
 	ex 	de, hl
 	call 	intoHL
 	ex 	de, hl			; DE contains prev offset
-	pop	hl			; <-- lvl 2
+	pop	hl			; <-- lvl 1
 	; HL is prev field's addr
 	; Is offset zero?
 	ld	a, d
 	or	e
-	jr	z, .noprev		; no prev entry
+	ret	z			; no prev entry
 	; get absolute addr from offset
 	; carry cleared from "or e"
 	sbc	hl, de
 	ex	de, hl			; result in DE
-.noprev:
+	ret				; NZ set from SBC
-	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:
@@ -510,19 +495,15 @@ chkPS:
 ; *** Dictionary ***
 ; It's important that this part is at the end of the resulting binary.
 ; A dictionary entry has this structure:
-; - Xb name. Arbitrary long number of character (but can't be bigger than
+; - 7b name (zero-padded)
-;   input buffer, of course). not null-terminated
 ; - 2b prev offset
-; - 1b size + IMMEDIATE flag
+; - 1b flags (bit 0: IMMEDIATE)
 ; - 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".
@@ -630,8 +611,9 @@ LIT:
 ; Pop previous IP from Return stack and execute it.
 ; ( R:I -- )
 	.db	"EXIT"
+	.fill	3
 	.dw	0
-	.db	4
+	.db	0
 EXIT:
 	.dw nativeWord
 	call	popRSIP
@@ -639,12 +621,12 @@ EXIT:
 
 ; ( R:I -- )
 	.db "QUIT"
+	.fill 3
 	.dw $-EXIT
-	.db 4
+	.db 0
 QUIT:
 	.dw compiledWord
-	.dw	NUMBER
+	.dw	ZERO
-	.dw	0
 	.dw	FLAGS_
 	.dw	STORE
 	.dw	.private
@@ -656,8 +638,9 @@ QUIT:
 	jp	next
 
 	.db "ABORT"
+	.fill 2
 	.dw $-QUIT
-	.db 5
+	.db 0
 ABORT:
 	.dw	compiledWord
 	.dw	.private
@@ -681,63 +664,51 @@ abortUnderflow:
 	.dw	ABORT
 
 	.db "BYE"
+	.fill 4
 	.dw $-ABORT
-	.db 3
+	.db 0
 BYE:
 	.dw nativeWord
-	halt
+	; Goodbye Forth! Before we go, let's restore the stack
+	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 4
+	.db 0
 EMIT:
-	.dw	compiledWord
+	.dw nativeWord
-	.dw	NUMBER
+	pop	hl
-	.dw	EMITPTR
+	call	chkPS
-	.dw	FETCH
+	ld	a, l
-	.dw	EXECUTE
+	call	PUTC
-	.dw	EXIT
+	jp	next
-
 
 	.db	"(print)"
 	.dw	$-EMIT
-	.db	7
+	.db	0
 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)
+.loop:
-	ld	h, 0
+	ld	a, (hl)		; load character to send
-	push	hl
+	or	a		; is it zero?
-	jp	next
+	jp	z, next		; if yes, we're finished
-
+	call	PUTC
+	inc	hl
+	jr	.loop
 
 	.db	"C,"
+	.fill	5
 	.dw	$-PRINT
-	.db	2
+	.db	0
 CWR:
 	.dw	nativeWord
 	pop	de
@@ -750,8 +721,9 @@ CWR:
 
 
 	.db	","
+	.fill	6
 	.dw	$-CWR
-	.db	1
+	.db	0
 WR:
 	.dw	nativeWord
 	pop	de
@@ -764,7 +736,7 @@ WR:
 
 	.db	"ROUTINE"
 	.dw	$-WR
-	.db	0x87			; IMMEDIATE
+	.db	1			; IMMEDIATE
 ROUTINE:
 	.dw	compiledWord
 	.dw	WORD
@@ -819,7 +791,7 @@ ROUTINE:
 ; ( addr -- )
 	.db "EXECUTE"
 	.dw $-ROUTINE
-	.db 7
+	.db 0
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
@@ -834,8 +806,9 @@ EXECUTE:
 
 
 	.db	";"
+	.fill	6
 	.dw	$-EXECUTE
-	.db	0x81		; IMMEDIATE
+	.db	1		; IMMEDIATE
 ENDDEF:
 	.dw	compiledWord
 	.dw	NUMBER
@@ -848,8 +821,9 @@ ENDDEF:
 	.dw	EXIT
 
 	.db	":"
+	.fill	6
 	.dw	$-ENDDEF
-	.db	0x81		; IMMEDIATE
+	.db	1		; IMMEDIATE
 DEFINE:
 	.dw	compiledWord
 	.dw	ENTRYHEAD
@@ -891,8 +865,9 @@ DEFINE:
 
 
 	.db "DOES>"
+	.fill 2
 	.dw $-DEFINE
-	.db 5
+	.db 0
 DOES:
 	.dw nativeWord
 	; We run this when we're in an entry creation context. Many things we
@@ -911,9 +886,9 @@ DOES:
 	jp	EXIT+2
 
 
-	.db "IMMEDIATE"
+	.db "IMMEDIA"
 	.dw $-DOES
-	.db 9
+	.db 0
 IMMEDIATE:
 	.dw nativeWord
 	ld	hl, (CURRENT)
@@ -923,8 +898,9 @@ IMMEDIATE:
 
 
 	.db	"IMMED?"
+	.fill	1
 	.dw	$-IMMEDIATE
-	.db	6
+	.db	0
 ISIMMED:
 	.dw	nativeWord
 	pop	hl
@@ -940,8 +916,9 @@ ISIMMED:
 
 ; ( n -- )
 	.db	"LITN"
+	.fill	3
 	.dw	$-ISIMMED
-	.db	4
+	.db	0
 LITN:
 	.dw nativeWord
 	ld	hl, (HERE)
@@ -954,8 +931,9 @@ LITN:
 	jp	next
 
 	.db	"SCPY"
+	.fill	3
 	.dw	$-LITN
-	.db	4
+	.db	0
 SCPY:
 	.dw	nativeWord
 	pop	hl
@@ -966,8 +944,9 @@ SCPY:
 
 
 	.db	"(find)"
+	.fill	1
 	.dw	$-SCPY
-	.db	6
+	.db	0
 FIND_:
 	.dw	nativeWord
 	pop	hl
@@ -984,11 +963,25 @@ 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<"
-	.dw $-FIND_
+	.fill 5
-	.db 2
+	.dw $-KEY
+	.db 0
 CIN:
 	.dw	compiledWord
 	.dw	NUMBER
@@ -1004,22 +997,23 @@ CIN:
 ; Hadn't we wanted to normalize, we'd have written:
 ; 32 CMP 1 -
 	.db	"WS?"
+	.fill	4
 	.dw	$-CIN
-	.db	3
+	.db	0
 ISWS:
 	.dw	compiledWord
 	.dw	NUMBER
 	.dw	33
 	.dw	CMP
-	.dw	NUMBER
+	.dw	ONE
-	.dw	1
 	.dw	PLUS
 	.dw	NOT
 	.dw	EXIT
 
 	.db	"NOT"
+	.fill	4
 	.dw	$-ISWS
-	.db	3
+	.db	0
 NOT:
 	.dw	nativeWord
 	pop	hl
@@ -1037,8 +1031,9 @@ NOT:
 ; ( -- c )
 ; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
 	.db	"TOWORD"
+	.fill	1
 	.dw	$-NOT
-	.db	6
+	.db	0
 TOWORD:
 	.dw	compiledWord
 	.dw	CIN
@@ -1053,8 +1048,9 @@ TOWORD:
 ; Read word from C<, copy to WORDBUF, null-terminate, and return, make
 ; HL point to WORDBUF.
 	.db "WORD"
+	.fill 3
 	.dw $-TOWORD
-	.db 4
+	.db 0
 WORD:
 	.dw	compiledWord
 	.dw	NUMBER		; ( a )
@@ -1063,19 +1059,17 @@ WORD:
 	; branch mark
 	.dw	OVER		; ( a c a )
 	.dw	STORE		; ( a )
-	.dw	NUMBER		; ( a 1 )
+	.dw	ONE		; ( 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	20	; here - mark
+	.db	18	; here - mark
 	; at this point, we have ( a WS )
 	.dw	DROP
-	.dw	NUMBER
+	.dw	ZERO
-	.dw	0
 	.dw	SWAP		; ( 0 a )
 	.dw	STORE		; ()
 	.dw	NUMBER
@@ -1101,9 +1095,9 @@ WORD:
 	jp	next
 
 
-	.db	"(parsed)"
+	.db	"(parsed"
 	.dw	$-WORD
-	.db	8
+	.db	0
 PARSED:
 	.dw	nativeWord
 	pop	hl
@@ -1124,7 +1118,7 @@ PARSED:
 
 	.db	"(parse)"
 	.dw	$-PARSED
-	.db	7
+	.db	0
 PARSE:
 	.dw	compiledWord
 	.dw	PARSED
@@ -1154,7 +1148,7 @@ PARSEI:
 ; HL points to new (HERE)
 	.db	"(entry)"
 	.dw	$-PARSE
-	.db	7
+	.db	0
 ENTRYHEAD:
 	.dw	compiledWord
 	.dw	WORD
@@ -1166,21 +1160,19 @@ ENTRYHEAD:
 	pop	hl
 	ld	de, (HERE)
 	call	strcpy
-	; DE point to char after null, rewind.
+	ld	hl, (HERE)
-	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
-	; Save size
+	; Set word flags: not IMMED, so it's 0
-	ld	(hl), b
+	xor	a
+	ld	(hl), a
 	inc	hl
 	ld	(CURRENT), hl
 	ld	(HERE), hl
@@ -1188,44 +1180,47 @@ ENTRYHEAD:
 
 
 	.db "HERE"
+	.fill 3
 	.dw $-ENTRYHEAD
-	.db 4
+	.db 0
 HERE_:	; Caution: conflicts with actual variable name
 	.dw sysvarWord
 	.dw HERE
 
 	.db "CURRENT"
 	.dw $-HERE_
-	.db 7
+	.db 0
 CURRENT_:
 	.dw sysvarWord
 	.dw CURRENT
 
-	.db "(parse*)"
+	.db "(parse*"
 	.dw $-CURRENT_
-	.db 8
+	.db 0
 PARSEPTR_:
 	.dw sysvarWord
 	.dw PARSEPTR
 
 	.db	"FLAGS"
+	.fill	2
 	.dw	$-PARSEPTR_
-	.db	5
+	.db	0
 FLAGS_:
 	.dw	sysvarWord
 	.dw	FLAGS
 
 	.db	"SYSVNXT"
 	.dw	$-FLAGS_
-	.db	7
+	.db	0
 SYSVNXT_:
 	.dw	sysvarWord
 	.dw	SYSVNXT
 
 ; ( n a -- )
 	.db "!"
+	.fill 6
 	.dw $-SYSVNXT_
-	.db 1
+	.db 0
 STORE:
 	.dw nativeWord
 	pop	iy
@@ -1237,8 +1232,9 @@ STORE:
 
 ; ( a -- n )
 	.db "@"
+	.fill 6
 	.dw $-STORE
-	.db 1
+	.db 0
 FETCH:
 	.dw nativeWord
 	pop	hl
@@ -1249,8 +1245,9 @@ FETCH:
 
 ; ( a -- )
 	.db "DROP"
+	.fill 3
 	.dw $-FETCH
-	.db 4
+	.db 0
 DROP:
 	.dw nativeWord
 	pop	hl
@@ -1258,8 +1255,9 @@ DROP:
 
 ; ( a b -- b a )
 	.db "SWAP"
+	.fill 3
 	.dw $-DROP
-	.db 4
+	.db 0
 SWAP:
 	.dw nativeWord
 	pop	hl
@@ -1270,8 +1268,9 @@ SWAP:
 
 ; ( a -- a a )
 	.db "DUP"
+	.fill 4
 	.dw $-SWAP
-	.db 3
+	.db 0
 DUP:
 	.dw nativeWord
 	pop	hl
@@ -1282,8 +1281,9 @@ DUP:
 
 ; ( a b -- a b a )
 	.db "OVER"
+	.fill 3
 	.dw $-DUP
-	.db 4
+	.db 0
 OVER:
 	.dw nativeWord
 	pop	hl	; B
@@ -1295,8 +1295,9 @@ OVER:
 	jp	next
 
 	.db	">R"
+	.fill	5
 	.dw	$-OVER
-	.db	2
+	.db	0
 P2R:
 	.dw	nativeWord
 	pop	hl
@@ -1305,8 +1306,9 @@ P2R:
 	jp	next
 
 	.db	"R>"
+	.fill	5
 	.dw	$-P2R
-	.db	2
+	.db	0
 R2P:
 	.dw	nativeWord
 	call	popRS
@@ -1314,8 +1316,9 @@ R2P:
 	jp	next
 
 	.db	"I"
+	.fill	6
 	.dw	$-R2P
-	.db	1
+	.db	0
 I:
 	.dw	nativeWord
 	ld	l, (ix)
@@ -1324,8 +1327,9 @@ I:
 	jp	next
 
 	.db	"I'"
+	.fill	5
 	.dw	$-I
-	.db	2
+	.db	0
 IPRIME:
 	.dw	nativeWord
 	ld	l, (ix-2)
@@ -1334,8 +1338,9 @@ IPRIME:
 	jp	next
 
 	.db	"J"
+	.fill	6
 	.dw	$-IPRIME
-	.db	1
+	.db	0
 J:
 	.dw	nativeWord
 	ld	l, (ix-4)
@@ -1345,8 +1350,9 @@ J:
 
 ; ( a b -- c ) A + B
 	.db "+"
+	.fill 6
 	.dw $-J
-	.db 1
+	.db 0
 PLUS:
 	.dw nativeWord
 	pop	hl
@@ -1358,8 +1364,9 @@ PLUS:
 
 ; ( a b -- c ) A - B
 	.db "-"
+	.fill 6
 	.dw $-PLUS
-	.db 1
+	.db 0
 MINUS:
 	.dw nativeWord
 	pop	de		; B
@@ -1372,8 +1379,9 @@ MINUS:
 
 ; ( a b -- c ) A * B
 	.db "*"
+	.fill 6
 	.dw $-MINUS
-	.db 1
+	.db 0
 MULT:
 	.dw nativeWord
 	pop	de
@@ -1396,10 +1404,36 @@ 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"
-	.dw $-MULT
+	.fill 3
-	.db 4
+	.dw $-ONE
+	.db 0
 SCMP:
 	.dw nativeWord
 	pop	de
@@ -1412,8 +1446,9 @@ SCMP:
 
 ; ( n1 n2 -- f )
 	.db "CMP"
+	.fill 4
 	.dw $-SCMP
-	.db 3
+	.db 0
 CMP:
 	.dw nativeWord
 	pop	hl
@@ -1429,8 +1464,9 @@ 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	5
+	.db	0
 CSKIP:
 	.dw	nativeWord
 	pop	hl
@@ -1486,8 +1522,9 @@ 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	5
+	.db	0
 FBR:
 	.dw	nativeWord
 	push	de
@@ -1499,8 +1536,9 @@ FBR:
 	jp	next
 
 	.db	"(bbr)"
+	.fill	2
 	.dw	$-FBR
-	.db	5
+	.db	0
 BBR:
 	.dw	nativeWord
 	ld	hl, (IP)
@@ -1514,5 +1552,7 @@ 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,7 +61,6 @@
 0xa0 OP1r0 ANDr,
 0xb0 OP1r0 ORr,
 0xa8 OP1r0 XORr,
-0xb8 OP1r0 CPr,
 
 ( qq -- also works for ss )
 : OP1qq
@@ -94,7 +93,7 @@
     DOES>
     C@ A, A,
 ;
-0xd3 OP2n OUTnA,
+0xd3 OP2n OUTAn,
 0xdb OP2n INAn,
 
 ( r n -- )

forth/z80c.fs

@@ -17,9 +17,6 @@
   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 )