forth: make prev word field relative

This should help with upcoming challenges in bootstrapping z80 code
compiled through Forth.

emul/Makefile

@@ -7,7 +7,7 @@ AVRABIN = zasm/avra
 SHELLAPPS = zasm ed
 SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
 # Those Forth source files are in a particular order
-FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs z80a.fs
+FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs z80a.fs dummy.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o

emul/forth/glue0.asm

@@ -34,6 +34,6 @@ emulPutC:
 	out	(STDIO_PORT), a
 	ret
 
-.dw	0		; placeholder used in glue1.
 CODE_END:
+.out LATEST
 .out $		; should be the same as in glue1

emul/forth/glue1.asm

@@ -1,6 +1,6 @@
 ; Warning: The offsets of native dict entries must be exactly the same between
 ;          glue0.asm and glue1.asm
-.equ	LATEST		CODE_END	; override
+.equ	LATEST		RAMSTART	; override
 .equ	STDIO_PORT	0x00
 
 	jp	init
@@ -26,9 +26,6 @@ emulPutC:
 	out	(STDIO_PORT), a
 	ret
 
-.out $		; should be the same as in glue0, minus 2
+.out $		; should be the same as in glue0
-; stage0 spits, at the beginning of the binary, the address of the latest word
-; Therefore, we can set the LATEST label to here and we should be good.
-CODE_END:
 .bin "core.bin"
 RAMSTART:

emul/forth/stage1.c

@@ -71,9 +71,6 @@ int main(int argc, char *argv[])
 
 #ifndef DEBUG
     // We're done, now let's spit dict data
-    // let's start with LATEST spitting.
-    putchar(m->mem[CURRENT]);
-    putchar(m->mem[CURRENT+1]);
     uint16_t here = m->mem[HERE] + (m->mem[HERE+1] << 8);
     for (int i=sizeof(KERNEL); i<here; i++) {
         putchar(m->mem[i]);

forth/core.fs

@@ -1,5 +1,9 @@
 : H HERE @ ;
 : -^ SWAP - ;
+: [LITN] LITN ; IMMEDIATE
+: LIT ROUTINE S [LITN] , ;
+: LITS LIT SCPY ;
+: LIT< WORD LITS ; IMMEDIATE
 : COMPILE ' LITN ['] , , ; IMMEDIATE
 : [COMPILE] ' , ; IMMEDIATE
 : BEGIN H ; IMMEDIATE
@@ -37,6 +41,11 @@
     H 1 -           ( push a. -1 for allot offset )
 ; IMMEDIATE
 
+: CREATE
+    WORD (entry)     ( empty header with name )
+    ROUTINE C [LITN] ( push cellWord addr )
+    ,                ( write it )
+;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE H ! DOES> @ ;
 : = CMP NOT ;

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 L=compiledWord V=nativeWord N=next S=LIT
+                            N=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",

forth/dummy.fs

@@ -0,0 +1,4 @@
+( When building a compiled dict, always include this unit at
+  the end of it so that Forth knows how to hook LATEST into
+  it )
+WORD _______ (entry)

forth/forth.asm

@@ -119,12 +119,10 @@ forthMain:
 	push	af \ push af \ push af
 	ld	(INITIAL_SP), sp
 	ld	ix, RS_ADDR
-	; LATEST is a *indirect* label to the latest entry of the dict. See
+	; LATEST is a label to the latest entry of the dict. This can be
-	; default at the bottom of dict.asm. This indirection allows us to
+	; overridden if a binary dict has been grafted to the end of this
-	; override latest to a value set in a binary dict compiled separately,
+	; binary
-	; for example by the stage0 bin.
 	ld	hl, LATEST
-	call	intoHL
 	ld	(CURRENT), hl
 	ld	hl, HERE_INITIAL
 	ld	(HERE), hl
@@ -416,9 +414,12 @@ find:
 	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
 .end:
 	pop	bc
