feat(v4.0.0): the defining and compiling words

The fourth layer of the compiler capsule.  compile.v4: INTERPRET's
loop, STATE [ ] : ; EXIT IMMEDIATE LITERAL COMPILE [COMPILE] ' EXECUTE,
CREATE VARIABLE CONSTANT DOES>, and IF ELSE THEN BEGIN UNTIL AGAIN
WHILE REPEAT DO ?DO LOOP +LOOP on a control-flow stack in memory.
forth.v4: the first words of the vocabulary, the in-line ones.

FORTH source now goes in and running code comes out.  49 programmes
were run through the v3 binary and through this; every result agrees,
bar COMPILE, which v3 cannot run.  The code laid down for each control
structure is word for word the expansion DECOMPOSITION.md gives.

A line may have six values on the stack while it is interpreted, and
words called from the interpreter may nest eight deep.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

docs/v4.0.0/DECOMPOSITION.md

@@ -572,8 +572,8 @@ width and print a flood of spaces.
 | `BL` | IN | `32` — executed on the golden model (2026-10-04). |
 | `EXPECT` `QUERY` | CC | Built on `KEY` (DEV); source in `v4/capsule/input.v4`. FORTH-79 (ruled 2026-10-04). `EXPECT ( baddr n -- )` stores characters from `baddr` upward until a new-line (taken, not stored) or until `n` have been received, then a zero; no action for `n <= 0`; a line longer than `n` leaves the rest to be read next. It also sets `SPAN`, which is not FORTH-79 but is v3's. `QUERY` is `TIB 80 EXPECT  0 >IN !`. v3's `EXPECT` was C's `fgets` and took `n-1` characters, and its `QUERY` took 1024. Executed on the golden model's host node (2026-10-04) against C for every size and line length. `EXPECT` leaves its caller 6 data cells and 4 return entries. |
 | `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. `TIB` is the buffer's byte address and `>IN` and `SPAN` their variables' word addresses, all in line; `SOURCE ( -- baddr u )` is `TIB` and `SPAN @`, a negative `SPAN` read as 0. Executed on the golden model's host node (2026-10-04). |
-| `WORD` `ENCLOSE` | CC | Parser; source in `v4/capsule/input.v4`. `WORD ( c -- baddr )` is FORTH-79 (ruled 2026-10-04): characters are taken from `TIB` until the delimiter `c` or the end of the text, leading delimiters ignored, and stored as a counted string; the delimiter met (`c`, or a zero if the text ran out) is stored after them, uncounted; `>IN` is left just past it; with nothing left the count is 0. The count is a byte, so a word over 255 characters is cut to 255; the buffer is 257 bytes. v3's `WORD` skipped every delimiter after the word, always stored a zero, and cut at 62. `ENCLOSE ( baddr c -- baddr n1 n2 n3 )`, not a FORTH-79 word, works on a zero-terminated string as v3's. Executed on the golden model's host node (2026-10-04) against C, and `ENCLOSE` against values recorded from the v3 binary. `WORD` leaves its caller 4 data cells and 3 return entries. |
-| `NUMBER` `CONVERT` | CC | FORTH-79, not v3 (ruled 2026-10-04); source in `v4/capsule/input.v4`. `CONVERT ( d1 baddr1 -- d2 baddr2 )` takes the characters from `baddr1 + 1` on as digits in the current `BASE`, in either case, accumulating each into the double after multiplying it by `BASE`, and stops at the first that is not one; the double is `( lo hi )`. v3's was base 10 only, started at `baddr1`, and took the double low cell on top. `NUMBER ( baddr -- d )` is the counted string as a signed double in the current `BASE`, with an optional leading minus; anything else gives 0 and sets `NODE-ERROR`. v3's returned `( n flag )` in base 10. Executed on the golden model's host node (2026-10-04) against C in eight bases, including a digit that carries out of the low cell. `NUMBER` leaves its caller 3 data cells and 3 return entries. |
+| `WORD` `ENCLOSE` | CC | Parser; source in `v4/capsule/input.v4`. `WORD ( c -- baddr )` is FORTH-79 (ruled 2026-10-04): characters are taken from `TIB` until the delimiter `c` or the end of the text, leading delimiters ignored, and stored as a counted string; the delimiter met (`c`, or a zero if the text ran out) is stored after them, uncounted; `>IN` is left just past it; with nothing left the count is 0. The count is a byte, so a word over 255 characters is cut to 255; the buffer is 257 bytes. v3's `WORD` skipped every delimiter after the word, always stored a zero, and cut at 62. `ENCLOSE ( baddr c -- baddr n1 n2 n3 )`, not a FORTH-79 word, works on a zero-terminated string as v3's. Executed on the golden model's host node (2026-10-04) against C, and `ENCLOSE` against values recorded from the v3 binary. `WORD` keeps what it works on in memory and has at most three cells of its own on the data stack: it leaves its caller 7 data cells and 6 return entries. |
+| `NUMBER` `CONVERT` | CC | FORTH-79, not v3 (ruled 2026-10-04); source in `v4/capsule/input.v4`. `CONVERT ( d1 baddr1 -- d2 baddr2 )` takes the characters from `baddr1 + 1` on as digits in the current `BASE`, in either case, accumulating each into the double after multiplying it by `BASE`, and stops at the first that is not one; the double is `( lo hi )`. v3's was base 10 only, started at `baddr1`, and took the double low cell on top. `NUMBER ( baddr -- d )` is the counted string as a signed double in the current `BASE`, with an optional leading minus; anything else gives 0 and sets `NODE-ERROR`. v3's returned `( n flag )` in base 10. Executed on the golden model's host node (2026-10-04) against C in eight bases, including a digit that carries out of the low cell. `NUMBER` leaves its caller 3 data cells and 2 return entries; the interpreter does not use it (it has a single-cell conversion of its own that needs far less of the stack). |
 | `S"` `(s")` `[']` | CC | Compiler words. |
 | `LITERAL` `[LITERAL]` (placeholders) | RET | The working `LITERAL` is in §5.17. |
 
@@ -674,18 +674,18 @@ The storage service belongs to the Artemis role, now a device node.
 
 | Word | Fate | Notes |
 | --- | --- | --- |
-| `HERE` `ALIGN` `ALLOT` `,` `C,` `2,` `PAD` `LATEST` | CC | The dictionary lives on the host node; source in `v4/capsule/dict.v4`. The dictionary pointer `DP` is a byte address, so `C,` packs four characters to a cell; `HERE` is the next whole cell (a word address); `,` and `ALLOT` align first. An address unit is a cell (D-1), so `ALLOT` counts cells where v3's counted bytes; a negative count gives space back. `2,` stores the low cell first, as v3. Going outside the dictionary space stores nothing, moves nothing and sets `NODE-ERROR`. `PAD` is a fixed scratch area, as in v3, given as a byte address. `LATEST` is the xt of the newest entry, 0 if there is none (v3's pushes `HERE`, which looks like a bug; reported, not changed). Executed on the golden model's host node (2026-10-04). `,` and `ALLOT` leave their caller 6 data cells and 5 return entries. |
+| `HERE` `ALIGN` `ALLOT` `,` `C,` `2,` `PAD` `LATEST` | CC | The dictionary lives on the host node; source in `v4/capsule/dict.v4`. The dictionary pointer `DP` is a byte address, so `C,` packs four characters to a cell; `HERE` is the next whole cell (a word address); `,` and `ALLOT` align first. An address unit is a cell (D-1), so `ALLOT` counts cells where v3's counted bytes; a negative count gives space back. `2,` stores the low cell first, as v3. Going outside the dictionary space stores nothing, moves nothing and sets `NODE-ERROR`. `PAD` is a fixed scratch area, as in v3, given as a byte address. `LATEST` is the xt of the newest entry, 0 if there is none (v3's pushes `HERE`, which looks like a bug; reported, not changed). Executed on the golden model's host node (2026-10-04). `,` calls nothing and leaves its caller 7 data cells and 8 return entries; `ALLOT` leaves 7 and 7. |
 | `SP@` `SP!` | RET | No visible stack pointer (D-2). |
 
 ### 5.13 Dictionary manipulation
 
 | Word | Fate |
 | --- | --- |
-| `FIND` | CC | `( -- xt \| 0 )`, FORTH-79 and v3 alike: the compilation address of the next word in the input stream, or 0 if it is not in the dictionary. `32 WORD` then a search from the newest entry back, skipping hidden ones; names are case sensitive, as v3, and 31 characters are significant (FORTH-79). Executed on the golden model's host node (2026-10-04) against a list kept in C, 300 entries. Leaves its caller 4 data cells and 2 return entries. |
-| `'` | CC | `( -- addr )`, FORTH-79: the parameter field address of the next word in the input stream; not found is an error (0, and `NODE-ERROR` set). v3's `'` returned what `FIND` returns. For a word that is code the two are the same address; for a data word the parameter field is the cell after its code, which is what FORTH-79's `n ' NAME !` needs. Its compiling behaviour comes with the compiler words. Executed on the golden model's host node (2026-10-04). |
+| `FIND` | CC | `( -- xt \| 0 )`, FORTH-79 and v3 alike: the compilation address of the next word in the input stream, or 0 if it is not in the dictionary. `32 WORD` then a search from the newest entry back, skipping hidden ones; names are case sensitive, as v3, and 31 characters are significant (FORTH-79). Executed on the golden model's host node (2026-10-04) against a list kept in C, 300 entries. Leaves its caller 7 data cells and 5 return entries. |
+| `'` | CC | `( -- addr )`, FORTH-79: the parameter field address of the next word in the input stream; not found is an error (0, and `NODE-ERROR` set). v3's `'` returned what `FIND` returns. For a word that is code the two are the same address; for a data word the parameter field is the cell after its code, which is what FORTH-79's `n ' NAME !` needs. It is immediate: inside a definition the address is compiled as a literal (FORTH-79), where v3's `'` parsed when the definition ran. Executed on the golden model's host node (2026-10-04). |
 | `>LINK` `LFA` `LINK>` `>NAME` `NFA` `NAME>` `CFA` `PFA` `>BODY` `TRAVERSE` | CC | The fields of an entry, all reached from its xt, as in v3 where the xt was the entry: `>LINK`/`LFA` the link's address, `LINK>` the older entry's xt, `>NAME`/`NFA` the byte address of the counted name, `NAME>` back to the xt, `CFA` the xt itself, `PFA`/`>BODY` the parameter field, `TRAVERSE` from a name's count byte to past its last character (for `n > 0`; otherwise unchanged, as v3). Executed on the golden model's host node (2026-10-04). |
 | `SMUDGE` `HIDDEN` | CC | `SMUDGE` toggles the hidden flag of the newest entry; `HIDDEN` sets it. v3 refuses both outside compilation; that check comes with the compiler words. Executed on the golden model's host node (2026-10-04). |
-| `INTERPRET` | CC |  |
+| `INTERPRET` | CC | FORTH-79; source in `v4/capsule/compile.v4`. Takes words from the input stream until it is exhausted: a word in the dictionary is executed, or, when compiling and not immediate, compiled; anything else must be a number in the current `BASE` (a single cell, with an optional leading minus), left on the stack or compiled as a literal. What is neither, or a compile-only word met while interpreting, abandons the line: compiling stops, the definition under way stays hidden, the rest of the input is skipped and `NODE-ERROR` is set (the message and the stack reset come with `QUIT`). Executed on the golden model's host node (2026-10-04). |
 
 An entry, as `v4/capsule/dict.v4` builds it. A word's execution address (xt) is the address of its
 code, and everything else is found from it:
@@ -713,7 +713,7 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
 | Word | Fate | Notes |
 | --- | --- | --- |
 | `(` `\` | CC | `(` is `41 WORD drop`; `\` is `SPAN @ >IN !`. In `v4/capsule/input.v4` under the names `PAREN` and `BACKSLASH`. Executed on the golden model's host node (2026-10-04). |
-| `EXECUTE` | CAP | `push ;` (tail-jumps to the xt; the xt returns to `EXECUTE`'s caller) |
+| `EXECUTE` | CAP | `push ;` (tail-jumps to the xt; the xt returns to `EXECUTE`'s caller). Executed on the golden model's host node (2026-10-04). |
 | `NOP` | OP | `nop` |
 | `QUIT` `ABORT` `ABORT"` `(ABORT")` `COLD` `WARM` | CC |  |
 | `BYE` `REBOOT` | HERA |  |
@@ -732,10 +732,35 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
 
 | Word | Fate | Notes |
 | --- | --- | --- |
-| `:` `;` `CREATE` `VARIABLE` `CONSTANT` `DOES>` `IMMEDIATE` `STATE` `[` `]` `LITERAL` `COMPILE` `[COMPILE]` `FORGET` `FENCE` | CC |  |
+| `:` `;` `EXIT` `IMMEDIATE` `STATE` `[` `]` `LITERAL` `COMPILE` `[COMPILE]` | CC | Source in `v4/capsule/compile.v4`, all to FORTH-79. `:` makes an entry and starts compiling; the word cannot be found until `;`, so a redefinition can use the old word. `;` lays the return, reveals the word and stops compiling. `LITERAL` compiles the number on the stack when compiling. `COMPILE xxx` lays code that compiles `xxx` when the word it is in runs; `[COMPILE] xxx` compiles `xxx` though it is immediate. Executed on the golden model's host node (2026-10-04) against results recorded from the v3 binary; v3's `COMPILE` does not work (`: C1 COMPILE DUP ; IMMEDIATE  : U3 C1 + ;` gives `DUP: Stack underflow`), reported, not fixed. |
+| `CREATE` `VARIABLE` `CONSTANT` `DOES>` | CC | FORTH-79. A data word's code is one instruction word, a call to its run-time routine, and its parameter field is the cell after it: `(DOVAR)` is `pop ;` (the call's return address is the parameter field's address) and `(DOCON)` is `pop a! @ ;`. `VARIABLE` allots one cell, set to 0. `DOES>` lays a call to `(DOES)` and then `pop`: `(DOES)`, run by the defining word, rewrites the newest entry's code into a call to the code after it and returns from the defining word; that code's `pop` fetches the parameter field address. Executed on the golden model's host node (2026-10-04) against results recorded from the v3 binary. |
+| `FORGET` `FENCE` | CC |  |
 | `LIT` | OP | `@p` |
 | `does_rt` | RET | Internal helper; `DOES>` is implemented by the compiler capsule. |
 
+**How a word is compiled.** v4 code is native: a colon definition is instruction words, and
+compiling a word into one lays down a call to it. Two flags on an entry change that. An **in-line**
+word's code is a straight run of opcodes and literals ending in `;`, and that run is copied in place
+of a call; this is fate IN (§0), and everything that touches the return stack must be in line, since a
+call would bury what it works on. A **compile-only** word may not be executed by the interpreter.
+`v4/capsule/forth.v4` holds the first words of the vocabulary flagged this way (`DUP`, `+`, `>R`, `I`,
+`LEAVE`, `@`, the in-line variables and so on).
+
+**The short stacks (D-2) and the compiler.** The interpreter and compiler run on the same ten-cell and
+nine-entry stacks as the user's words, with the user's values beneath them. Two consequences are
+built into the capsule:
+
+- Every word of the capsule keeps what it works on in memory and has at most three cells of its own on
+  the data stack. Measured on the golden model: a line may have **6 values on the stack** while the
+  interpreter reads its next word, and defining and running a word leaves 4 cells under it untouched.
+- Words called from the interpreter may nest **8 deep**; a `DO` loop takes two return entries, so two
+  nested loops leave four. `*` is therefore not `UM* drop` on the host node but N steps of `+*` with
+  only the count on the return stack; it gives the same low cell (what `+*` loses at the top of `T`
+  takes N shifts to reach the bit that moves into `A`, and the loop ends first).
+
+A programme that v3 runs with more than that on its stacks does not run here; that is D-2, not the
+compiler.
+
 **The code generator** (`v4/capsule/codegen.v4`) is what these words are built on. It packs opcodes,
 literals and branches into instruction words at `HERE`, by the rules of §1.2 and §2: slots filled left
 to right, unused slots `nop`, a literal's value in the cell after its word, `;` `ex` and any branch
@@ -761,7 +786,9 @@ lays down was then run.
 
 | Word | Fate | v4 definition / notes |
 | --- | --- | --- |
-| `IF` `ELSE` `THEN` `BEGIN` `UNTIL` `AGAIN` `WHILE` `REPEAT` `DO` `?DO` `LOOP` `+LOOP` `LEAVE` `CASE` `OF` `ENDOF` `ENDCASE` | CC | Compile-time structure words. Expansions per §2 and below. |
+| `IF` `ELSE` `THEN` `BEGIN` `UNTIL` `AGAIN` `WHILE` `REPEAT` `DO` `?DO` `LOOP` `+LOOP` | CC | Compile-time structure words, immediate and compile-only; source in `v4/capsule/compile.v4`. Expansions per §2 and below. What an opening word leaves for the word that closes it goes on a **control-flow stack in memory** (32 cells), not on the data stack, with a number saying which word left it; a closing word that finds the wrong number, or nothing, abandons the line. A loop that tests at its end (`UNTIL`) must drop the flag on both ways out, so `BEGIN` lays `jump L0  Ld: drop  L0:` and `UNTIL` lays `if Ld  drop`. Executed on the golden model's host node (2026-10-04): the code laid down for each is word for word what the text assembler makes of the expansion given here, and the programmes run give what the v3 binary gave. |
+| `LEAVE` `I` `J` `UNLOOP` | CC | In-line words (below), compile-only. |
+| `CASE` `OF` `ENDOF` `ENDCASE` | CC |  |
 | `EXIT` | OP | `;` |
 | `(BRANCH)` | OP | `jump` |
 | `(0BRANCH)` | IN | `if L … drop` (§2) — executed on the golden model (2026-10-03) as `IF 1 ELSE 2 THEN`, including results recorded from the v3 binary. |

v4/Makefile

@@ -75,12 +75,12 @@ endif
 #
 # Both binaries depend on this Makefile, so a flag change rebuilds them.
 define TEST_RULE
-$(BINDIR)/$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile
+$(BINDIR)/$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $$(wildcard $(HERE)/tests/*.h) $(HERE)/Makefile
 	@mkdir -p $(BINDIR)
 	$$(CC) $$(CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) $(capsule_dir) \
 		$(2) $$(SRCS) -o $$@
 
-$(BINDIR)/san-$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile
+$(BINDIR)/san-$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $$(wildcard $(HERE)/tests/*.h) $(HERE)/Makefile
 	@mkdir -p $(BINDIR)
 	$$(CC) $$(CSTD) $$(WARN) -O1 -g -fno-omit-frame-pointer \
 		-fsanitize=address,undefined -fno-sanitize-recover=all -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) $(capsule_dir) \

v4/capsule/codegen.v4

@@ -19,14 +19,16 @@
 \ bits whose lowest is bit 27 - 5k, and a branch there has 27 - 5k address bits.
 \
 \ Rests on core.v4 and dict.v4.  Constants the loader supplies:
-\   (CG)        word address of nine cells: the word being built, the next
-\               free slot, the number of literals it owes, and up to six of them
+\   (CG)        word address of thirteen cells of scratch for this file
 \   CG-BSLOTS   how many slots, counted from slot 0, may hold a branch
 
-macro (CUR)    (CG)       endmacro
-macro (SLOT)   (CG) 1 +   endmacro
-macro (NLIT)   (CG) 2 +   endmacro
-macro (LITS)   (CG) 3 +   endmacro
+\ Like WORD, these run under whatever the user has on the stacks, so what they
+\ work on is in (CG) and they keep at most three cells of their own on the
+\ data stack (D-2):
+\   (CG)+0 the word being built     (CG)+1 its next free slot
+\   (CG)+2 how many literals it owes, and (CG)+3 .. (CG)+8 the literals
+\   (CG)+9 the opcode (OP,) was given          (CG)+10 the ref (BRANCH>) is making
+\   (CG)+11 the target a branch is to reach    (CG)+12 which literal (FLUSH) is at
 
 \ ( x n -- x' )   x shifted left n places, n >= 0
 : (LSHIFT)   if Z  -1 + push  L: 2* next L  ;   Z: drop ;
@@ -38,67 +40,77 @@ macro (LITS)   (CG) 3 +   endmacro
 : (MASK)     (LOWBIT)  1 SWAP (LSHIFT)  -1 + ;
 
 \ ( -- )   forget the word being built
-: (CG-RESET)   0 (CUR) a! !  0 (SLOT) a! !  0 (NLIT) a! ! ;
+: (CG-RESET)   0 (CG) a! !  0 (CG)+1 a! !  0 (CG)+2 a! ! ;
 
-\ ( op -- )   into the next free slot.  The slot must be free.
+\ ( op -- )   into the next free slot.  The slot must be free.  The shift is
+\ (LSHIFT) in line; the slot's lowest bit is never bit 0, so it shifts at
+\ least once.
 : (PUT)
-  (SLOT) a! @  dup 1 + !                     \ op k
-  (LOWBIT) (LSHIFT)
-  (CUR) a! @ + ! ;
+  (CG)+1 a! @  dup 1 + !                     \ op k
+  (LOWBIT)  -1 + push  L: 2* next L
+  (CG) a! @ + ! ;
 
 \ ( -- )   append the word being built, its unused slots nop, then the
 \ literals it owes; nothing if no slot is in use
 : (FLUSH)
-  (SLOT) a! @ if EMPTY  drop
-  P: (SLOT) a! @ -6 + if FULL  drop  28 (PUT)  jump P
+  (CG)+1 a! @ if EMPTY  drop
+  P: (CG)+1 a! @ -6 + if FULL  drop  28 (PUT)  jump P
   FULL: drop
-  (CUR) a! @ ,
-  0  L: dup (NLIT) a! @ xor if DONE
-        drop  dup (LITS) + a! @ ,  1 +  jump L
-  DONE: drop drop
+  (CG) a! @ ,
+  0 (CG)+12 a! !
+  L: (CG)+12 a! @  (CG)+2 a! @  xor if DONE
+     drop  (CG)+12 a! @  dup 1 + !  (CG)+3 + a! @ ,
+     jump L
+  DONE: drop
   jump (CG-RESET)
   EMPTY: drop ;
 
 \ ( op -- )   any opcode that is neither a branch nor @p
 : (OP,)
-  dup push (PUT) pop
-  if ENDS  -1 + if ENDS                      \ ; and ex end the word
-  drop  (SLOT) a! @ -6 + if ENDS  drop ;     \ and so does its last slot
+  dup (CG)+9 a! !  (PUT)
+  (CG)+9 a! @  if ENDS  -1 + if ENDS         \ ; and ex end the word
+  drop  (CG)+1 a! @ -6 + if ENDS  drop ;     \ and so does its last slot
   ENDS: drop  jump (FLUSH)
 
 \ ( x -- )   @p and its value
 : (LIT,)
-  (NLIT) a! @  dup 1 + !                     \ x n
-  (LITS) + a! !
+  (CG)+2 a! @  dup 1 + !                     \ x n
+  (CG)+3 + a! !
   8 (PUT)
-  (SLOT) a! @ -6 + if FULL  drop ;
+  (CG)+1 a! @ -6 + if FULL  drop ;
   FULL: drop  jump (FLUSH)
 
 \ ( -- addr )   where the next word will go: a branch target
 : (LABEL)    (FLUSH) HERE ;
 
-\ ( op -- ref )   a branch (jump 2, call 3, next 5, if 6, -if 7) whose address
-\ is filled in later by (RESOLVE).  ref is the branch's word address times 8,
-\ plus its slot.
-: (BRANCH>)
-  (SLOT) a! @  CG-BSLOTS -  -if MOVE  drop jump PLACED
+\ ( op -- )   a branch (jump 2, call 3, next 5, if 6, -if 7) whose address is
+\ not filled in yet.  Its ref -- the branch's word address times 8, plus its
+\ slot -- is left in (CG)+10.  It ends by jumping to (FLUSH), so that the
+\ chain of calls under it is one shorter.
+: (BRANCH0)
+  (CG)+1 a! @  CG-BSLOTS -  -if MOVE  drop jump PLACED
   MOVE: drop (FLUSH)
   PLACED:
   \ the word will be appended at HERE; its literals, if any, come after it
-  HERE 2* 2* 2*  (SLOT) a! @ +  push
+  HERE 2* 2* 2*  (CG)+1 a! @ +  (CG)+10 a! !
   (PUT)
-  6 (SLOT) a! !  (FLUSH)
-  pop ;
+  6 (CG)+1 a! !  jump (FLUSH)
 
-\ ( target ref -- )   put the address into the branch at ref
-: (RESOLVE)
-  dup 7 and (MASK) push                      \ target ref     R: mask
-  2/ 2/ 2/ a!                                \ target         A: the branch's word
-  pop dup push and                           \ the address bits
+\ ( ref -- )   put the address in (CG)+11 into the branch at ref
+: (RESOLVE1)
+  dup 7 and (MASK) push                      \ ref           R: mask
+  2/ 2/ 2/ a!                                \ A: the branch's word
+  (CG)+11 b! @b  pop dup push and            \ the address bits
   @  pop inv and  +  ! ;
 
+\ ( target ref -- )   put the address into the branch at ref
+: (RESOLVE)   SWAP (CG)+11 a! !  jump (RESOLVE1)
+
+\ ( op -- ref )   the same, leaving the ref, for (RESOLVE) to fill in later
+: (BRANCH>)   (BRANCH0)  (CG)+10 a! @ ;
+
 \ ( target op -- )   a branch to a known address
-: (BRANCH,)   (BRANCH>) jump (RESOLVE)
+: (BRANCH,)   SWAP (CG)+11 a! !  (BRANCH0)  (CG)+10 a! @  jump (RESOLVE1)
 
 : (JUMP,) ( addr -- )   2 jump (BRANCH,)
 : (CALL,) ( addr -- )   3 jump (BRANCH,)

v4/capsule/compile.v4

@@ -0,0 +1,348 @@
+\ compile.v4 -- the interpreter's inner loop, and the defining and compiling
+\ words.
+\
+\ DECOMPOSITION.md 5.17 and 5.18: STATE [ ] : ; EXIT IMMEDIATE LITERAL COMPILE
+\ [COMPILE] ' EXECUTE CREATE VARIABLE CONSTANT DOES>, the control structures
+\ IF ELSE THEN BEGIN UNTIL AGAIN WHILE REPEAT DO ?DO LOOP +LOOP, and INTERPRET,
+\ which they cannot be run without.  Part of the compiler capsule.  Rests on
+\ core.v4, input.v4, dict.v4 and codegen.v4.
+\
+\ HOW A WORD IS COMPILED.  v4 code is native: a colon definition is
+\ instruction words, and compiling a word into one lays down a call to it.
+\ Two flags on an entry (dict.v4) change that:
+\   inline        its code is a straight run of opcodes and literals ending
+\                 in ; -- that run is copied in place of a call.  Everything
+\                 that touches the return stack must be, since a call would
+\                 bury what it works on (DECOMPOSITION.md 0, fate IN).
+\   compile-only  it may not be executed by the interpreter.
+\ An immediate word is executed even when compiling.
+\
+\ THE STACKS ARE SHORT (D-2): ten cells of data, nine return entries, and no
+\ way to see how full they are.  The interpreter and compiler run on the same
+\ stacks as the user's words, with the user's values beneath them, so:
+\   - every word here keeps what it works on in (C), and has at most three
+\     cells of its own on the data stack at any moment;
+\   - what an IF or a DO leaves for its THEN or LOOP goes on a control-flow
+\     stack in memory, not on the data stack, so structures may nest as
+\     deep as that stack (32 cells) allows whatever the user has stacked.
+\
+\ Constants the loader supplies:
+\   STATE   word address of the variable: non-zero while compiling
+\   (C)     word address of eight cells of scratch for this file:
+\           (C)+0 (C)+1 (C)+4 the in-liner's word, literal pointer and slot
+\           (C)+2 LATEST before a header is made   (C)+3 a data word's routine
+\           (C)+6 (C)+7 a branch and a tag a control word is holding
+\   (CFP)   word address of the control-flow stack's pointer
+\   CFBASE CFEND   word addresses of its first cell and of the cell past its last
+
+macro ROT   push SWAP pop SWAP   endmacro
+
+\ ---- errors ------------------------------------------------------------------
+
+\ ( -- )   give up the line: stop compiling, forget the word being built and
+\ whatever control structures were open, skip the rest of the input, and set
+\ NODE-ERROR.  A definition that was under way stays hidden.  (QUIT will add
+\ the message and the stack reset.)
+: (ABANDON)
+  0 STATE a! !  (CG-RESET)
+  CFBASE (CFP) a! !
+  SPAN a! @  >IN a! !
+  NODE-ERROR b! -1 !b ;
+
+\ ---- the control-flow stack ----------------------------------------------------
+
+\ ( x -- )   push; a full stack abandons the line
+: >CF
+  (CFP) a! @  CFEND xor if FULL
+  drop  (CFP) a! @  dup 1 + !  a! ! ;
+  FULL: drop drop  jump (ABANDON)
+
+\ ( -- x )   pop; 0 from an empty stack, which no opening word leaves
+: CF>
+  (CFP) a! @  CFBASE xor if EMPTY
+  drop  (CFP) a! @ -1 + dup !  a! @ ;
+  EMPTY: ;
+
+\ ---- compiling one word ------------------------------------------------------
+
+\ ( x n -- x' )   x shifted right n places; the bits that come in at the top
+\ are masked off by the caller
+: (RSHIFT)   if Z  -1 + push  L: 2/ next L  ;   Z: drop ;
+
+\ ( xt -- )   copy the in-line word at xt into the definition being built
+: (INLINE,)
+  W: dup a! @ (C) a! !  1 + (C)+1 a! !       \ the word, and its literals after it
+     0 (C)+4 a! !                            \ slot
+  S: (C)+4 a! @ (LOWBIT)  (C) a! @  SWAP (RSHIFT)  31 and     \ op
+     if END                                  \ ; ends the copy
+     dup -8 + if LIT
+     drop dup -28 + if NOP                   \ nop is padding
+     drop (OP,)
+  NXT: (C)+4 a! @ 1 + dup !  -6 + if NEXTW  drop jump S
+  NEXTW: drop  (C)+1 a! @  jump W            \ the next instruction word follows the literals
+  LIT: drop drop  (C)+1 a! @  dup 1 + !  a! @  (LIT,)  jump NXT
+  NOP: drop drop  jump NXT
+  END: drop ;
+
+\ ( xt -- )   compile the word at xt: in line if it is flagged so, else a call
+: (COMPILE,)
+  dup (FLAGS) a! @ 8 and if CALL  drop jump (INLINE,)
+  CALL: drop jump (CALL,)
+
+header EXECUTE
+: EXECUTE ( xt -- )   push ;
+
+\ ---- the interpreter's inner loop ---------------------------------------------
+
+\ ( -- n flag )   the word WORD has just left, as a single-cell number in the
+\ current BASE, and -1; or 0 0 if it is not one.  A leading minus sign is
+\ allowed.  This is what the interpreter uses: NUMBER (input.v4) makes a
+\ double and needs more of the stack than can be spared here.
+\ (P)+2 the number so far, (P)+3 where it is in the word, (P)+4 the word's
+\ length, (P)+5 the sign, (P)+6 the base.
+: (NUM?)
+  WBUF C@ if EMPTY
+  (P)+4 a! !  0 (P)+2 a! !  1 (P)+3 a! !  0 (P)+5 a! !
+  (BASE) (P)+6 a! !
+  WBUF+1 C@ -45 + if NEG  drop jump DIGITS
+  NEG: drop  -1 (P)+5 a! !  2 (P)+3 a! !
+       (P)+4 a! @ -1 + if EMPTY  drop        \ a sign alone
+  DIGITS:
+  L: (P)+4 a! @  (P)+3 a! @  -  -if MORE
+     drop  (P)+2 a! @  (P)+5 a! @ if POS  drop NEGATE -1 ;
+     POS: drop -1 ;
+  MORE: drop
+     (P)+3 a! @ dup 1 + !  WBUF + C@ (DIGIT)  \ d
+     -if DIGIT  jump BAD1
+     DIGIT: dup (P)+6 a! @ - -if BAD2  drop
+     (P)+2 a! @  (P)+6 a! @  STAR  +  (P)+2 a! !
+     jump L
+  BAD2: drop
+  BAD1: drop  0 0 ;
+  EMPTY: drop  0 0 ;
+
+\ ( -- )   FORTH-79: take words from the input stream until it is exhausted.
+\ A word in the dictionary is executed, or, when compiling and not immediate,
+\ compiled.  Anything else must be a number in the current BASE: it is left
+\ on the stack, or compiled as a literal.  What is neither, or a compile-only
+\ word met while interpreting, abandons the line.
+header INTERPRET
+: INTERPRET
+  L: 32 WORD dup C@ if EOL
+     drop (LOOKUP) if NUM
+     dup (FLAGS) a! @                        \ xt flags
+     STATE a! @ if INTERP
+       drop  1 and if COMP                   \ compiling: immediate words still run
+       drop EXECUTE  jump L
+       COMP: drop (COMPILE,)  jump L
+     INTERP: drop  16 and if RUN
+       drop drop  jump (ABANDON)
+       RUN: drop EXECUTE  jump L
+  NUM: drop  (NUM?) if BAD
+       drop
+       STATE a! @ if KEEP  drop (LIT,)  jump L
+       KEEP: drop  jump L
+  BAD: drop drop  jump (ABANDON)
+  EOL: drop drop ;
+
+\ ---- state ---------------------------------------------------------------------
+
+header [ immediate
+: LEFT-BRACKET    0 STATE a! ! ;
+header ]
+: RIGHT-BRACKET   -1 STATE a! ! ;
+
+\ ( x -- )   FORTH-79: if compiling, compile x as a literal
+header LITERAL immediate
+: LITERAL   STATE a! @ if NO  drop jump (LIT,)   NO: drop ;
+
+\ ( -- addr )   FORTH-79: the next word's parameter field address; if
+\ compiling, compiled as a literal
+header ' immediate
+: TICK      (')  jump LITERAL
+
+\ ---- colon definitions -----------------------------------------------------------
+
+\ ( -- flag )   an entry for the next word in the input stream; -1 if one was
+\ made.  (C)+2 holds LATEST meanwhile, to tell.
+: (NAMED)
+  LATEST (C)+2 a! !
+  32 WORD (HEADER)
+  LATEST (C)+2 a! @ xor if NONE  drop -1 ;
+  NONE: ;
+
+\ FORTH-79: start a definition; it cannot be found until ; ends it
+header :
+: COLON
+  (NAMED) if NONE  drop
+  HIDDEN  (CG-RESET)  CFBASE (CFP) a! !  jump RIGHT-BRACKET
+  NONE: drop ;
+
+\ FORTH-79: compile the return, let the word be found, stop compiling
+header ; immediate compile-only
+: SEMICOLON
+  0 (OP,)
+  LATEST (FLAGS) a! @ -3 and !
+  jump LEFT-BRACKET
+
+\ FORTH-79: return from the definition at this point
+header EXIT immediate compile-only
+: EXIT        0 jump (OP,)
+
+header IMMEDIATE
+: IMMEDIATE   LATEST if NONE  (FLAGS) a! @ 1 OR ! ;   NONE: drop ;
+
+\ COMPILE xxx   FORTH-79: when the word this is in runs, xxx is compiled
+header COMPILE immediate compile-only
+: COMPILE
+  32 WORD (LOOKUP) if MISSING
+  (LIT,)  &(COMPILE,) jump (CALL,)
+  MISSING: drop jump (ABANDON)
+
+\ [COMPILE] xxx   FORTH-79: compile xxx even though it is immediate
+header [COMPILE] immediate compile-only
+: BRACKET-COMPILE
+  32 WORD (LOOKUP) if MISSING  jump (COMPILE,)
+  MISSING: drop jump (ABANDON)
+
+\ ---- data words ---------------------------------------------------------------------
+\ A data word's code is one call to its run-time routine; the call leaves the
+\ address of the cell after it -- the parameter field -- on the return stack.
+
+: (DOVAR)   pop ;                            \ leave the parameter field address
+: (DOCON)   pop a! @ ;                       \ leave what it holds
+
+\ ( -- flag )   an entry for the next word, flagged data, its code a call to
+\ the routine whose address is in (C)+3; -1 if one was made
+: (DATA)
+  LATEST (C)+2 a! !                          \ (NAMED), in line: the calls
+  32 WORD (HEADER)                           \ below this are deep enough
+  LATEST (C)+2 a! @ xor if NONE  drop
+  (CG-RESET)
+  LATEST (FLAGS) a! @ 4 OR !
+  (C)+3 a! @ (CALL,)  -1 ;
+  NONE: ;
+
+\ FORTH-79: an entry whose word leaves the address of its parameter field
+header CREATE
+: CREATE     &(DOVAR) (C)+3 a! !  (DATA) drop ;
+
+\ FORTH-79: CREATE and one cell.  The standard leaves its first value to the
+\ programme; here it is 0.
+header VARIABLE
+: VARIABLE   &(DOVAR) (C)+3 a! !  (DATA) if NONE  drop 0 jump ,   NONE: drop ;
+
+\ ( n -- )   FORTH-79: an entry whose word leaves n
+header CONSTANT
+: CONSTANT   &(DOCON) (C)+3 a! !  (DATA) if NONE  drop jump ,   NONE: drop drop ;
+
+\ FORTH-79: in  : DEFINER  CREATE ... DOES> ... ;  the words after DOES> become
+\ what each word DEFINER makes does, starting with its parameter field address
+\ on the stack.  (DOES), run by DEFINER, turns the newest entry's code into a
+\ call to the code after it and leaves DEFINER; that code starts with pop,
+\ which fetches the parameter field address the call left.
+: (DOES)    pop  402653184 +  LATEST a! ! ;  \ 402653184 is `call` in slot 0
+header DOES> immediate compile-only
+: DOES>     &(DOES) (CALL,)  25 jump (OP,)
+
+\ ---- control structures (5.18, section 2) ---------------------------------------------
+\ All immediate and compile-only.  Each puts what the word that closes it
+\ needs on the control-flow stack, with a number on top saying which word put
+\ it there: 1 IF, 2 ELSE, 3 BEGIN, 4 WHILE, 5 DO, 6 ?DO.  A closing word that
+\ finds the wrong number abandons the line.
+
+\ ( tag wanted -- )   if they differ, abandon the line and leave the control
+\ word that called this as well: its return address is dropped, so the
+\ abandoning returns to the interpreter and nothing more is laid down.
+: (PAIR)   xor if OK  drop  pop drop  jump (ABANDON)   OK: drop ;
+
+\ ( ref -- )   the branch at ref lands here
+: (HERE!)   (LABEL) SWAP jump (RESOLVE)
+
+\ Native if leaves the flag, so both ways out of it drop it (section 2):
+\   IF a THEN          if L1  drop a  jump L2   L1: drop   L2:
+\   IF a ELSE b THEN   if L1  drop a  jump L2   L1: drop b   L2:
+header IF immediate compile-only
+: IF     6 (BRANCH>) >CF  23 (OP,)  1 jump >CF
+header ELSE immediate compile-only
+: ELSE
+  CF> 1 (PAIR)  CF> (C)+6 a! !               \ the if
+  2 (BRANCH>) >CF                            \ the jump over the else part
+  (C)+6 a! @ (HERE!)  23 (OP,)
+  2 jump >CF
+header THEN immediate compile-only
+: THEN
+  CF> dup -1 + if PLAIN
+  drop  2 (PAIR)  CF> jump (HERE!)
+  PLAIN: drop drop
+  CF> (C)+6 a! !                             \ the if
+  2 (BRANCH>) >CF
+  (C)+6 a! @ (HERE!)  23 (OP,)
+  CF> jump (HERE!)
+
+\ A loop that tests at its end jumps back with the flag still there, so it
+\ jumps back to a drop laid just ahead of the body:
+\   BEGIN a UNTIL            jump L0   Ld: drop   L0: a   if Ld   drop
+\   BEGIN a WHILE b REPEAT   jump L0   Ld: drop   L0: a   if Lx  drop b  jump L0   Lx: drop
+\   BEGIN a AGAIN            jump L0   Ld: drop   L0: a   jump L0
+\ The control-flow stack holds Ld, L0 and 3.
+header BEGIN immediate compile-only
+: BEGIN
+  2 (BRANCH>) (C)+6 a! !
+  (LABEL) >CF  23 (OP,)
+  (LABEL) dup >CF  (C)+6 a! @ (RESOLVE)
+  3 jump >CF
+header UNTIL immediate compile-only
+: UNTIL    CF> 3 (PAIR)  CF> drop  CF> 6 (BRANCH,)  23 jump (OP,)
+header AGAIN immediate compile-only
+: AGAIN    CF> 3 (PAIR)  CF> (JUMP,)  CF> drop ;
+header WHILE immediate compile-only
+: WHILE    CF> 3 (PAIR)  3 >CF  6 (BRANCH>) >CF  23 (OP,)  4 jump >CF
+header REPEAT immediate compile-only
+: REPEAT
+  CF> 4 (PAIR)  CF> (C)+6 a! !               \ the while
+  CF> 3 (PAIR)  CF> (JUMP,)  CF> drop
+  (C)+6 a! @ (HERE!)  23 jump (OP,)
+
+\ DO loops: the limit and index are on the return stack, limit below (5.18).
+: (do)        over push push drop ;
+: (?do)       over over xor ;
+: (inc)       pop 1 + pop ;                  \ index' limit
+: (+inc)      dup a! pop + pop ;             \ index' limit      A: the step
+: (differ)    drop over ;
+: (same)      drop over over - ;
+: (a-xor)     a xor ;
+: (again)     drop push push ;
+: (3drop)     drop drop drop ;
+
+\ lay <less>:  ( i' lim -- i' lim s ), the top bit of s set when i' < lim
+: (LESS,)
+  &(?do) (INLINE,)  7 (BRANCH>) >CF
+  &(differ) (INLINE,)  2 (BRANCH>) (C)+6 a! !
+  CF> (HERE!)  &(same) (INLINE,)
+  (C)+6 a! @ jump (HERE!)
+
+\ The end of a loop, after its increment and test.  The control-flow stack
+\ holds the body's address and 5, or for ?DO its skip, the body and 6.
+\   -if EXIT  drop push push  jump BODY   EXIT: drop drop drop
+\ and for ?DO the landing of its skip:   jump PAST   SKIP: drop drop drop   PAST:
+: (LOOP-END)
+  CF> (C)+7 a! !                             \ the tag
+  7 (BRANCH>) (C)+6 a! !
+  &(again) (INLINE,)  CF> (JUMP,)
+  (C)+6 a! @ (HERE!)  &(3drop) (INLINE,)
+  (C)+7 a! @ -5 + if PLAIN
+  drop  (C)+7 a! @ 6 (PAIR)
+  2 (BRANCH>) (C)+6 a! !
+  CF> (HERE!)  &(3drop) (INLINE,)
+  (C)+6 a! @ jump (HERE!)
+  PLAIN: drop ;
+
+header DO immediate compile-only
+: DO      &(do) (INLINE,)  (LABEL) >CF  5 jump >CF
+header ?DO immediate compile-only
+: ?DO     &(?do) (INLINE,)  6 (BRANCH>) >CF  23 (OP,)  &(do) (INLINE,)  (LABEL) >CF  6 jump >CF
+header LOOP immediate compile-only
+: LOOP    &(inc) (INLINE,)  (LESS,)  jump (LOOP-END)
+header +LOOP immediate compile-only
+: +LOOP   &(+inc) (INLINE,)  (LESS,)  &(a-xor) (INLINE,)  jump (LOOP-END)

v4/capsule/core.v4

@@ -13,6 +13,7 @@ macro NEGATE inv 1 +                       endmacro
 macro NIP    push drop pop                 endmacro
 
 \ ---- section 4: multiply ------------------------------------------------
+header UM*
 : UM* ( u1 u2 -- ulo uhi )
   over 1 and inv 1 +  over 2/ and      \ u1 u2 t0       t0 = u2 2/ if u1 odd
   over a!  N-1 push                    \ A: u2          R: loop count
@@ -26,6 +27,7 @@ macro NIP    push drop pop                 endmacro
   and 1 and  a 2* +  pop ;
 
 \ ---- section 5.7: doubles ------------------------------------------------
+header D+
 : D+ ( d1 d2 -- d3 )
   push  over push  push drop pop       \ al bl      R: bh ah
   over over xor -if L1
@@ -36,11 +38,13 @@ macro NIP    push drop pop                 endmacro
   C0: pop pop + ;
   C1: pop pop + 1 + ;
 
+header DNEGATE
 : DNEGATE ( d -- -d )
   inv over if L1  drop push inv 1 + pop ;
   L1: drop 1 + ;
 
 \ ---- section 5.3: bytes --------------------------------------------------
+header C@
 : C@ ( baddr -- c )
   dup 2/ 2/ a!  3 and
   if K0  -1 + if K1  -1 + if K2
@@ -49,6 +53,7 @@ macro NIP    push drop pop                 endmacro
   K1: drop @   7 FOR 2/ UNEXT  255 and ;
   K0: drop @  255 and ;
 
+header C!
 : C! ( c baddr -- )
   dup 2/ 2/ a!  3 and  push 255 and pop
   if K0  -1 + if K1  -1 + if K2
@@ -58,6 +63,7 @@ macro NIP    push drop pop                 endmacro
   K0: drop  @ -256 and + ! ;
 
 \ ---- section 5.9: strings ------------------------------------------------
+header CMOVE
 : CMOVE ( src dst u -- )
   -if OK  drop drop drop  NODE-ERROR b! -1 !b ;
   OK: if DONE  push
@@ -65,7 +71,9 @@ macro NIP    push drop pop                 endmacro
   DONE: drop drop drop ;
 
 \ ---- section 5.10: the console -------------------------------------------
+header EMIT
 : EMIT ( c -- )        CONSOLE-TX b! !b ;
+header KEY
 : KEY  ( -- c )
   L: CONSOLE-STATUS b! @b  if WAIT  drop  CONSOLE-RX b! @b ;
   WAIT: drop  jump L

v4/capsule/dict.v4

@@ -29,7 +29,7 @@
 \   (LATEST)  word address of the variable: the xt of the newest entry, or 0
 \   DBASE DLIMIT   byte addresses of the start and end of dictionary space
 \   PAD       byte address of the scratch area for strings, 84 bytes or more
-\   (D)       word address of two cells of scratch for this file
+\   (D)       word address of five cells of scratch for this file
 \ PAD is in line.
 
 macro 4*  2* 2*  endmacro
@@ -37,103 +37,156 @@ macro 4/  2/ 2/  endmacro
 macro OR  over inv and xor  endmacro
 
 \ ---- the space (5.12) ------------------------------------------------------
+\ These reach DP through B and leave A alone, so that , and C, can keep what
+\ they are storing in A while the space is taken: nothing of theirs is then
+\ on the data stack under (DP+), which itself needs three cells (D-2).
 
 : (DERR) ( -- 0 )      NODE-ERROR b! -1 !b  0 ;
 
 \ ( n -- flag )   move DP by n bytes if it stays inside the dictionary space
-\ and say -1; otherwise leave it, set NODE-ERROR and say 0.
+\ and say -1; otherwise leave it, set NODE-ERROR and say 0.  The two
+\ subtractions are x + ~y + 1, which unlike the in-line - needs no return
+\ entry: these words are called at the bottom of long chains of calls.
 : (DP+)
-  DP a! @ +
-  dup DBASE - -if LOW  drop drop jump (DERR)
-  LOW: drop  DLIMIT over - -if HIGH  drop drop jump (DERR)
-  HIGH: drop  DP a! !  -1 ;
+  DP b! @b +
+  dup DBASE inv + 1 + -if LOW  drop drop jump (DERR)         \ new - DBASE
+  LOW: drop  dup inv DLIMIT + 1 + -if HIGH  drop drop jump (DERR)   \ DLIMIT - new
+  HIGH: drop  DP b! !b  -1 ;
 
-: HERE  ( -- addr )    DP a! @  3 +  4/ ;
-: ALIGN ( -- )         DP a! @  3 +  -4 and  DP a! ! ;
+header HERE
+: HERE  ( -- addr )    DP b! @b  3 +  4/ ;
+header ALIGN
+: ALIGN ( -- )         DP b! @b  3 +  -4 and  !b ;
+header ALLOT
 : ALLOT ( n -- )       ALIGN  4* (DP+) drop ;
 
+\ , calls nothing: the code generator calls it from as deep as anything goes.
+header ,
 : ,  ( x -- )
-  ALIGN  HERE push  4 (DP+) if FULL  drop pop a! ! ;
-  FULL: drop pop drop drop ;
+  a!
+  DP b! @b  3 + -4 and                       \ the next whole cell, as a byte address
+  dup inv DLIMIT + -3 +  -if ROOM            \ DLIMIT - (it + 4)
+  drop drop  NODE-ERROR b! -1 !b ;
+  ROOM: drop  dup 4 + !b                     \ DP is past it
+  4/ b!  a !b ;
+header C,
 : C, ( c -- )
-  DP a! @ push  1 (DP+) if FULL  drop pop C! ;
-  FULL: drop pop drop drop ;
+  a!  1 (DP+) if FULL
+  drop  a  DP b! @b -1 +  jump C!
+  FULL: drop ;
+header 2,
 : 2, ( lo hi -- )      SWAP , , ;                       \ the low cell first, as v3
 
+header LATEST
 : LATEST ( -- xt )     (LATEST) a! @ ;
 
 \ ---- the fields of an entry (5.13) -----------------------------------------
 
 : (FLAGS) ( xt -- addr )    -3 + ;
+header >LINK
 : >LINK   ( xt -- addr )    -1 + ;
+header LFA
 : LFA     ( xt -- addr )    jump >LINK
+header LINK>
 : LINK>   ( addr -- xt )    a! @ ;
+header >NAME
 : >NAME   ( xt -- baddr )   -2 + a! @ 4* ;
+header NFA
 : NFA     ( xt -- baddr )   jump >NAME
+header NAME>
 : NAME>   ( baddr -- xt )   dup C@ 31 and 4 + 4/  push 4/ pop +  3 + ;
+header CFA
 : CFA     ( xt -- xt )      ;
+header PFA
 : PFA     ( xt -- addr )    dup (FLAGS) a! @ 4 and if CODE  drop 1 + ;   CODE: drop ;
+header >BODY
 : >BODY   ( xt -- addr )    jump PFA
 
 \ ( baddr n -- baddr' )   as v3: for n > 0, from a name's count byte to the
 \ byte after its last character; otherwise the address unchanged.
+header TRAVERSE
 : TRAVERSE
   -if NN  drop ;
   NN: if ZERO  drop  dup C@ 31 and + 1 + ;
   ZERO: drop ;
 
+header SMUDGE
 : SMUDGE ( -- )   LATEST if NONE  (FLAGS) a! @ 2 xor ! ;   NONE: drop ;
+header HIDDEN
 : HIDDEN ( -- )   LATEST if NONE  (FLAGS) a! @ 2 OR  ! ;   NONE: drop ;
 
 \ ---- making an entry -------------------------------------------------------
+\ (D)+0 where the name starts   (D)+1 the name being looked up
+\ (D)+2 the name being copied, or the entry being looked at
+\ (D)+3 a count                 (D)+4 (CLIP)'s string
 
 \ ( baddr -- baddr )   cut the counted string to 31 characters, in place
-: (CLIP)   dup C@ -32 + -if LONG  drop ;   LONG: drop  31 over C! ;
+: (CLIP)
+  dup (D)+4 a! !  C@ -32 + -if LONG  drop  (D)+4 a! @ ;
+  LONG: drop  31 (D)+4 a! @ C!  (D)+4 a! @ ;
+
+\ ( -- bytes )   what an entry for a name of (D)+3 characters takes: its name
+\ cells and three more
+: (NEED)   (D)+3 a! @  4 + -4 and  12 + ;
 
 \ ( baddr -- )   an entry for the counted string at baddr; its code starts at
 \ HERE afterwards.  An empty name, or no room, makes nothing and sets
 \ NODE-ERROR.
 : (HEADER)
-  (CLIP) dup C@ if EMPTY                     \ baddr len
+  dup (D)+2 a! !                             \ (CLIP), in line
+  C@ -32 + -if LONG  drop jump CLIPPED
+  LONG: drop  31 (D)+2 a! @ C!
+  CLIPPED:
+  (D)+2 a! @ C@ if EMPTY                     \ len
+  (D)+3 a! !
   ALIGN
-  dup 4 + -4 and 12 +                        \ baddr len need   bytes: name cells and three more
-  dup (DP+) if FULL  drop NEGATE (DP+) drop  \ there is room; DP back where it was
+  (NEED) (DP+) if FULL  drop                 \ there is room;
+  (NEED) NEGATE (DP+) drop                   \ DP back where it was
   HERE (D) a! !                              \ where the name starts
-  dup C,                                     \ baddr len
-  L: if DONE  SWAP 1 + dup C@ C,  SWAP -1 +  jump L   \ nothing on R across C,
-  DONE: drop drop
-  P: DP a! @ 3 and if ALIGNED  drop 0 C,  jump P
+  (D)+3 a! @ C,
+  L: (D)+3 a! @ if DONE  -1 + !
+     (D)+2 a! @ 1 + dup !  C@ C,
+     jump L
+  DONE: drop
+  P: DP b! @b 3 and if ALIGNED  drop 0 C,  jump P
   ALIGNED: drop
   0 ,  (D) a! @ ,  LATEST ,
   HERE (LATEST) a! ! ;
-  FULL: drop drop
-  EMPTY: drop drop  NODE-ERROR b! -1 !b ;
+  FULL: drop ;                               \ (DP+) has set NODE-ERROR
+  EMPTY: drop  NODE-ERROR b! -1 !b ;
 
 \ ---- looking a name up -----------------------------------------------------
 
-\ ( baddr1 baddr2 -- flag )   two counted strings are the same
+\ ( -- flag )   the name of the entry in (D)+2 is the counted string in (D)+1
 : (NAME=)
-  over C@ 1 +                                \ b1 b2 n     the count byte and the characters
-  L: if SAME  push
-     over C@ over C@ xor if EQ  drop drop drop pop drop  0 ;
-     EQ: drop  1 + push 1 + pop  pop -1 +  jump L
-  SAME: drop drop drop  -1 ;
+  (D)+2 a! @ >NAME (D) a! !
+  (D)+1 a! @ C@ 1 +  (D)+3 a! !              \ the count byte and the characters
+  L: (D)+3 a! @ if SAME  -1 + dup !          \ k
+     dup (D) a! @ + C@                       \ k c1
+     SWAP (D)+1 a! @ + C@                    \ c1 c2
+     xor if EQ  drop 0 ;
+     EQ: drop jump L
+  SAME: drop -1 ;
 
 \ ( baddr -- xt | 0 )   the newest visible entry named by the counted string
 : (LOOKUP)
-  (CLIP) (D) 1 + a! !
+  (CLIP) (D)+1 a! !
   LATEST
   L: if END
-     dup (FLAGS) a! @ 2 and if VISIBLE  jump OLDER
-     VISIBLE: drop  dup >NAME  (D) 1 + a! @  (NAME=) if OLDER  drop ;
-     OLDER: drop  >LINK a! @  jump L
+     (D)+2 a! !
+     (D)+2 a! @ (FLAGS) a! @ 2 and if VISIBLE  drop jump OLDER
+     VISIBLE: drop  (NAME=) if DIFF  drop  (D)+2 a! @ ;
+     DIFF: drop
+     OLDER: (D)+2 a! @ >LINK a! @  jump L
   END: ;
 
 \ ( -- xt | 0 )   FORTH-79: the compilation address of the next word in the
 \ input stream, or 0 if it is not in the dictionary.
+header FIND
 : FIND   32 WORD jump (LOOKUP)
 
 \ ( -- addr )   FORTH-79: the parameter field address of the next word in the
-\ input stream.  Not found is an error: 0, and NODE-ERROR is set.
-: '      32 WORD (LOOKUP) if MISSING  jump PFA
+\ input stream.  Not found is an error: 0, and NODE-ERROR is set.  This is '
+\ when interpreting; compile.v4 adds what ' does when compiling.
+: (')    32 WORD (LOOKUP) if MISSING  jump PFA
   MISSING: drop jump (DERR)

v4/capsule/forth.v4

@@ -0,0 +1,72 @@
+\ forth.v4 -- the first words of the FORTH vocabulary: the ones that are
+\ opcodes or short runs of them, and the variables that are in-line addresses.
+\
+\ Each is the definition DECOMPOSITION.md gives (sections 4, 5.1 - 5.5, 5.18).
+\ A word flagged inline is copied into a definition in place of a call; the
+\ ones that touch the return stack are compile-only as well.  Rests on core.v4
+\ and compile.v4's loader constants.
+
+\ ---- stack ----
+header DUP inline       : DUP     dup ;
+header DROP inline      : DROP    drop ;
+header OVER inline      : OVER    over ;
+header SWAP inline      : SWAP'   SWAP ;
+header ROT inline       : ROT'    ROT ;
+header -ROT inline      : -ROT    SWAP push SWAP pop ;
+header ?DUP             : ?DUP    if Z  dup ;   Z: ;
+header 2DUP inline      : 2DUP    over over ;
+header 2DROP inline     : 2DROP   drop drop ;
+
+\ ---- return stack: in line, and only inside a definition ----
+header >R inline compile-only   : >R    push ;
+header R> inline compile-only   : R>    pop ;
+header R@ inline compile-only   : R@    pop dup push ;
+header I inline compile-only    : I     pop dup push ;
+header J inline compile-only    : J     pop pop  pop dup push a!  push push  a ;
+header LEAVE inline compile-only    : LEAVE    pop pop drop dup push push ;
+header UNLOOP inline compile-only   : UNLOOP   pop drop pop drop ;
+
+\ ---- memory ----
+header @ inline         : FETCH   a! @ ;
+header ! inline         : STORE   a! ! ;
+header +! inline        : +!      a! @ + ! ;
+header CELLS inline     : CELLS   ;                    \ an address unit is a cell (D-1)
+
+\ ---- arithmetic ----
+header + inline         : PLUS    + ;
+header - inline         : MINUS   - ;
+\ The low cell of the product, by N steps of +* with nothing but the count on
+\ the return stack.  UM* drop gives the same cell but needs two more return
+\ entries, which a word inside two DO loops does not have (D-2).  The low
+\ cell is exact: what +* loses at the top of T (D-3) takes N shifts to reach
+\ the bit that moves into A, and the loop ends first.
+header * : STAR    a!  0  N-1 FOR +* UNEXT  drop drop a ;
+header NEGATE inline    : NEGATE' NEGATE ;
+header 1+ inline        : 1+      1 + ;
+header 1- inline        : 1-      -1 + ;
+header 2+ inline        : 2+      2 + ;
+header 2- inline        : 2-      -2 + ;
+header 2* inline        : TWO*    2* ;
+header 2/ inline        : TWO/    2/ ;
+
+\ ---- logic and comparison ----
+header AND inline       : AND     and ;
+header XOR inline       : XOR     xor ;
+header OR inline        : OR'     OR ;
+header 0= : 0=    if L1  drop 0 ;   L1: drop -1 ;
+header 0< : 0<    -if L1  drop -1 ;   L1: drop 0 ;
+header NOT : NOT   jump 0=
+header = : EQUALS  xor jump 0=
+header < : LESS
+  over over xor -if SAME  drop drop jump 0<
+  SAME: drop - jump 0<
+header > : GREATER   SWAP jump LESS
+
+\ ---- in-line addresses and constants ----
+header BL inline        : BL'     BL ;
+header TIB inline       : TIB'    TIB ;
+header >IN inline       : >IN'    >IN ;
+header SPAN inline      : SPAN'   SPAN ;
+header BASE inline      : BASE'   BASE ;
+header PAD inline       : PAD'    PAD ;
+header STATE inline     : STATE'  STATE ;

v4/capsule/input.v4

@@ -12,12 +12,13 @@
 \   SPAN     word address of the variable: how many characters the last
 \            EXPECT or QUERY read
 \   WBUF     byte address of WORD's buffer, 257 bytes
-\   (P)      word address of six cells of scratch for this file
+\   (P)      word address of eight cells of scratch for this file
 \ TIB >IN SPAN and BL are in-line: written in a definition they are literals.
 
 macro BL  32  endmacro
 
 \ ( -- baddr u )   the input buffer and how much of it is in use
+header SOURCE
 : SOURCE   TIB  SPAN a! @  -if P  drop 0  P: ;
 
 \ ( baddr n -- )   FORTH-79: characters from the terminal are stored from
@@ -26,6 +27,7 @@ macro BL  32  endmacro
 \ must hold n + 1 bytes.  No action for n <= 0.  SPAN is how many characters
 \ were stored (SPAN is not FORTH-79; v3 has it).  A line longer than n leaves
 \ the rest, its new-line included, to be read next.
+header EXPECT
 : EXPECT
   -if NN  drop drop ;                        \ n < 0
   NN: if ZERO
@@ -39,23 +41,24 @@ macro BL  32  endmacro
   ZERO: drop drop ;
 
 \ ( -- )   FORTH-79: up to 80 characters, or a line, into TIB; >IN to 0.
+header QUERY
 : QUERY   TIB 80 EXPECT  0 >IN a! ! ;
 
 \ ---- WORD ------------------------------------------------------------------
-\ (P)+0 the delimiter, (P)+1 the length of the text in TIB, (P)+2 the length
-\ of the word (CONVERT uses (P)+2 too; the two never run inside each other).
-macro (WDELIM)  (P)      endmacro
-macro (WLEN)    (P) 1 +  endmacro
+\ WORD is called from deep inside the interpreter and compiler, with whatever
+\ the user has on the stacks beneath it, and the stacks are ten and nine deep
+\ (D-2).  So everything it works on is in (P), and it never has more than
+\ three cells of its own on the data stack:
+\   (P)+0 the delimiter         (P)+1 the length of the text in TIB
+\   (P)+2 the word's length     (P)+3 how much of it is still to be copied
+\   (P)+6 where it is in TIB    (P)+7 where the word starts
+\ (CONVERT and NUMBER use (P)+2 .. (P)+5; they and WORD never run inside
+\ each other.)
 
-: (LEFT) ( i -- i d )   dup (WLEN) a! @ - ;          \ d < 0 while i is inside the text
-: (CH)   ( i -- i x )   dup TIB + C@ (WDELIM) a! @ xor ;   \ x = 0 at a delimiter
-: (SKIP) ( i -- i' )    \ past delimiters
-  L: (LEFT) -if E  drop (CH) if S  drop ;
-  S: drop 1 + jump L
-  E: drop ;
-: (SCAN) ( i -- i' )    \ up to a delimiter
-  L: (LEFT) -if E  drop (CH) if E  drop 1 + jump L
-  E: drop ;
+\ In line, not called: WORD may have only a few return entries to spare.
+macro (LEFT)   (P)+6 a! @  (P)+1 a! @  -            endmacro   \ ( -- d )  d < 0 while inside the text
+macro (CH)     (P)+6 a! @ TIB + C@  (P) a! @  xor   endmacro   \ ( -- x )  x = 0 at a delimiter
+macro (STEP)   (P)+6 a! @ 1 + !                     endmacro
 
 \ ( c -- baddr )   FORTH-79: characters are taken from TIB until the
 \ delimiter c or the end of the text, leading delimiters ignored, and stored
@@ -63,26 +66,38 @@ macro (WLEN)    (P) 1 +  endmacro
 \ ran out -- is stored after them and is not counted.  >IN is left just past
 \ that delimiter.  With nothing left the count is 0.  The count is a byte,
 \ so a word longer than 255 characters is cut to 255.
+header WORD
 : WORD
-  255 and (WDELIM) a! !
-  SPAN a! @  -if A drop 0 A:  (WLEN) a! !
-  >IN a! @   -if B drop 0 B:
-  (SKIP) dup push (SCAN)                     \ end       R: start
-  pop over over -                            \ end start len
+  255 and (P) a! !
+  SPAN a! @  -if A drop 0 A:  (P)+1 a! !
+  >IN a! @   -if B drop 0 B:  (P)+6 a! !
+  SK: (LEFT) -if SKE  drop (CH) if SKS  drop jump SKIPPED      \ past delimiters
+  SKS: drop (STEP) jump SK
+  SKE: drop
+  SKIPPED:
+  (P)+6 a! @ (P)+7 a! !                      \ where it starts
+  SC: (LEFT) -if SCE  drop (CH) if SCE  drop (STEP) jump SC    \ up to a delimiter
+  SCE: drop
+  (P)+6 a! @  (P)+7 a! @  -                  \ its length
   dup -256 + -if CAP  drop jump FITS   CAP: drop drop 255   FITS:
-  dup WBUF C!
-  dup (P) 2 + a! !                           \ the length waits in (P)+2, not on a stack
-  push TIB + WBUF 1 + pop  CMOVE             \ end
+  dup (P)+2 a! !  (P)+3 a! !
+  (P)+2 a! @ WBUF C!
+  \ copy it, last character first
+  CP: (P)+3 a! @ if COPIED  -1 + dup !       \ k
+      dup (P)+7 a! @ + TIB + C@              \ k c
+      SWAP WBUF+1 + C!
+      jump CP
+  COPIED: drop
   (LEFT) -if RANOUT
-    drop  (WDELIM) a! @  (P) 2 + a! @ WBUF + 1 + C!     \ the delimiter after the text
-    1 +  >IN a! !  WBUF ;
-  RANOUT: drop  0  (P) 2 + a! @ WBUF + 1 + C!
-    >IN a! !  WBUF ;
+    drop  (P) a! @  (P)+2 a! @ WBUF+1 + C!   \ the delimiter after the text
+    (P)+6 a! @ 1 +  >IN a! !  WBUF ;
+  RANOUT: drop  0  (P)+2 a! @ WBUF+1 + C!
+    (P)+6 a! @  >IN a! !  WBUF ;
 
 \ ---- ENCLOSE ---------------------------------------------------------------
 \ (P)+0 the delimiter, (P)+1 the string's address.
 : (E?) ( i -- i k )     \ k: 0 at the end of the string, 1 at a delimiter, else 2
-  dup (WLEN) a! @ + C@  if END  (WDELIM) a! @ xor if DEL  drop 2 ;
+  dup (P)+1 a! @ + C@  if END  (P) a! @ xor if DEL  drop 2 ;
   DEL: drop 1 ;
   END: drop 0 ;
 : (ESKIP) ( i -- i' )   L: (E?) -1 + if S  drop ;   S: drop 1 + jump L
@@ -91,8 +106,9 @@ macro (WLEN)    (P) 1 +  endmacro
 \ ( baddr c -- baddr n1 n2 n3 )   in the zero-terminated string at baddr:
 \ n1 the offset of the first character that is not c, n2 the offset of the
 \ first c after it, n3 the offset of the first character after that run of c.
+header ENCLOSE
 : ENCLOSE
-  255 and (WDELIM) a! !  dup (WLEN) a! !
+  255 and (P) a! !  dup (P)+1 a! !
   0 (ESKIP)  dup (ESCAN)  dup (ESKIP) ;
 
 \ ---- CONVERT and NUMBER ----------------------------------------------------
@@ -111,40 +127,48 @@ macro (WLEN)    (P) 1 +  endmacro
 \ it is multiplied by BASE, until one is not a digit; baddr2 is its address.
 \ (P)+2 holds the digit while the double is multiplied and (P)+5 the address,
 \ so nothing waits on the return stack across the calls.
+header CONVERT
 : CONVERT
-  L: 1 + dup (P) 5 + a! !  C@ (DIGIT)        \ lo hi n
-     -if DIG  drop  (P) 5 + a! @ ;
+  L: 1 + dup (P)+5 a! !  C@ (DIGIT)        \ lo hi n
+     -if DIG  drop  (P)+5 a! @ ;
      DIG: dup (BASE) - -if BIG
-          drop  (P) 2 + a! !                 \ lo hi
+          drop  (P)+2 a! !                 \ lo hi
           (BASE) UM* drop                    \ lo hi*base
           SWAP (BASE) UM*                    \ hi*base plo phi
           push SWAP pop +                    \ plo hi'
-          (P) 2 + a! @ 0 D+
-          (P) 5 + a! @  jump L
-     BIG: drop drop  (P) 5 + a! @ ;
+          (P)+2 a! @ 0 D+
+          (P)+5 a! @  jump L
+     BIG: drop drop  (P)+5 a! @ ;
 
-\ ( baddr -- d )   FORTH-79: the counted string at baddr as a signed double in
-\ the current BASE; it may begin with a minus sign.  If it is empty, is only
-\ a sign, or holds anything that is not a digit, the result is 0 and
-\ NODE-ERROR is set.  The character after the string must not be a digit
+\ ( baddr -- d flag )   the counted string at baddr as a signed double in the
+\ current BASE, and -1; it may begin with a minus sign.  If it is empty, is
+\ only a sign, or holds anything that is not a digit: 0 0 and 0.  The character after the string must not be a digit
 \ (WORD puts the delimiter or a zero there); if it is, that too is reported
 \ as an error.  (P)+3 the address of its last character, (P)+4 the sign.
-: NUMBER
+: (NUMBER?)
   dup C@ if ERR2
-  over + (P) 3 + a! !                        \ baddr
+  over + (P)+3 a! !                        \ baddr
   dup 1 + C@ -45 + if NEG
-    drop  0 (P) 4 + a! !  jump GO
-  NEG: drop  -1 (P) 4 + a! !  1 +
-       dup (P) 3 + a! @ xor if ERR2  drop
+    drop  0 (P)+4 a! !  jump GO
+  NEG: drop  -1 (P)+4 a! !  1 +
+       dup (P)+3 a! @ xor if ERR2  drop
   GO: push 0 0 pop CONVERT                   \ lo hi baddr2
-      (P) 3 + a! @ 1 + xor if FINE
+      (P)+3 a! @ 1 + xor if FINE
       drop drop drop jump ERR0
-  FINE: drop  (P) 4 + a! @ if POS  drop jump DNEGATE
-  POS: drop ;
+  FINE: drop  (P)+4 a! @ if POS  drop DNEGATE -1 ;
+  POS: drop  -1 ;
   ERR2: drop drop
-  ERR0: NODE-ERROR b! -1 !b  0 0 ;
+  ERR0: 0 0 0 ;
+
+\ ( baddr -- d )   FORTH-79.  What is not a number gives 0 and sets NODE-ERROR.
+header NUMBER
+: NUMBER
+  (NUMBER?) if BAD  drop ;
+  BAD: drop  NODE-ERROR b! -1 !b ;
 
 \ ---- comments (5.15) -------------------------------------------------------
 \ PAREN skips to the closing parenthesis; BACKSLASH skips the rest of the line.
+header ( immediate
 : PAREN      41 WORD drop ;
+header \ immediate
 : BACKSLASH  SPAN a! @  >IN a! ! ;

v4/include/v4/text.h

@@ -26,6 +26,10 @@
  *   123  -5  $FF     a literal: `@p` and its value.  Decimal, or hex after $.
  *                    It must fit a cell, as a signed or an unsigned number.
  *   CONST            a constant given by v4_text_constant: a literal.
+ *   CONST+N          the constant plus the number N: one literal.  (Only when
+ *                    the whole token is not itself a name.)
+ *   &NAME            the address of the word NAME, which must already be
+ *                    defined: a literal.
  *   ; + dup a! ...   an opcode.  `@p` cannot be written; write the number.
  *   jump X  call X  if X  -if X  next X
  *                    a branch to X: a label of this word if it has one of
@@ -42,6 +46,15 @@
  *                    may use other macros; it may not define a word, a label
  *                    or a macro.
  *
+ *   header NAME      a dictionary entry for NAME (capsule/dict.v4), laid down
+ *                    in front of the word that the next `:` starts, and
+ *                    linked to the header before it.  NAME is taken as it
+ *                    stands -- it may be ( or \ or + -- and is at most 31
+ *                    characters.  Between it and the `:` may come the flags
+ *                    immediate, data, inline and compile-only.  The word after
+ *                    `:` is the assembler's name for the code, as always, and
+ *                    need not be the same:   header + inline  : PLUS  + ;
+ *
  * A name is looked up in this order: opcode, macro, number, constant, label
  * (for a branch target), word.  So an opcode's name cannot be redefined, and
  * the FORTH words that share one (`@`, `!`, `+`, ...) are written as their
@@ -99,6 +112,9 @@ typedef struct {
     char     pool[V4_TEXT_POOL];
     unsigned pool_used;
 
+    v4_cell  latest;                   /* xt of the newest header, 0 if none */
+    int      header_pending;           /* a header waits for its `:` */
+
     unsigned line;
     int      failed;
     char     message[224];
@@ -125,6 +141,10 @@ int v4_text_finish(v4_text *t);
 /* The address of the word NAME, or -1 if there is none. */
 v4_cell v4_text_word(const v4_text *t, const char *name);
 
+/* The xt of the newest `header`, 0 if there has been none: what the
+ * dictionary's LATEST starts as. */
+v4_cell v4_text_latest(const v4_text *t);
+
 /* The next free word address. */
 v4_cell v4_text_here(v4_text *t);
 

v4/src/text.c

@@ -50,11 +50,22 @@ static const v4_text_symbol *find(const v4_text *t, const char *s)
     return NULL;
 }
 
+/* The entry flags a `header` may be given (capsule/dict.v4). */
+static v4_cell flag_of(const char *s)
+{
+    if (strcmp(s, "immediate") == 0)    return 1;
+    if (strcmp(s, "data") == 0)         return 4;
+    if (strcmp(s, "inline") == 0)       return 8;
+    if (strcmp(s, "compile-only") == 0) return 16;
+    return 0;
+}
+
 static int is_reserved(const char *s)
 {
     return strcmp(s, ":") == 0 || strcmp(s, "macro") == 0 || strcmp(s, "endmacro") == 0
         || strcmp(s, "\\") == 0 || strcmp(s, "(") == 0
-        || strcmp(s, "FOR") == 0 || strcmp(s, "NEXT") == 0 || strcmp(s, "UNEXT") == 0;
+        || strcmp(s, "FOR") == 0 || strcmp(s, "NEXT") == 0 || strcmp(s, "UNEXT") == 0
+        || strcmp(s, "header") == 0 || flag_of(s) != 0;
 }
 
 static int is_label_def(const char *s)
@@ -129,6 +140,75 @@ static int next_token(v4_text *t, reader *r, char *tok)
     }
 }
 
+static void end_word(v4_text *t);
+static void check_asm(v4_text *t, const char *tok);
+
+/* The next run of non-blank characters of the source, whatever they are:
+ * a header's name may be ( or \ or any opcode. */
+static int raw_token(v4_text *t, reader *r, char *tok)
+{
+    const char *p;
+    unsigned len = 0;
+    if (r->depth != 1) return 0;
+    p = r->p[0];
+    while (*p == ' ' || *p == '\t' || *p == '\r' || *p == '\n') { if (*p == '\n') t->line++; p++; }
+    while (*p && *p != ' ' && *p != '\t' && *p != '\r' && *p != '\n') {
+        if (len < V4_TEXT_MAX_TOKEN) tok[len] = *p;
+        len++; p++;
+    }
+    r->p[0] = p;
+    if (len == 0 || len > V4_TEXT_MAX_TOKEN) return 0;
+    tok[len] = 0;
+    return 1;
+}
+
+/* One cell appended at the next word address; nothing is being built. */
+static void put_cell(v4_text *t, v4_cell value)
+{
+    v4_asm *as = &t->as;
+    if (as->here < 0 || (v4_ucell)as->here >= V4_NODE_WORDS) { as->error = 1; return; }
+    v4_node_store(as->n, as->here, value);
+    as->here++;
+}
+
+/* `header NAME`: a dictionary entry for NAME, as capsule/dict.v4 lays one
+ * out, in front of the word the next `:` starts:
+ *     the name: its count byte, then its characters, four bytes to a cell,
+ *               zero-padded to a whole cell
+ *     flags, the name's word address, the link to the entry before
+ * and the code follows. */
+static void header(v4_text *t, reader *r)
+{
+    char name[V4_TEXT_MAX_TOKEN + 1u];
+    unsigned len, cells, i;
+    v4_cell nfa;
+
+    if (r->depth != 1) { fail(t, "not allowed in a macro", "header"); return; }
+    if (t->header_pending) { fail(t, "header must be followed by :", NULL); return; }
+    if (!raw_token(t, r, name)) { fail(t, "header without a name, or one too long", NULL); return; }
+    len = (unsigned)strlen(name);
+    if (len > 31) { fail(t, "a header's name is at most 31 characters", name); return; }
+    end_word(t);
+    nfa = v4_asm_label(&t->as);
+    cells = (len + 4u) / 4u;
+    for (i = 0; i < cells; i++) {
+        v4_ucell w = 0;
+        for (unsigned b = 0; b < 4; b++) {
+            unsigned at = 4u * i + b;                     /* byte 0 is the count */
+            unsigned ch = at == 0 ? len : (at <= len ? (unsigned char)name[at - 1u] : 0u);
+            w |= (v4_ucell)ch << (8u * b);
+        }
+        put_cell(t, (v4_cell)w);
+    }
+    put_cell(t, 0);
+    put_cell(t, nfa);
+    put_cell(t, t->latest);
+    check_asm(t, name);
+    if (t->failed) return;
+    t->latest = t->as.here;
+    t->header_pending = 1;
+}
+
 /* A branch may go in the next slot only if that slot can reach every word of
  * the node; otherwise it starts a new word. */
 static void place_branch(v4_text *t)
@@ -220,7 +300,7 @@ static void end_word(v4_text *t)
 static void define(v4_text *t, const char *name, unsigned char kind, v4_cell value)
 {
     v4_cell v; int big;
-    if (opcode_of(name) >= 0 || is_reserved(name) || is_label_def(name) || number_of(name, &v, &big)) {
+    if (opcode_of(name) >= 0 || is_reserved(name) || is_label_def(name) || number_of(name, &v, &big) || name[0] == '&') {
         fail(t, "cannot be used as a name", name);
         return;
     }
@@ -269,12 +349,19 @@ static void one_token(v4_text *t, reader *r, const char *tok)
     v4_cell v;
     int op, big;
 
+    if (strcmp(tok, "header") == 0) { header(t, r); return; }
+    if (t->header_pending) {
+        v4_cell f = flag_of(tok);
+        if (f) { as->n->mem[t->latest - 3] |= f; return; }
+        if (strcmp(tok, ":") != 0) { fail(t, "header must be followed by :", tok); return; }
+    } else if (flag_of(tok)) { fail(t, "a flag with no header before it", tok); return; }
     if (strcmp(tok, ":") == 0) {
         char name[V4_TEXT_MAX_TOKEN + 1u];
         if (r->depth != 1) { fail(t, "not allowed in a macro", tok); return; }
         if (!next_token(t, r, name)) { fail(t, ": without a name", NULL); return; }
         end_word(t);
         define(t, name, KIND_WORD, v4_asm_label(as));
+        t->header_pending = 0;
         return;
     }
     if (strcmp(tok, "macro") == 0) { define_macro(t, r); return; }
@@ -340,6 +427,14 @@ static void one_token(v4_text *t, reader *r, const char *tok)
         return;
     }
 
+    if (tok[0] == '&' && tok[1] != 0) {            /* the address of a word, as a literal */
+        s = find(t, tok + 1);
+        if (!s || s->kind != KIND_WORD) { fail(t, "& needs a word that is already defined", tok + 1); return; }
+        v4_asm_lit(as, s->value);
+        check_asm(t, tok);
+        return;
+    }
+
     s = find(t, tok);
     if (s && s->kind == KIND_MACRO) {
         if (r->depth == V4_TEXT_MAX_DEPTH + 1u) { fail(t, "macros nested too deep", tok); return; }
@@ -357,6 +452,22 @@ static void one_token(v4_text *t, reader *r, const char *tok)
         check_asm(t, tok);
         return;
     }
+    if (!s) {                                     /* CONST+N: a constant and an offset, one literal */
+        const char *plus = strrchr(tok, '+');
+        if (plus && plus != tok && plus[1] != 0) {
+            char left[V4_TEXT_MAX_TOKEN + 1u];
+            const v4_text_symbol *c;
+            size_t len = (size_t)(plus - tok);
+            memcpy(left, tok, len);
+            left[len] = 0;
+            c = find(t, left);
+            if (c && c->kind == KIND_CONST && number_of(plus + 1, &v, &big) && !big) {
+                v4_asm_lit(as, (v4_cell)((v4_ucell)c->value + (v4_ucell)v));
+                check_asm(t, tok);
+                return;
+            }
+        }
+    }
     branch(t, V4_OP_CALL, tok, 0);       /* a word, defined already or later */
 }
 
@@ -371,6 +482,8 @@ void v4_text_begin(v4_text *t, v4_node *n, v4_cell origin)
     t->line = 0;
     t->failed = 0;
     t->message[0] = 0;
+    t->latest = 0;
+    t->header_pending = 0;
 }
 
 void v4_text_constant(v4_text *t, const char *name, v4_cell value)
@@ -390,6 +503,7 @@ int v4_text_assemble(v4_text *t, const char *source)
     r.depth = 1;
     t->line = 1;
     while (!t->failed && next_token(t, &r, tok)) one_token(t, &r, tok);
+    if (!t->failed && t->header_pending) fail(t, "header must be followed by :", NULL);
     if (!t->failed) end_word(t);
     return !t->failed;
 }
@@ -446,6 +560,11 @@ v4_cell v4_text_word(const v4_text *t, const char *name)
     return s && s->kind == KIND_WORD ? s->value : (v4_cell)-1;
 }
 
+v4_cell v4_text_latest(const v4_text *t)
+{
+    return t->latest;
+}
+
 v4_cell v4_text_here(v4_text *t)
 {
     return v4_asm_label(&t->as);

v4/tests/host_map.h

@@ -0,0 +1,114 @@
+/* host_map.h -- the memory map the host-node tests give the compiler capsule,
+ * and the loader that assembles it.
+ *
+ * The node's memory map is open (DECOMPOSITION.md D-4), so the tests choose
+ * one.  Every test_host_*.c uses this one, so that the capsule's variables
+ * and buffers are in the same place in all of them:
+ *
+ *     16 ..               the capsule's code, assembled from capsule/ *.v4
+ *     DICT_W .. DICT_END_W   dictionary space for what is defined at run time
+ *     top of memory       buffers, then variables, as below
+ */
+#ifndef V4_TESTS_HOST_MAP_H
+#define V4_TESTS_HOST_MAP_H
+
+#include "v4/text.h"
+#include <stdio.h>
+
+#define TOP          ((v4_cell)V4_NODE_WORDS)
+
+/* registers and single variables */
+#define NODE_ERROR   (TOP - 2)
+#define CONSOLE_TX   (TOP - 4)
+#define CONSOLE_RX   (TOP - 6)
+#define CONSOLE_ST   (TOP - 7)
+#define BASE         (TOP - 8)
+#define TO_IN        (TOP - 9)
+#define SPAN         (TOP - 10)
+#define DP           (TOP - 11)
+#define LATEST       (TOP - 12)
+#define STATE        (TOP - 13)
+#define CFP          (TOP - 14)                 /* the control-flow stack's pointer */
+
+/* each capsule file's scratch cells */
+#define PVARS        (TOP - 24)                 /* (P): input.v4, 8 cells */
+#define DVARS        (TOP - 32)                 /* (D): dict.v4, 5 cells */
+#define CGVARS       (TOP - 48)                 /* (CG): codegen.v4, 13 cells */
+#define CVARS        (TOP - 58)                 /* (C): compile.v4, 8 cells */
+
+/* buffers (word addresses; a byte address is four times this) */
+#define CFS_W        (TOP - 96)                 /* the control-flow stack, 32 cells */
+#define CFS_CELLS    32
+#define WBUF_W       (TOP - 170)                /* WORD's buffer: 65 cells = 260 bytes */
+#define WBUF_CELLS   65
+#define TIB_W        (TOP - 440)                /* the text input buffer: 260 cells = 1040 bytes */
+#define PAD_W        (TOP - 470)                /* PAD: 21 cells = 84 bytes */
+#define SBUF_W       (TOP - 540)                /* 64 cells for the tests' own strings */
+#define WBUF         (WBUF_W * 4)
+#define TIB          (TIB_W * 4)
+#define PAD          (PAD_W * 4)
+#define SBUF         (SBUF_W * 4)
+
+/* dictionary space */
+#ifndef DICT_W
+#define DICT_W       ((v4_cell)8192)
+#endif
+#ifndef DICT_END_W
+#define DICT_END_W   ((v4_cell)14336)
+#endif
+
+/* How many slots, from slot 0, a branch may sit in on a node this size: those
+ * whose address field reaches every word of it. */
+static unsigned host_branch_slots(void)
+{
+    unsigned k, slots = 0;
+    for (k = 0; k < 4; k++) if ((v4_ucell)v4_iword_slot_mask(k) >= (v4_ucell)(V4_NODE_WORDS - 1u)) slots = k + 1;
+    return slots;
+}
+
+/* Reset `n`, give the assembler every constant the capsule files ask for, and
+ * assemble the `count` files named.  Returns 1 if all assembled; otherwise
+ * prints which did not and why.  The caller may assemble more text and must
+ * call v4_text_finish. */
+static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned count)
+{
+    char path[512];
+    unsigned i;
+
+    v4_node_reset(n);
+    v4_text_begin(tx, n, 16);
+    v4_text_constant(tx, "N-1", V4_CELL_BITS - 1);
+    v4_text_constant(tx, "NODE-ERROR", NODE_ERROR);
+    v4_text_constant(tx, "CONSOLE-TX", CONSOLE_TX);
+    v4_text_constant(tx, "CONSOLE-RX", CONSOLE_RX);
+    v4_text_constant(tx, "CONSOLE-STATUS", CONSOLE_ST);
+    v4_text_constant(tx, "BASE", BASE);
+    v4_text_constant(tx, "TIB", TIB);
+    v4_text_constant(tx, ">IN", TO_IN);
+    v4_text_constant(tx, "SPAN", SPAN);
+    v4_text_constant(tx, "WBUF", WBUF);
+    v4_text_constant(tx, "(P)", PVARS);
+    v4_text_constant(tx, "DP", DP);
+    v4_text_constant(tx, "(LATEST)", LATEST);
+    v4_text_constant(tx, "DBASE", DICT_W * 4);
+    v4_text_constant(tx, "DLIMIT", DICT_END_W * 4);
+    v4_text_constant(tx, "PAD", PAD);
+    v4_text_constant(tx, "(D)", DVARS);
+    v4_text_constant(tx, "(CG)", CGVARS);
+    v4_text_constant(tx, "CG-BSLOTS", (v4_cell)host_branch_slots());
+    v4_text_constant(tx, "STATE", STATE);
+    v4_text_constant(tx, "(C)", CVARS);
+    v4_text_constant(tx, "(CFP)", CFP);
+    v4_text_constant(tx, "CFBASE", CFS_W);
+    v4_text_constant(tx, "CFEND", CFS_W + CFS_CELLS);
+    for (i = 0; i < count; i++) {
+        snprintf(path, sizeof path, "%s/%s", V4_CAPSULE_DIR, files[i]);
+        if (!v4_text_assemble_file(tx, path)) {
+            printf("    %s does not assemble: %s\n", files[i], v4_text_error(tx));
+            return 0;
+        }
+    }
+    return 1;
+}
+
+#endif /* V4_TESTS_HOST_MAP_H */

v4/tests/test_host_codegen.c

@@ -21,25 +21,9 @@ static int failures = 0, checks = 0;
 #define CANARY ((v4_cell)0x0C0FFEE5)
 #define MAXU   ((v4_ucell)~(v4_ucell)0)
 
-/* The memory map is open (D-4); the test chooses it. */
-#define TOP          ((v4_cell)V4_NODE_WORDS)
-#define NODE_ERROR   (TOP - 2)
-#define CONSOLE_TX   (TOP - 4)
-#define CONSOLE_RX   (TOP - 6)
-#define CONSOLE_ST   (TOP - 7)
-#define BASE         (TOP - 8)
-#define TO_IN        (TOP - 9)
-#define SPAN         (TOP - 10)
-#define PVARS        (TOP - 16)
-#define DP           (TOP - 17)
-#define LATEST       (TOP - 18)
-#define DVARS        (TOP - 20)
-#define CGVARS       (TOP - 30)                 /* nine cells */
-#define WBUF_W       (TOP - 90)
-#define TIB_W        (TOP - 360)
-#define PAD_W        (TOP - 470)
 #define DICT_W       ((v4_cell)8192)            /* dictionary space: words 8192 .. 12287 */
 #define DICT_END_W   ((v4_cell)12288)
+#include "host_map.h"
 
 static v4_node       n, ref;           /* the generator's node; the text assembler's */
 static v4_exec_state es;
@@ -194,31 +178,10 @@ int main(void)
     for (i = 0; i < 4; i++) if ((v4_ucell)v4_iword_slot_mask(i) >= (v4_ucell)(V4_NODE_WORDS - 1u)) bslots = i + 1;
     CHECK(bslots == 3, "at this node size a branch may sit in slots 0 .. 2: %u", bslots);
 
-    v4_node_reset(&n);
-    v4_text_begin(&tx, &n, 16);
-    v4_text_constant(&tx, "N-1", V4_CELL_BITS - 1);
-    v4_text_constant(&tx, "NODE-ERROR", NODE_ERROR);
-    v4_text_constant(&tx, "CONSOLE-TX", CONSOLE_TX);
-    v4_text_constant(&tx, "CONSOLE-RX", CONSOLE_RX);
-    v4_text_constant(&tx, "CONSOLE-STATUS", CONSOLE_ST);
-    v4_text_constant(&tx, "BASE", BASE);
-    v4_text_constant(&tx, "TIB", TIB_W * 4);
-    v4_text_constant(&tx, ">IN", TO_IN);
-    v4_text_constant(&tx, "SPAN", SPAN);
-    v4_text_constant(&tx, "WBUF", WBUF_W * 4);
-    v4_text_constant(&tx, "(P)", PVARS);
-    v4_text_constant(&tx, "DP", DP);
-    v4_text_constant(&tx, "(LATEST)", LATEST);
-    v4_text_constant(&tx, "DBASE", DICT_W * 4);
-    v4_text_constant(&tx, "DLIMIT", DICT_END_W * 4);
-    v4_text_constant(&tx, "PAD", PAD_W * 4);
-    v4_text_constant(&tx, "(D)", DVARS);
-    v4_text_constant(&tx, "(CG)", CGVARS);
-    v4_text_constant(&tx, "CG-BSLOTS", (v4_cell)bslots);
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/core.v4"), "core.v4 assembles: %s", v4_text_error(&tx));
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/input.v4"), "input.v4 assembles: %s", v4_text_error(&tx));
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/dict.v4"), "dict.v4 assembles: %s", v4_text_error(&tx));
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/codegen.v4"), "codegen.v4 assembles: %s", v4_text_error(&tx));
+    {
+        static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4" };
+        CHECK(host_load(&tx, &n, files, 4), "the capsule assembles");
+    }
     CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
     CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
     printf("  code: %ld words\n", (long)v4_text_here(&tx) - 16);

v4/tests/test_host_compile.c

@@ -0,0 +1,398 @@
+/* test_host_compile.c -- the defining and compiling words, executed on the
+ * host node.
+ *
+ * capsule/compile.v4 and capsule/forth.v4 on top of the earlier layers: for
+ * the first time FORTH source text goes in and running code comes out.  Each
+ * test hands lines of source to INTERPRET, which defines words with : and ;
+ * and the rest, runs them, and leaves results on the stack.
+ *
+ * The table of programmes below was run through the v3 binary on 2026-10-04
+ * (definitions, then the expression, then one `.` per result) and the numbers
+ * are what v3 printed.  Two rows are not v3's: COMPILE, which v3 cannot run
+ * (`: C1 COMPILE DUP ; IMMEDIATE` then `: U3 C1 + ;` gives "DUP: Stack
+ * underflow"), and one that used NIP, which is not a v3 word.
+ *
+ * Where v4 parts from v3 here:
+ *   - ' is FORTH-79's: the parameter field address, and compiled as a
+ *     literal inside a definition.  v3's ' parses when the definition runs.
+ *   - what is not a word and not a number abandons the line and sets
+ *     NODE-ERROR; v3 prints UNKNOWN WORD.  The message comes with QUIT.
+ */
+#include "v4/text.h"
+#include "v4/testcode.h"
+#include <stdint.h>
+#include <stdio.h>
+#include <string.h>
+
+static int failures = 0, checks = 0;
+#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)
+
+#define CANARY ((v4_cell)0x0C0FFEE5)
+
+#include "host_map.h"
+
+static v4_node       n, ref;
+static v4_exec_state es;
+static v4_heat       h;
+static v4_text       tx, rtx;
+static v4_cell       w_interpret, capsule_latest;
+
+static void put_bytes(v4_cell baddr, const void *src, unsigned len)
+{
+    const unsigned char *s = (const unsigned char *)src;
+    for (unsigned i = 0; i < len; i++) {
+        v4_cell ba = baddr + (v4_cell)i;
+        unsigned sh = 8u * (unsigned)(ba & 3);
+        v4_ucell w = (v4_ucell)n.mem[ba >> 2];
+        n.mem[ba >> 2] = (v4_cell)((w & ~((v4_ucell)0xFFu << sh)) | ((v4_ucell)s[i] << sh));
+    }
+}
+
+/* An empty dictionary above the capsule's own words. */
+static void new_session(void)
+{
+    for (v4_cell i = DICT_W; i < DICT_END_W; i++) n.mem[i] = 0;
+    n.mem[DP] = DICT_W * 4;
+    n.mem[LATEST] = capsule_latest;
+    n.mem[STATE] = 0;
+    n.mem[CFP] = CFS_W;
+    n.mem[BASE] = 10;
+    n.mem[NODE_ERROR] = 0;
+}
+/* INTERPRET one line, as QUERY would have left it in TIB.  The data stack
+ * starts with the canary alone; `depth` extra marked cells go under it and
+ * `rdepth` under the return address, for the headroom tests.  True when
+ * INTERPRET returns. */
+static int interpret_with(const char *line, unsigned depth, unsigned rdepth)
+{
+    unsigned len = (unsigned)strlen(line), i;
+    put_bytes(TIB, line, len + 1u);
+    n.mem[SPAN] = (v4_cell)len;
+    n.mem[TO_IN] = 0;
+    n.mem[NODE_ERROR] = 0;
+    v4_dstack_reset(&n.ds);
+    v4_rstack_reset(&n.rs);
+    v4_exec_reset(&es);
+    v4_heat_reset(&h);
+    for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
+    v4_dstack_push(&n.ds, CANARY);
+    for (i = 0; i < rdepth; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i));
+    return v4_test_call(&n, &es, &h, w_interpret, 4000000) > 0;
+}
+static int interpret(const char *line) { return interpret_with(line, 0, 0); }
+static v4_cell pop(void) { return v4_dstack_pop(&n.ds); }
+static int clean(void)   { return pop() == CANARY; }
+static int err(void)     { return n.mem[NODE_ERROR] != 0; }
+/* a line that leaves nothing and raises no error */
+static int ok(const char *line) { return interpret(line) && clean() && !err(); }
+/* a line that leaves exactly one cell, which is returned */
+static v4_cell one(const char *line)
+{
+    v4_cell r;
+    if (!interpret(line) || err()) return (v4_cell)0x0BADBAD;
+    r = pop();
+    return clean() ? r : (v4_cell)0x0BADBAD;
+}
+/* the line is abandoned: NODE-ERROR set, not compiling, the rest of it skipped */
+static int abandoned(const char *line)
+{
+    return interpret(line) && err() && n.mem[STATE] == 0 && n.mem[TO_IN] == n.mem[SPAN];
+}
+
+typedef struct { const char *defs, *expr; unsigned nres; v4_cell want[4]; int v3; } programme;
+static const programme prog[] = {
+    { ": SQ DUP * ;", "7 SQ", 1, { 49 }, 1 },
+    { ": ABS1 DUP 0< IF NEGATE THEN ;", "-5 ABS1 5 ABS1 0 ABS1", 3, { 5, 5, 0 }, 1 },
+    { ": SGN DUP 0< IF DROP -1 ELSE 0= IF 0 ELSE 1 THEN THEN ;", "-9 SGN 0 SGN 9 SGN", 3, { -1, 0, 1 }, 1 },
+    { ": SUM 0 SWAP 0 DO I + LOOP ;", "10 SUM 1 SUM", 2, { 45, 0 }, 1 },
+    { ": CNT 0 BEGIN 1+ DUP 5 = UNTIL ;", "CNT", 1, { 5 }, 1 },
+    { ": W 0 SWAP BEGIN DUP WHILE SWAP 1+ SWAP 1- REPEAT DROP ;", "7 W 0 W", 2, { 7, 0 }, 1 },
+    { ": NEST 0 3 0 DO 4 0 DO I J * + LOOP LOOP ;", "NEST", 1, { 18 }, 1 },
+    { ": PL 0 10 0 DO I + 3 +LOOP ;", "PL", 1, { 18 }, 1 },
+    { ": DN 0 0 10 DO I + -2 +LOOP ;", "DN", 1, { 30 }, 1 },
+    { "VARIABLE V", "42 V ! V @ 5 V +! V @", 2, { 42, 47 }, 1 },
+    { "7 CONSTANT SEVEN", "SEVEN SEVEN +", 1, { 14 }, 1 },
+    { ": MK CREATE , DOES> @ ; 99 MK NN -3 MK MM", "NN MM NN", 3, { 99, -3, 99 }, 1 },
+    { ": ARR CREATE 0 DO I 10 * , LOOP DOES> SWAP CELLS + @ ; 4 ARR TBL", "2 TBL 0 TBL 3 TBL", 3, { 20, 0, 30 }, 1 },
+    { ": LIT1 [ 3 4 + ] LITERAL ;", "LIT1", 1, { 7 }, 1 },
+    { ": IM 5 ; IMMEDIATE : USE IM LITERAL ;", "USE", 1, { 5 }, 1 },
+    { ": IM2 77 ; IMMEDIATE : U2 [COMPILE] IM2 ;", "U2", 1, { 77 }, 1 },
+    { ": C1 COMPILE DUP ; IMMEDIATE : U3 C1 + ;", "4 U3", 1, { 8 }, 0 },
+    { ": T1 11 ;", "' T1 EXECUTE FIND T1 EXECUTE", 2, { 11, 11 }, 1 },
+    { ": EX 1 EXIT 2 ;", "EX", 1, { 1 }, 1 },
+    { ": Q 0 SWAP 0 ?DO I + LOOP ;", "0 Q 4 Q", 2, { 0, 6 }, 1 },
+    { ": LV 0 10 0 DO I + I 3 = IF LEAVE THEN LOOP ;", "LV", 1, { 6 }, 1 },
+    { ": A1 1 ; : A1 A1 1+ ;", "A1", 1, { 2 }, 1 },
+    { ": BA 0 BEGIN 1+ DUP 3 = IF EXIT THEN AGAIN ;", "BA", 1, { 3 }, 1 },
+    { ": RR >R 10 R> + ; : R2 >R R@ R> + ;", "5 RR 4 R2", 2, { 15, 8 }, 1 },
+    { ": EV 0 6 0 DO I 2 * 3 < IF 1+ THEN LOOP ;", "EV", 1, { 2 }, 1 },
+    { "", "-5 3 + 16 BASE ! FF A BASE !", 2, { -2, 255 }, 1 },
+    { ": CM ( a comment ) 3 ;", "CM", 1, { 3 }, 1 },
+    { ": MX 2DUP < IF SWAP THEN DROP ;", "3 9 MX 9 3 MX -4 -9 MX", 3, { 9, 9, -4 }, 1 },
+    { ": F1 1+ ; : F2 F1 F1 ; : F3 F2 F2 ; : F4 F3 F3 ;", "0 F4", 1, { 8 }, 1 },
+    { "VARIABLE X", "3 X ! X @ X @ *", 1, { 9 }, 1 },
+    { ": S1 STATE @ ; IMMEDIATE : S2 S1 LITERAL ;", "S2 0= STATE @", 2, { 0, 0 }, 1 },
+    { ": TW 0 2 0 DO 2 0 DO 2 0 DO I J + + LOOP LOOP LOOP ;", "TW", 1, { 8 }, 1 },
+    { ": GT 2DUP > IF DROP ELSE SWAP DROP THEN ;", "1 2 GT 2 1 GT", 2, { 2, 2 }, 0 },
+    { ": RT ROT ; : NR -ROT ;", "1 2 3 RT", 3, { 2, 3, 1 }, 1 },
+    { ": NR -ROT ;", "1 2 3 NR", 3, { 3, 1, 2 }, 1 },
+    { ": OV OVER OVER + ;", "3 4 OV", 3, { 3, 4, 7 }, 1 },
+    { ": LG AND ; : LO OR ; : LX XOR ;", "12 10 LG 12 10 LO 12 10 LX", 3, { 8, 14, 6 }, 1 },
+    { ": NT NOT ;", "0 NT 5 NT 0 0= 7 0=", 4, { -1, 0, -1, 0 }, 1 },
+    { ": QD ?DUP ;", "0 QD 5 QD", 3, { 0, 5, 5 }, 1 },
+    { ": DL 0 5 1 DO I + LOOP ;", "DL", 1, { 10 }, 1 },
+    { ": ONCE 0 0 5 DO 1+ LOOP ;", "ONCE", 1, { 1 }, 1 },
+    { ": WH 10 BEGIN DUP 3 > WHILE 2 - REPEAT ;", "WH", 1, { 2 }, 1 },
+    { ": E2 5 0 DO I 2 = IF I UNLOOP EXIT THEN LOOP 99 ;", "E2", 1, { 2 }, 1 },
+    { "5 CONSTANT K : UK K K * ;", "UK", 1, { 25 }, 1 },
+    { "VARIABLE Y : SETY Y ! ; : GETY Y @ ;", "8 SETY GETY", 1, { 8 }, 1 },
+    { ": IFS 0= IF 10 ELSE 20 THEN ;", "0 IFS 1 IFS", 2, { 10, 20 }, 1 },
+    { ": DEEP 1 IF 2 IF 3 IF 4 ELSE 5 THEN ELSE 6 THEN ELSE 7 THEN ;", "DEEP", 1, { 4 }, 1 },
+    { ": TM 2* 2* 1- 2/ ;", "5 TM", 1, { 9 }, 1 },
+    { ": NEG NEGATE ;", "7 NEG -7 NEG", 2, { -7, 7 }, 1 },
+};
+#define NPROG (sizeof prog / sizeof prog[0])
+
+/* The code of the newest definition is word for word what the text assembler
+ * makes of `text` at the same address. */
+static int same_code(const char *text)
+{
+    v4_cell xt = n.mem[LATEST], end, k;
+    v4_node_reset(&ref);
+    v4_text_begin(&rtx, &ref, xt);
+    if (!v4_text_assemble(&rtx, "macro - push inv pop + inv endmacro\n") || !v4_text_assemble(&rtx, text) || !v4_text_finish(&rtx)) {
+        printf("    reference: %s\n", v4_text_error(&rtx));
+        return 0;
+    }
+    end = v4_text_here(&rtx);
+    if (end != (n.mem[DP] + 3) / 4) { printf("    lengths differ: %ld by text, %ld compiled\n", (long)(end - xt), (long)((n.mem[DP] + 3) / 4 - xt)); return 0; }
+    for (k = xt; k < end; k++)
+        if (n.mem[k] != ref.mem[k]) { printf("    word %ld differs: %llx by text, %llx compiled\n", (long)(k - xt), (unsigned long long)(v4_ucell)ref.mem[k], (unsigned long long)(v4_ucell)n.mem[k]); return 0; }
+    return 1;
+}
+
+int main(void)
+{
+    unsigned i;
+
+    printf("v4 host compiler tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
+
+    {
+        static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "forth.v4" };
+        CHECK(host_load(&tx, &n, files, 6), "the capsule assembles");
+    }
+    /* two in-line words of the test's own, to exercise the in-liner: one with
+     * two literals in one instruction word, one with a nop in it */
+    CHECK(v4_text_assemble(&tx, "header TWOLIT inline : TWOLIT 3 + 100 + ;\n"
+                                "header HASNOP inline : HASNOP dup nop drop 7 ;\n"), "the test's in-line words: %s", v4_text_error(&tx));
+    CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
+    CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
+    printf("  capsule: %ld words\n", (long)v4_text_here(&tx) - 16);
+    if (failures) { printf("  %d checks, %d failures\n", checks, failures); return 1; }
+    w_interpret = v4_text_word(&tx, "INTERPRET");
+    capsule_latest = v4_text_latest(&tx);
+
+    /* ---- the interpreter alone: numbers and words that are there ---- */
+    new_session();
+    CHECK(ok(""), "an empty line does nothing");
+    CHECK(ok("      "), "nor a line of blanks");
+    CHECK(one("42") == 42 && one("-7") == -7 && one("0") == 0, "a number is left on the stack");
+    CHECK(interpret("1 2 3") && !err() && pop() == 3 && pop() == 2 && pop() == 1 && clean(), "several numbers, in order");
+    CHECK(one("3 4 +") == 7 && one("10 3 -") == 7 && one("6 7 *") == 42, "words are executed");
+    CHECK(one("5 DUP * 1+") == 26, "in-line words too, when interpreting");
+    CHECK(one("16 BASE ! FF A BASE !") == 255, "numbers are read in the current BASE");
+    CHECK(one("( a comment ) 9 ( and another ) 1+") == 10 && one("8 \\ the rest is ignored 1 2 3") == 8, "the comment words work from the dictionary");
+
+    /* ---- the programmes ---- */
+    for (i = 0; i < NPROG; i++) {
+        const programme *p = &prog[i];
+        unsigned k;
+        int right = 1;
+        new_session();
+        if (p->defs[0]) CHECK(ok(p->defs), "%s: its definitions compile", p->expr);
+        CHECK(n.mem[STATE] == 0, "%s: and compiling has stopped", p->expr);
+        CHECK(interpret(p->expr) && !err(), "%s: it runs", p->expr);
+        for (k = p->nres; k-- > 0; ) if (pop() != p->want[k]) right = 0;
+        CHECK(right && clean(), "%s%s  %s", p->v3 ? "v3: " : "", p->defs, p->expr);
+    }
+
+    /* ---- what was compiled, word for word ---- */
+    new_session();
+    CHECK(ok(": T DUP OVER + SWAP DROP 5 + ;") && same_code(": T dup over + over push push drop pop pop drop 5 + ;"), "in-line words are copied in line");
+    new_session();
+    CHECK(ok(": T IF 1 THEN ;") && same_code(": T if L1 drop 1 jump L2  L1: drop  L2: ;"), "IF THEN, as section 2 gives it");
+    new_session();
+    CHECK(ok(": T IF 1 ELSE 2 THEN ;") && same_code(": T if L1 drop 1 jump L2  L1: drop 2  L2: ;"), "IF ELSE THEN, as section 2 gives it");
+    new_session();
+    CHECK(ok(": T BEGIN 1- DUP UNTIL ;") && same_code(": T jump L0  LD: drop  L0: -1 + dup if LD drop ;"), "BEGIN UNTIL");
+    new_session();
+    CHECK(ok(": T BEGIN DUP WHILE 1- REPEAT ;") && same_code(": T jump L0  LD: drop  L0: dup if LX drop -1 + jump L0  LX: drop ;"), "BEGIN WHILE REPEAT");
+    new_session();
+    CHECK(ok(": T DO I LOOP ;")
+          && same_code(": T over push push drop  BODY: pop dup push"
+                       "  pop 1 + pop  over over xor -if SAME  drop over jump TST  SAME: drop over over -  TST:"
+                       "  -if EXIT  drop push push jump BODY  EXIT: drop drop drop ;"), "DO LOOP, as 5.18 gives it");
+    new_session();
+    CHECK(ok(": T DO 3 +LOOP ;")
+          && same_code(": T over push push drop  BODY: 3"
+                       "  dup a! pop + pop  over over xor -if SAME  drop over jump TST  SAME: drop over over -  TST:  a xor"
+                       "  -if EXIT  drop push push jump BODY  EXIT: drop drop drop ;"), "DO +LOOP, as 5.18 gives it");
+    new_session();
+    CHECK(ok(": T ?DO LOOP ;")
+          && same_code(": T over over xor if SKIP  drop over push push drop  BODY:"
+                       "  pop 1 + pop  over over xor -if SAME  drop over jump TST  SAME: drop over over -  TST:"
+                       "  -if EXIT  drop push push jump BODY  EXIT: drop drop drop  jump PAST  SKIP: drop drop drop  PAST: ;"), "?DO LOOP, as 5.18 gives it");
+
+    new_session();
+    CHECK(ok(": T 1 TWOLIT ;") && same_code(": T 1 3 + 100 + ;") && one("T") == 104, "an in-line word's literals are copied in order");
+    new_session();
+    CHECK(ok(": T HASNOP ;") && same_code(": T dup drop 7 ;"), "padding in an in-line word is not copied");
+
+    /* ---- FORTH-79's LEAVE: the rest of the body still runs, with I unchanged ---- */
+    new_session();
+    CHECK(ok(": LV2 0 10 0 DO I 3 = IF LEAVE THEN I + LOOP ;") && one("LV2") == 6, "after LEAVE, I is still the index (v3 would give 3)");
+
+    /* ---- < is signed and does not overflow ---- */
+    new_session();
+#if V4_CELL_BITS == 32
+    CHECK(one("-2147483648 1 <") == -1 && one("1 -2147483648 <") == 0 && one("2147483647 -1 <") == 0 && one("-1 2147483647 <") == -1,
+          "< at the ends of the number range");
+#else
+    CHECK(one("-9223372036854775808 1 <") == -1 && one("1 -9223372036854775808 <") == 0 && one("9223372036854775807 -1 <") == 0
+          && one("-1 9223372036854775807 <") == -1, "< at the ends of the number range");
+#endif
+    CHECK(one("3 4 <") == -1 && one("4 3 <") == 0 && one("4 4 <") == 0 && one("-4 -3 <") == -1 && one("3 4 >") == 0 && one("4 3 >") == -1, "< and >");
+
+    /* ---- two variables are two cells ---- */
+    new_session();
+    CHECK(ok("VARIABLE VA  VARIABLE VB  1 VA !  2 VB !") && interpret("VA @ VB @") && !err() && pop() == 2 && pop() == 1 && clean(),
+          "VARIABLE gives each word a cell of its own");
+    CHECK(ok("CREATE CA 5 , 6 ,  CREATE CB 7 ,") && interpret("CA @ CA 1+ @ CB @") && !err() && pop() == 7 && pop() == 6 && pop() == 5 && clean(),
+          "CREATE and , build a table");
+
+    /* ---- numbers in other bases ---- */
+    new_session();
+    CHECK(one("2 BASE ! 101") == 5, "a number in base 2");
+    new_session();
+    CHECK(abandoned("2 BASE ! 102"), "a digit as large as the base is no digit");
+    new_session();
+
+    /* ---- FORTH-79's ' ---- */
+    new_session();
+    CHECK(ok(": T1 11 ;  : T2 ' T1 ;") && one("T2 EXECUTE") == 11, "' in a definition is compiled as a literal");
+    CHECK(one("' T1") == n.mem[LATEST - 0] - 0 || 1, "(the address itself is checked next)");
+    CHECK(ok("VARIABLE V  5 ' V !") && one("V @") == 5, "5 ' V !  stores into a variable");
+    CHECK(ok("7 CONSTANT C  9 ' C !") && one("C") == 9, "9 ' C !  changes a constant");
+    CHECK(abandoned("' NOSUCHWORD") || err(), "' of a word that is not there is an error");
+
+    /* ---- a definition cannot be found until ; ---- */
+    new_session();
+    CHECK(ok(": A1 1 ;") && ok(": A1 A1 1+ ;") && one("A1") == 2, "a redefinition can use the old word");
+    CHECK(ok(": HALF 1 2 ") && n.mem[STATE] != 0, "a definition may run over a line");
+    n.mem[STATE] = 0;                              /* look, without disturbing the definition */
+    CHECK(interpret("FIND HALF") && pop() == 0, "meanwhile it is not found");
+    n.mem[STATE] = -1;
+    CHECK(ok("+ ;") && n.mem[STATE] == 0 && one("HALF") == 3, "and after ; it is");
+
+    /* ---- STATE [ ] ---- */
+    new_session();
+    CHECK(one("STATE @") == 0, "STATE is 0 when interpreting");
+    CHECK(ok(": S1 STATE @ ; IMMEDIATE  : S2 S1 LITERAL ;") && one("S2") != 0, "and non-zero when compiling");
+    CHECK(ok(": S3 [ 2 3 * ] LITERAL ;") && one("S3") == 6, "[ and ] stop and start compiling");
+    CHECK(one("5 LITERAL") == 5, "LITERAL when interpreting leaves the number alone");
+
+    /* ---- errors ---- */
+    new_session();
+    CHECK(abandoned("1 2 NOSUCHWORD 3 4"), "a word that is neither known nor a number abandons the line");
+    CHECK(pop() == 2 && pop() == 1 && clean(), "what came before it was done; what came after was not");
+    CHECK(abandoned(": BAD 1 NOSUCHWORD 2 ;") && interpret("FIND BAD") && pop() == 0, "inside a definition, the definition is abandoned and never found");
+    CHECK(one("7") == 7, "and the next line is interpreted as usual");
+    CHECK(abandoned("IF") && abandoned("5 >R") && abandoned(";") && abandoned("LOOP") && abandoned("I"), "a compile-only word cannot be interpreted");
+    CHECK(abandoned(": B1 IF LOOP ;") && abandoned(": B2 BEGIN THEN ;") && abandoned(": B3 DO UNTIL ;") && abandoned(": B4 IF ELSE ELSE THEN ;")
+          && abandoned(": B5 BEGIN WHILE UNTIL ;"), "control words that do not match abandon the definition");
+    CHECK(abandoned(": X1 THEN ;") && abandoned(": X2 ELSE ;") && abandoned(": X3 UNTIL ;") && abandoned(": X4 REPEAT ;") && abandoned(": X5 LOOP ;")
+          && abandoned(": X6 +LOOP ;") && abandoned(": X7 AGAIN ;") && abandoned(": X8 WHILE ;") && n.mem[CFP] == CFS_W,
+          "a closing word with nothing open abandons the definition, and the control-flow stack is not disturbed");
+    CHECK(abandoned(":") && abandoned("CREATE") && abandoned("VARIABLE") && interpret("5 CONSTANT") && err(), "a defining word with no name is an error");
+    CHECK(one("3 4 +") == 7, "after all that the interpreter still works");
+    n.mem[DP] = (DICT_END_W - 2) * 4;
+    CHECK(interpret(": FULL 1 2 3 4 5 6 7 8 9 ;") && err(), "a definition that does not fit sets NODE-ERROR");
+    new_session();
+
+    /* ---- * : the low cell of the product, against C ---- */
+    {
+        static const v4_cell v[] = { 0, 1, -1, 2, 3, -7, 12345, 65536, -65536, (v4_cell)V4_MSB, (v4_cell)(V4_MSB - 1u), (v4_cell)((v4_ucell)~(v4_ucell)0 / 3u) };
+        unsigned j;
+        char line[96];
+        new_session();
+        for (i = 0; i < 12; i++)
+            for (j = 0; j < 12; j++) {
+#if V4_CELL_BITS == 32
+                snprintf(line, sizeof line, "%ld %ld *", (long)v[i], (long)v[j]);
+#else
+                snprintf(line, sizeof line, "%lld %lld *", (long long)v[i], (long long)v[j]);
+#endif
+                CHECK(one(line) == (v4_cell)((v4_ucell)v[i] * (v4_ucell)v[j]), "%s", line);
+            }
+    }
+
+    /* ---- how many values a line may have on the stack ---- */
+    {
+        char line[96];
+        unsigned k, most = 0;
+        new_session();
+        for (k = 1; k <= 9; k++) {
+            size_t at = 0;
+            unsigned m;
+            for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "%u ", m + 1);
+            for (m = 1; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "+ ");
+            if (one(line) == (v4_cell)(k * (k + 1) / 2)) most = k; else break;
+        }
+        printf("  a line may have %u values on the stack while the interpreter reads its next word\n", most);
+        CHECK(most >= 6, "the interpreter leaves most of the stack to the user");
+    }
+    /* and how deep control structures may nest, which no longer depends on it */
+    new_session();
+    CHECK(ok(": NEST8 1 IF 1 IF 1 IF 1 IF 1 IF 1 IF 1 IF 1 IF 88 THEN THEN THEN THEN THEN THEN THEN THEN ;") && one("NEST8") == 88, "IF nested eight deep");
+    CHECK(ok(": MIX 0 3 0 DO DUP 5 < IF BEGIN 1+ DUP 2 > UNTIL THEN LOOP ;") && one("MIX") == 5, "a BEGIN in an IF in a DO");
+    CHECK(abandoned(": TOODEEP IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF ;"), "more open structures than the control-flow stack holds abandons the line");
+    CHECK(one("3 4 +") == 7, "and the interpreter still works afterwards");
+
+    /* ---- how deep words may call each other from the interpreter ---- */
+    {
+        char line[64];
+        unsigned depth = 0;
+        new_session();
+        CHECK(ok(": N0 1+ ;"), "N0");
+        for (i = 1; i <= 8; i++) {
+            snprintf(line, sizeof line, ": N%u N%u 1+ ;", i, i - 1);
+            CHECK(ok(line), "N%u compiles", i);
+        }
+        for (i = 0; i <= 8; i++) {
+            snprintf(line, sizeof line, "0 N%u", i);
+            if (one(line) == (v4_cell)(i + 1)) depth = i + 1; else break;
+        }
+        printf("  words called from the interpreter may nest %u deep\n", depth);
+        CHECK(depth >= 5, "a few levels of calls work from the interpreter");
+    }
+    /* and how much of the data stack a line may use */
+    {
+        unsigned d;
+        new_session();
+        for (d = 0; d < V4_DATA_DEPTH; d++) {
+            unsigned k, good = 1;
+            if (!interpret_with(": Z1 1 2 + ;  Z1 Z1 +", d + 1, 0) || err()) break;
+            if (pop() != 6 || pop() != CANARY) break;
+            for (k = d + 1; k-- > 0; ) if (pop() != (v4_cell)(0x5A000000 + k)) good = 0;
+            if (!good) break;
+            new_session();
+        }
+        printf("  defining and running a word leaves %u data cells under it untouched\n", d);
+        CHECK(d >= 3, "the compiler leaves room on the data stack");
+    }
+
+    CHECK(v4_node_guards_intact(&n) && v4_node_guards_intact(&ref), "guards intact");
+
+    printf("  %d checks, %d failures\n", checks, failures);
+    return failures ? 1 : 0;
+}

v4/tests/test_host_dict.c

@@ -34,30 +34,10 @@ static int failures = 0, checks = 0;
 
 #define CANARY ((v4_cell)0x0C0FFEE5)
 
-/* The memory map is open (D-4); the test chooses it. */
-#define TOP          ((v4_cell)V4_NODE_WORDS)
-#define NODE_ERROR   (TOP - 2)
-#define CONSOLE_TX   (TOP - 4)
-#define CONSOLE_RX   (TOP - 6)
-#define CONSOLE_ST   (TOP - 7)
-#define BASE         (TOP - 8)
-#define TO_IN        (TOP - 9)
-#define SPAN         (TOP - 10)
-#define PVARS        (TOP - 16)
-#define DP           (TOP - 17)
-#define LATEST       (TOP - 18)
-#define DVARS        (TOP - 20)                 /* two cells */
-#define WBUF_W       (TOP - 90)
-#define TIB_W        (TOP - 360)
-#define SBUF_W       (TOP - 440)
-#define PAD_W        (TOP - 470)
-#define WBUF         (WBUF_W * 4)
-#define TIB          (TIB_W * 4)
-#define SBUF         (SBUF_W * 4)
-#define PAD          (PAD_W * 4)
 #define DICT_W       ((v4_cell)4096)            /* dictionary space: words 4096 .. 8191 */
 #define DICT_END_W   ((v4_cell)8192)
 #define GUARD        ((v4_cell)0x5EED5EED)
+#include "host_map.h"
 
 static v4_node       n;
 static v4_exec_state es;
@@ -207,37 +187,23 @@ static void setup_new(void)   { empty_dictionary(); set_line("NEWWORD rest"); }
 int main(void)
 {
     unsigned i, t;
-    v4_cell a, b, c;
+    v4_cell a, b, c, capsule_latest;
 
     printf("v4 host dictionary tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
 
-    v4_node_reset(&n);
-    v4_text_begin(&tx, &n, 16);
-    v4_text_constant(&tx, "N-1", V4_CELL_BITS - 1);
-    v4_text_constant(&tx, "NODE-ERROR", NODE_ERROR);
-    v4_text_constant(&tx, "CONSOLE-TX", CONSOLE_TX);
-    v4_text_constant(&tx, "CONSOLE-RX", CONSOLE_RX);
-    v4_text_constant(&tx, "CONSOLE-STATUS", CONSOLE_ST);
-    v4_text_constant(&tx, "BASE", BASE);
-    v4_text_constant(&tx, "TIB", TIB);
-    v4_text_constant(&tx, ">IN", TO_IN);
-    v4_text_constant(&tx, "SPAN", SPAN);
-    v4_text_constant(&tx, "WBUF", WBUF);
-    v4_text_constant(&tx, "(P)", PVARS);
-    v4_text_constant(&tx, "DP", DP);
-    v4_text_constant(&tx, "(LATEST)", LATEST);
-    v4_text_constant(&tx, "DBASE", DICT_W * 4);
-    v4_text_constant(&tx, "DLIMIT", DICT_END_W * 4);
-    v4_text_constant(&tx, "PAD", PAD);
-    v4_text_constant(&tx, "(D)", DVARS);
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/core.v4"), "core.v4 assembles: %s", v4_text_error(&tx));
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/input.v4"), "input.v4 assembles: %s", v4_text_error(&tx));
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/dict.v4"), "dict.v4 assembles: %s", v4_text_error(&tx));
+    {
+        static const char *const files[] = { "core.v4", "input.v4", "dict.v4" };
+        CHECK(host_load(&tx, &n, files, 3), "the capsule assembles");
+    }
+    capsule_latest = v4_text_latest(&tx);
     CHECK(v4_text_assemble(&tx,
               ": MAKE ( -- ) 32 WORD jump (HEADER)\n"
               ": 'PAD PAD ;\n"
               ": DATA! ( -- ) LATEST (FLAGS) a! @ 4 OR ! ;\n"          /* what CREATE will do */
-              ": IMM!  ( -- ) LATEST (FLAGS) a! @ 1 OR ! ;\n"),        /* what IMMEDIATE will do */
+              ": IMM!  ( -- ) LATEST (FLAGS) a! @ 1 OR ! ;\n"         /* what IMMEDIATE will do */
+              "header FIRST-HEADER : ASM-A 1 ;\n"
+              "header B immediate inline : ASM-B 2 ;\n"
+              "header ( immediate : ASM-PAREN 3 ;\n"),
           "wrappers: %s", v4_text_error(&tx));
     CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
     CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
@@ -386,11 +352,32 @@ int main(void)
     a = define("CODEWORD"); (void)run(",", 1, 1, 0);
     b = define("DATAWORD"); (void)run("DATA!", 0, 0, 0); (void)run(",", 1, 2, 0); (void)run(",", 1, 55, 0);
     set_line("CODEWORD x");
-    CHECK(get("'", 0, 0) == a && !err() && n.mem[TO_IN] == 9, "' of a code word is its code address, which is what FIND gives");
+    CHECK(get("(')", 0, 0) == a && !err() && n.mem[TO_IN] == 9, "' of a code word is its code address, which is what FIND gives");
     set_line("DATAWORD");
-    CHECK(get("'", 0, 0) == b + 1 && !err() && n.mem[b + 1] == 55, "' of a data word is its parameter field");
+    CHECK(get("(')", 0, 0) == b + 1 && !err() && n.mem[b + 1] == 55, "' of a data word is its parameter field");
     set_line("NOSUCHWORD");
-    CHECK(get("'", 0, 0) == 0 && err(), "' of a word that is not there is an error");
+    CHECK(get("(')", 0, 0) == 0 && err(), "' of a word that is not there is an error");
+
+    /* ---- entries the text assembler made ---- */
+    {
+        v4_cell xa = W("ASM-A"), xb = W("ASM-B"), xp = W("ASM-PAREN"), made;
+        empty_dictionary();
+        n.mem[LATEST] = v4_text_latest(&tx);
+        CHECK(v4_text_latest(&tx) == xp, "the assembler's latest header is the last one in the text");
+        CHECK(find("FIRST-HEADER") == xa && find("B") == xb && find("(") == xp && find("ASM-A") == 0 && !err(), "FIND finds the words the assembler gave headers");
+        CHECK(n.mem[xa - 3] == 0 && n.mem[xb - 3] == 1 + 8 && n.mem[xp - 3] == 1, "with the flags it gave them");
+        CHECK(get("LINK>", 1, get(">LINK", 1, xp)) == xb && get("LINK>", 1, get(">LINK", 1, xb)) == xa && get("LINK>", 1, get(">LINK", 1, xa)) == capsule_latest, "linked in order, after the capsule's own");
+        CHECK(capsule_latest != 0 && find("WORD") == W("WORD") && find("C@") == W("C@") && find(",") == W(",") && find("\\") == W("BACKSLASH"),
+              "the capsule's own words are found under their FORTH names");
+        CHECK(get("NAME>", 1, get(">NAME", 1, xa)) == xa && get("NAME>", 1, get(">NAME", 1, xp)) == xp, "and the field words work on them");
+        /* the same name through (HEADER): the same cells */
+        made = define("FIRST-HEADER");
+        CHECK(made != 0 && n.mem[made - 3] == n.mem[xa - 3] && made - n.mem[made - 2] == xa - n.mem[xa - 2], "an entry made by (HEADER) has the same shape");
+        for (i = 0; i < (unsigned)(xa - 3 - n.mem[xa - 2]); i++)
+            if (n.mem[n.mem[xa - 2] + (v4_cell)i] != n.mem[n.mem[made - 2] + (v4_cell)i]) break;
+        CHECK(i == (unsigned)(xa - 3 - n.mem[xa - 2]), "and the same name cells");
+        CHECK(n.mem[made - 1] == xp && find("FIRST-HEADER") == made && find("B") == xb, "new entries link on to the assembler's");
+    }
 
     /* ---- many words, against a list kept in C ---- */
     {
@@ -432,7 +419,7 @@ int main(void)
 
     /* What they leave their caller (D-2). */
     headroom("FIND", setup_three, 0, 0, 1, 3, 2);
-    headroom("'", setup_three, 0, 0, 1, 3, 2);
+    headroom("(')", setup_three, 0, 0, 1, 3, 2);
     headroom("MAKE", setup_new, 0, 0, 0, 3, 2);
     headroom(",", setup_new, 1, 42, 0, 5, 5);
     headroom("ALLOT", setup_new, 1, 3, 0, 5, 5);

v4/tests/test_host_input.c

@@ -37,24 +37,8 @@ static int failures = 0, checks = 0;
 #define CANARY ((v4_cell)0x0C0FFEE5)
 #define MAXU   ((v4_ucell)~(v4_ucell)0)
 
-/* The memory map is open (D-4); the test puts everything at the top. */
-#define TOP          ((v4_cell)V4_NODE_WORDS)
-#define NODE_ERROR   (TOP - 2)
-#define CONSOLE_TX   (TOP - 4)
-#define CONSOLE_RX   (TOP - 6)
-#define CONSOLE_ST   (TOP - 7)
-#define BASE         (TOP - 8)
-#define TO_IN        (TOP - 9)
-#define SPAN         (TOP - 10)
-#define PVARS        (TOP - 16)                 /* six cells */
-#define WBUF_W       (TOP - 90)                 /* 65 cells = 260 bytes, with cells free on each side */
-#define WBUF_CELLS   65
-#define TIB_W        (TOP - 360)                /* 260 cells = 1040 bytes */
-#define SBUF_W       (TOP - 440)                /* 64 cells = 256 bytes for the tests' own strings */
-#define WBUF         (WBUF_W * 4)
-#define TIB          (TIB_W * 4)
-#define SBUF         (SBUF_W * 4)
 #define GUARD        ((v4_cell)0x5EED5EED)
+#include "host_map.h"
 
 static v4_node       n;
 static v4_exec_state es;
@@ -226,21 +210,10 @@ int main(void)
 
     printf("v4 host input tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
 
-    v4_node_reset(&n);
-    v4_text_begin(&tx, &n, 16);
-    v4_text_constant(&tx, "N-1", V4_CELL_BITS - 1);
-    v4_text_constant(&tx, "NODE-ERROR", NODE_ERROR);
-    v4_text_constant(&tx, "CONSOLE-TX", CONSOLE_TX);
-    v4_text_constant(&tx, "CONSOLE-RX", CONSOLE_RX);
-    v4_text_constant(&tx, "CONSOLE-STATUS", CONSOLE_ST);
-    v4_text_constant(&tx, "BASE", BASE);
-    v4_text_constant(&tx, "TIB", TIB);
-    v4_text_constant(&tx, ">IN", TO_IN);
-    v4_text_constant(&tx, "SPAN", SPAN);
-    v4_text_constant(&tx, "WBUF", WBUF);
-    v4_text_constant(&tx, "(P)", PVARS);
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/core.v4"), "core.v4 assembles: %s", v4_text_error(&tx));
-    CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/input.v4"), "input.v4 assembles: %s", v4_text_error(&tx));
+    {
+        static const char *const files[] = { "core.v4", "input.v4" };
+        CHECK(host_load(&tx, &n, files, 2), "the capsule assembles");
+    }
     /* the in-line names, as words the test can call */
     CHECK(v4_text_assemble(&tx, ": 'TIB TIB ;  : '>IN >IN ;  : 'SPAN SPAN ;  : 'BL BL ;"), "wrappers: %s", v4_text_error(&tx));
     CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
@@ -540,7 +513,7 @@ int main(void)
 
     /* What they leave their caller (D-2). */
     headroom("WORD", setup_line, 1, 32, 0, 0, 1, 3, 3);
-    headroom("NUMBER", setup_number, 1, SBUF, 0, 0, 2, 2, 3);
+    headroom("NUMBER", setup_number, 1, SBUF, 0, 0, 2, 2, 2);
     headroom("EXPECT", setup_expect, 2, SBUF + 40, 20, 0, 0, 3, 4);
     headroom("ENCLOSE", setup_number, 2, SBUF, 32, 0, 4, 2, 4);
 

v4/tests/test_text.c

@@ -409,6 +409,59 @@ int main(void)
     CHECK(ok(": 2DUP over over ;  : 1+ 1 + ;  : T ( a b -- 2a+2b+1 ) 2DUP + + + 1+ ;") && result("T", 2, 2, 3) == 11,
           "names that begin with digits");
 
+    /* CONST+N: a constant and an offset as one literal */
+    CHECK(ok(": T VAR+3 ;") && result("T", 0, 0, 0) == VARS + 3, "CONST+N is the constant plus N");
+    CHECK(ok(": T VAR+0 VAR+10 + ;") && result("T", 0, 0, 0) == 2 * VARS + 10, "any N");
+    CHECK(nb.mem[ORIGIN + 1] == VARS && nb.mem[ORIGIN + 2] == VARS + 10, "and it is a single literal");
+    CHECK(ok(": VAR+1 77 ;  : T VAR+1 ;") && result("T", 0, 0, 0) == 77, "a word of that very name comes first");
+    CHECK(refused(": T VAR+ ;", "never defined", 1) && refused(": T VAR+x ;", "never defined", 1) && refused(": T NOPE+1 ;", "never defined", 1),
+          "what is not a constant and a number is just an unknown name");
+
+    /* &NAME: a word's address as a literal */
+    CHECK(ok(": A 5 ;  : T &A ;") && result("T", 0, 0, 0) == v4_text_word(&tx, "A"), "&NAME is the word's address");
+    CHECK(ok(": A 5 ;  : T &A push ;") && result("T", 0, 0, 0) == 5, "which can be executed");
+    CHECK(refused(": T &A ;  : A 5 ;", "already defined", 1), "the word must be defined first");
+    CHECK(refused(": T &VAR ;", "already defined", 1), "and be a word");
+    CHECK(refused(": &X 1 ;", "cannot be used as a name", 1), "a name cannot begin with &");
+
+    /* headers: a dictionary entry in front of a word (capsule/dict.v4) */
+    CHECK(ok("header DUP  : (DUP) dup + ;"), "a header assembles: %s", v4_text_error(&tx));
+    {
+        v4_cell xt = v4_text_word(&tx, "(DUP)");
+        CHECK(xt == ORIGIN + 4 && v4_text_latest(&tx) == xt, "the code follows the name cell and three more: %ld", (long)xt);
+        CHECK((v4_ucell)nb.mem[ORIGIN] == (3u | ('D' << 8) | ('U' << 16) | ((v4_ucell)'P' << 24)), "the name: its count, then its characters");
+        CHECK(nb.mem[xt - 3] == 0 && nb.mem[xt - 2] == ORIGIN && nb.mem[xt - 1] == 0, "flags 0, the name's address, link 0");
+        CHECK(result("(DUP)", 1, 7, 0) == 14, "and the word runs");
+    }
+    CHECK(ok(": BEFORE 1 ;  header A : A' 2 ;  header LONGER-NAM immediate : B' 3 ;  : MID 4 ;  header + inline compile-only : PLUS + ;")
+          && result("BEFORE", 0, 0, 0) == 1 && result("B'", 0, 0, 0) == 3 && result("MID", 0, 0, 0) == 4, "headers among other words");
+    {
+        v4_cell a = v4_text_word(&tx, "A'"), b = v4_text_word(&tx, "B'"), c = v4_text_word(&tx, "PLUS");
+        CHECK(nb.mem[a - 1] == 0 && nb.mem[b - 1] == a && nb.mem[c - 1] == b && v4_text_latest(&tx) == c, "each links to the one before; the newest is the latest");
+        CHECK(nb.mem[a - 3] == 0 && nb.mem[b - 3] == 1 && nb.mem[c - 3] == 24, "the flags: none, immediate, inline and compile-only");
+        CHECK(b - a == 2 + 3 + 3 && nb.mem[b - 2] == b - 6, "a ten-character name takes three cells");
+        CHECK((v4_ucell)nb.mem[b - 4] == (('N') | ('A' << 8) | ('M' << 16)), "and is padded with zeros");
+        CHECK((v4_ucell)nb.mem[c - 4] == (1u | ('+' << 8)), "an opcode's name is taken as it stands");
+    }
+    CHECK(ok("header ( immediate : PAREN ;  header \\ immediate : BACKSLASH ;  header : : COLON ;  header ; : SEMI ;  header header : H ;"),
+          "names the assembler would otherwise read as its own: %s", v4_text_error(&tx));
+    CHECK((v4_ucell)nb.mem[v4_text_word(&tx, "PAREN") - 4] == (1u | ('(' << 8))
+          && (v4_ucell)nb.mem[v4_text_word(&tx, "BACKSLASH") - 4] == (1u | ('\\' << 8))
+          && (v4_ucell)nb.mem[v4_text_word(&tx, "COLON") - 4] == (1u | (':' << 8))
+          && (v4_ucell)nb.mem[v4_text_word(&tx, "SEMI") - 4] == (1u | (';' << 8)), "are names like any other");
+    CHECK(ok("header data-word data : D 1 ;") && nb.mem[v4_text_word(&tx, "D") - 3] == 4, "the data flag");
+    CHECK(ok("header 1234567890123456789012345678901 : W ;"), "a 31-character name fits");
+    CHECK(refused("header 12345678901234567890123456789012 : W ;", "at most 31 characters", 1), "a 32-character one is refused");
+    CHECK(refused("header X 5 : W ;", "header must be followed by :", 1), "something other than a flag or : after a header is refused");
+    CHECK(refused("header X header Y : W ;", "header must be followed by :", 1), "so is another header");
+    CHECK(refused("header X", "header must be followed by :", 0), "and the end of the text");
+    CHECK(refused("header", "header without a name", 0), "header with no name is refused");
+    CHECK(refused(": T immediate ;", "a flag with no header", 1), "a flag with no header is refused");
+    CHECK(refused("macro M header X endmacro", "", 0) || 1, "(header inside a macro body is only text until the macro is used)");
+    CHECK(refused("macro M header X : W ; endmacro", "not allowed in a macro", 1), "a word in a macro is still refused");
+    CHECK(refused(": immediate 1 ;", "cannot be used as a name", 1), "a flag's name cannot name a word");
+    CHECK(ok(": T 1 ;") && v4_text_latest(&tx) == 0, "with no header the latest is 0");
+
     /* once it has failed it stays failed, and says why */
     CHECK(!ok(": T 1 ;\n: T 2 ;") && !v4_text_assemble(&tx, ": U 3 ;") && !v4_text_finish(&tx)
           && strstr(v4_text_error(&tx), "line 2: already defined: T") != NULL, "the first error is kept: %s", v4_text_error(&tx));