@@ -429,15 +430,21 @@ find:
 ; Z is set if DE point to 0 (no entry). NZ if not.
 .prev:
 	dec	de \ dec de \ dec de	; prev field
+	push	de			; --> lvl 1
 	ex 	de, hl
 	call 	intoHL
-	ex 	de, hl		; de preserved by intoHL, so no push/pop needed
+	ex 	de, hl			; DE contains prev offset
-	; DE points to prev. Is it zero?
+	pop	hl			; <-- lvl 1
-	xor	a
+	; HL is prev field's addr
-	or	d
+	; Is offset zero?
+	ld	a, d
 	or	e
-	; Z will be set if DE is zero
+	ret	z			; no prev entry
-	ret
+	; get absolute addr from offset
+	; carry cleared from "or e"
+	sbc	hl, de
+	ex	de, hl			; result in DE
+	ret				; NZ set from SBC
 
 ; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
 flagsToBC:
@@ -519,11 +526,14 @@ chkPS:
 ; It's important that this part is at the end of the resulting binary.
 ; A dictionary entry has this structure:
 ; - 7b name (zero-padded)
-; - 2b prev pointer
+; - 2b prev offset
 ; - 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 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".
@@ -642,7 +652,7 @@ EXIT:
 ; ( R:I -- )
 	.db "QUIT"
 	.fill 3
-	.dw EXIT
+	.dw $-EXIT
 	.db 0
 QUIT:
 	.dw compiledWord
@@ -659,7 +669,7 @@ QUIT:
 
 	.db "ABORT"
 	.fill 2
-	.dw QUIT
+	.dw $-QUIT
 	.db 0
 ABORT:
 	.dw	compiledWord
@@ -685,7 +695,7 @@ abortUnderflow:
 
 	.db "BYE"
 	.fill 4
-	.dw ABORT
+	.dw $-ABORT
 	.db 0
 BYE:
 	.dw nativeWord
@@ -700,7 +710,7 @@ BYE:
 ; ( c -- )
 	.db "EMIT"
 	.fill 3
-	.dw BYE
+	.dw $-BYE
 	.db 0
 EMIT:
 	.dw nativeWord
@@ -711,7 +721,7 @@ EMIT:
 	jp	next
 
 	.db	"(print)"
-	.dw	EMIT
+	.dw	$-EMIT
 	.db	0
 PRINT:
 	.dw	nativeWord
@@ -728,7 +738,7 @@ PRINT:
 ; ( c port -- )
 	.db "PC!"
 	.fill 4
-	.dw PRINT
+	.dw $-PRINT
 	.db 0
 PSTORE:
 	.dw nativeWord
@@ -741,7 +751,7 @@ PSTORE:
 ; ( port -- c )
 	.db "PC@"
 	.fill 4
-	.dw PSTORE
+	.dw $-PSTORE
 	.db 0
 PFETCH:
 	.dw nativeWord
@@ -754,7 +764,7 @@ PFETCH:
 
 	.db	"C,"
 	.fill	5
-	.dw	PFETCH
+	.dw	$-PFETCH
 	.db	0
 CWR:
 	.dw	nativeWord
@@ -769,7 +779,7 @@ CWR:
 
 	.db	","
 	.fill	6
-	.dw	CWR
+	.dw	$-CWR
 	.db	0
 WR:
 	.dw	nativeWord
@@ -781,9 +791,63 @@ WR:
 	jp	next
 
 
+	.db	"ROUTINE"
+	.dw	$-WR
+	.db	1			; 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, compiledWord
+	cp	'L'
+	jr	z, .end
+	ld	de, nativeWord
+	cp	'V'
+	jr	z, .end
+	ld	de, next
+	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	'N'
+	jr	z, .end
+	ld	de, chkPS
+	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 0
 EXECUTE:
 	.dw nativeWord
@@ -800,7 +864,7 @@ EXECUTE:
 
 	.db	";"
 	.fill	6
-	.dw	EXECUTE
+	.dw	$-EXECUTE
 	.db	1		; IMMEDIATE
 ENDDEF:
 	.dw	compiledWord
@@ -815,7 +879,7 @@ ENDDEF:
 
 	.db	":"
 	.fill	6
-	.dw	ENDDEF
+	.dw	$-ENDDEF
 	.db	1		; IMMEDIATE
 DEFINE:
 	.dw	compiledWord
@@ -860,7 +924,7 @@ DEFINE:
 
 	.db "DOES>"
 	.fill 2
-	.dw DEFINE
+	.dw $-DEFINE
 	.db 0
 DOES:
 	.dw nativeWord
@@ -881,7 +945,7 @@ DOES:
 
 
 	.db "IMMEDIA"
-	.dw DOES
+	.dw $-DOES
 	.db 0
 IMMEDIATE:
 	.dw nativeWord
@@ -893,7 +957,7 @@ IMMEDIATE:
 
 	.db	"IMMED?"
 	.fill	1
-	.dw	IMMEDIATE
+	.dw	$-IMMEDIATE
 	.db	0
 ISIMMED:
 	.dw	nativeWord
@@ -911,7 +975,7 @@ ISIMMED:
 ; ( n -- )
 	.db	"LITN"
 	.fill	3
-	.dw	ISIMMED
+	.dw	$-ISIMMED
 	.db	0
 LITN:
 	.dw nativeWord
@@ -926,7 +990,7 @@ LITN:
 
 	.db	"SCPY"
 	.fill	3
-	.dw	LITN
+	.dw	$-LITN
 	.db	0
 SCPY:
 	.dw	nativeWord
@@ -937,41 +1001,9 @@ SCPY:
 	jp	next
 
 
-	.db	"LIT"
-	.fill	4
-	.dw	SCPY
-	.db	0
-LIT_:
-	.dw	compiledWord
-	.dw	NUMBER
-	.dw	LIT
-	.dw	WR
-	.dw	EXIT
-
-	.db	"LITS"
-	.fill	3
-	.dw	LIT_
-	.db	0
-LITS:
-	.dw	compiledWord
-	.dw	LIT_
-	.dw	SCPY
-	.dw	EXIT
-
-
-	.db	"LIT<"
-	.fill	3
-	.dw	LITS
-	.db	1		; IMMEDIATE
-LITRD:
-	.dw	compiledWord
-	.dw	WORD
-	.dw	LITS
-	.dw	EXIT
-
 	.db	"(find)"
 	.fill	1
-	.dw	LITRD
+	.dw	$-SCPY
 	.db	0
 FIND_:
 	.dw	nativeWord
@@ -991,7 +1023,7 @@ FIND_:
 
 	.db	"'"
 	.fill	6
-	.dw	FIND_
+	.dw	$-FIND_
 	.db	0
 FIND:
 	.dw	compiledWord
@@ -1003,7 +1035,7 @@ FIND:
 
 	.db	"[']"
 	.fill	4
-	.dw	FIND
+	.dw	$-FIND
 	.db	0b01		; IMMEDIATE
 FINDI:
 	.dw	compiledWord
@@ -1025,7 +1057,7 @@ FINDERR:
 ; ( -- c )
 	.db "KEY"
 	.fill 4
-	.dw FINDI
+	.dw $-FINDI
 	.db 0
 KEY:
 	.dw nativeWord
@@ -1054,7 +1086,7 @@ CIN:
 ; 32 CMP 1 -
 	.db	"WS?"
 	.fill	4
-	.dw	KEY
+	.dw	$-KEY
 	.db	0
 ISWS:
 	.dw	compiledWord
@@ -1068,7 +1100,7 @@ ISWS:
 
 	.db	"NOT"
 	.fill	4
-	.dw	ISWS
+	.dw	$-ISWS
 	.db	0
 NOT:
 	.dw	nativeWord
@@ -1088,7 +1120,7 @@ NOT:
 ; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
 	.db	"TOWORD"
 	.fill	1
-	.dw	NOT
+	.dw	$-NOT
 	.db	0
 TOWORD:
 	.dw	compiledWord
@@ -1105,7 +1137,7 @@ TOWORD:
 ; HL point to WORDBUF.
 	.db "WORD"
 	.fill 3
-	.dw TOWORD
+	.dw $-TOWORD
 	.db 0
 WORD:
 	.dw	compiledWord
@@ -1152,7 +1184,7 @@ WORD:
 
 
 	.db	"(parsed"
-	.dw	WORD
+	.dw	$-WORD
 	.db	0
 PARSED:
 	.dw	nativeWord
@@ -1173,7 +1205,7 @@ PARSED:
 
 
 	.db	"(parse)"
-	.dw	PARSED
+	.dw	$-PARSED
 	.db	0
 PARSE:
 	.dw	compiledWord
@@ -1202,6 +1234,9 @@ PARSEI:
 
 ; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
 ; HL points to new (HERE)
+	.db	"(entry)"
+	.dw	$-PARSE
+	.db	0
 ENTRYHEAD:
 	.dw	nativeWord
 	pop	hl
@@ -1211,6 +1246,11 @@ ENTRYHEAD:
 	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
 	xor	a
@@ -1221,19 +1261,6 @@ ENTRYHEAD:
 	jp	next
 
 
-	.db "CREATE"
-	.fill 1
-	.dw PARSE
-	.db 0
-CREATE:
-	.dw	compiledWord
-	.dw	WORD
-	.dw	ENTRYHEAD
-	.dw	NUMBER
-	.dw	cellWord
-	.dw	WR
-	.dw	EXIT
-
 ; WARNING: there are no limit checks. We must be cautious, in core code, not
 ; to create more than SYSV_BUFSIZE/2 sys vars.
 ; Also: SYSV shouldn't be used during runtime: SYSVNXT won't point at the
@@ -1241,7 +1268,7 @@ CREATE:
 ; this word is not documented in dictionary.txt
 	.db	"(sysv)"
 	.fill	1
-	.dw	CREATE
+	.dw	$-ENTRYHEAD
 	.db	0
 SYSV:
 	.dw	compiledWord
@@ -1269,21 +1296,21 @@ SYSV:
 
 	.db "HERE"
 	.fill 3
-	.dw SYSV
+	.dw $-SYSV
 	.db 0
 HERE_:	; Caution: conflicts with actual variable name
 	.dw sysvarWord
 	.dw HERE
 
 	.db "CURRENT"
-	.dw HERE_
+	.dw $-HERE_
 	.db 0
 CURRENT_:
 	.dw sysvarWord
 	.dw CURRENT
 
 	.db "(parse*"
-	.dw CURRENT_
+	.dw $-CURRENT_
 	.db 0
 PARSEPTR_:
 	.dw sysvarWord
@@ -1291,7 +1318,7 @@ PARSEPTR_:
 
 	.db	"FLAGS"
 	.fill	2
-	.dw	PARSEPTR_
+	.dw	$-PARSEPTR_
 	.db	0
 FLAGS_:
 	.dw	sysvarWord
@@ -1300,7 +1327,7 @@ FLAGS_:
 ; ( n a -- )
 	.db "!"
 	.fill 6
-	.dw FLAGS_
+	.dw $-FLAGS_
 	.db 0
 STORE:
 	.dw nativeWord
@@ -1314,7 +1341,7 @@ STORE:
 ; ( n a -- )
 	.db "C!"
 	.fill 5
-	.dw STORE
+	.dw $-STORE
 	.db 0
 CSTORE:
 	.dw nativeWord
@@ -1327,7 +1354,7 @@ CSTORE:
 ; ( a -- n )
 	.db "@"
 	.fill 6
-	.dw CSTORE
+	.dw $-CSTORE
 	.db 0
 FETCH:
 	.dw nativeWord
@@ -1340,7 +1367,7 @@ FETCH:
 ; ( a -- c )
 	.db "C@"
 	.fill 5
-	.dw FETCH
+	.dw $-FETCH
 	.db 0
 CFETCH:
 	.dw nativeWord
@@ -1354,7 +1381,7 @@ CFETCH:
 ; ( a -- )
 	.db "DROP"
 	.fill 3
-	.dw CFETCH
+	.dw $-CFETCH
 	.db 0
 DROP:
 	.dw nativeWord
@@ -1364,7 +1391,7 @@ DROP:
 ; ( a b -- b a )
 	.db "SWAP"
 	.fill 3
-	.dw DROP
+	.dw $-DROP
 	.db 0
 SWAP:
 	.dw nativeWord
@@ -1377,7 +1404,7 @@ SWAP:
 ; ( a b c d -- c d a b )
 	.db "2SWAP"
 	.fill 2
-	.dw SWAP
+	.dw $-SWAP
 	.db 0
 SWAP2:
 	.dw nativeWord
@@ -1395,7 +1422,7 @@ SWAP2:
 ; ( a -- a a )
 	.db "DUP"
 	.fill 4
-	.dw SWAP2
+	.dw $-SWAP2
 	.db 0
 DUP:
 	.dw nativeWord
@@ -1408,7 +1435,7 @@ DUP:
 ; ( a b -- a b a b )
 	.db "2DUP"
 	.fill 3
-	.dw DUP
+	.dw $-DUP
 	.db 0
 DUP2:
 	.dw nativeWord
@@ -1424,7 +1451,7 @@ DUP2:
 ; ( a b -- a b a )
 	.db "OVER"
 	.fill 3
-	.dw DUP2
+	.dw $-DUP2
 	.db 0
 OVER:
 	.dw nativeWord
@@ -1439,7 +1466,7 @@ OVER:
 ; ( a b c d -- a b c d a b )
 	.db "2OVER"
 	.fill 2
-	.dw OVER
+	.dw $-OVER
 	.db 0
 OVER2:
 	.dw nativeWord
@@ -1459,7 +1486,7 @@ OVER2:
 ; ( a b c -- b c a)
 	.db "ROT"
 	.fill 4
-	.dw OVER2
+	.dw $-OVER2
 	.db 0
 ROT:
 	.dw nativeWord
@@ -1474,7 +1501,7 @@ ROT:
 
 	.db	">R"
 	.fill	5
-	.dw	ROT
+	.dw	$-ROT
 	.db	0
 P2R:
 	.dw	nativeWord
@@ -1485,7 +1512,7 @@ P2R:
 
 	.db	"R>"
 	.fill	5
-	.dw	P2R
+	.dw	$-P2R
 	.db	0
 R2P:
 	.dw	nativeWord
@@ -1495,7 +1522,7 @@ R2P:
 
 	.db	"I"
 	.fill	6
-	.dw	R2P
+	.dw	$-R2P
 	.db	0
 I:
 	.dw	nativeWord
@@ -1506,7 +1533,7 @@ I:
 
 	.db	"I'"
 	.fill	5
-	.dw	I
+	.dw	$-I
 	.db	0
 IPRIME:
 	.dw	nativeWord
@@ -1517,7 +1544,7 @@ IPRIME:
 
 	.db	"J"
 	.fill	6
-	.dw	IPRIME
+	.dw	$-IPRIME
 	.db	0
 J:
 	.dw	nativeWord
@@ -1529,7 +1556,7 @@ J:
 ; ( a b -- c ) A + B
 	.db "+"
 	.fill 6
-	.dw J
+	.dw $-J
 	.db 0
 PLUS:
 	.dw nativeWord
@@ -1543,7 +1570,7 @@ PLUS:
 ; ( a b -- c ) A - B
 	.db "-"
 	.fill 6
-	.dw PLUS
+	.dw $-PLUS
 	.db 0
 MINUS:
 	.dw nativeWord
@@ -1558,7 +1585,7 @@ MINUS:
 ; ( a b -- c ) A * B
 	.db "*"
 	.fill 6
-	.dw MINUS
+	.dw $-MINUS
 	.db 0
 MULT:
 	.dw nativeWord
@@ -1585,7 +1612,7 @@ MULT:
 
 	.db	"/MOD"
 	.fill	3
-	.dw MULT
+	.dw $-MULT
 	.db 0
 DIVMOD:
 	.dw nativeWord
@@ -1600,7 +1627,7 @@ DIVMOD:
 
 	.db	"AND"
 	.fill	4
-	.dw	DIVMOD
+	.dw	$-DIVMOD
 	.db	0
 AND:
 	.dw	nativeWord
@@ -1618,7 +1645,7 @@ AND:
 
 	.db	"OR"
 	.fill	5
-	.dw	AND
+	.dw	$-AND
 	.db	0
 OR:
 	.dw	nativeWord
@@ -1636,7 +1663,7 @@ OR:
 
 	.db	"XOR"
 	.fill	4
-	.dw	OR
+	.dw	$-OR
 	.db	0
 XOR:
 	.dw	nativeWord
@@ -1658,7 +1685,7 @@ XOR:
 
 	.db	"0"
 	.fill	6
-	.dw	XOR
+	.dw	$-XOR
 	.db	0
 ZERO:
 	.dw	nativeWord
@@ -1668,7 +1695,7 @@ ZERO:
 
 	.db	"1"
 	.fill	6
-	.dw	ZERO
+	.dw	$-ZERO
 	.db	0
 ONE:
 	.dw	nativeWord
@@ -1679,7 +1706,7 @@ ONE:
 ; ( a1 a2 -- b )
 	.db "SCMP"
 	.fill 3
-	.dw ONE
+	.dw $-ONE
 	.db 0
 SCMP:
 	.dw nativeWord
@@ -1694,7 +1721,7 @@ SCMP:
 ; ( n1 n2 -- f )
 	.db "CMP"
 	.fill 4
-	.dw SCMP
+	.dw $-SCMP
 	.db 0
 CMP:
 	.dw nativeWord
@@ -1712,7 +1739,7 @@ CMP:
 ; to after null-termination.
 	.db	"SKIP?"
 	.fill	2
-	.dw	CMP
+	.dw	$-CMP
 	.db	0
 CSKIP:
 	.dw	nativeWord
@@ -1770,7 +1797,7 @@ CSKIP:
 ; contain 3. Add this value to RS.
 	.db	"(fbr)"
 	.fill	2
-	.dw	CSKIP
+	.dw	$-CSKIP
 	.db	0
 FBR:
 	.dw	nativeWord
@@ -1784,7 +1811,7 @@ FBR:
 
 	.db	"(bbr)"
 	.fill	2
-	.dw	FBR
+	.dw	$-FBR
 	.db	0
 BBR:
 	.dw	nativeWord
@@ -1796,5 +1823,11 @@ BBR:
 	ld	(IP), hl
 	jp	next
 
+; 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
 LATEST:
-	.dw BBR

forth/z80a.fs

@@ -1,12 +1,19 @@
 ( Z80 assembler )
 
+: CODE
+    ( same as CREATE, but with ROUTINE V )
+    WORD (entry)
+    ROUTINE V [LITN] ,
+;
+
 ( Splits word into msb/lsb, lsb being on TOS )
 : SPLITB
     DUP 0x100 /
     SWAP 0xff AND
 ;
 
-: A, .X ;
+( To debug, change C, to .X )
+: A, C, ;
 7 CONSTANT A
 0 CONSTANT B
 1 CONSTANT C
@@ -122,3 +129,4 @@
 
 ( Specials )
 : JRe, 0x18 A, 2 - A, ;
+: JPNEXT, ROUTINE N [LITN] JPnn, ;