diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 8adbd714..248a4592 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/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,14 +674,14 @@ 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. | +| `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. Its compiling behaviour comes with the compiler words. 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). | diff --git a/v4/Makefile b/v4/Makefile index e31ef7a9..62890c69 100644 --- a/v4/Makefile +++ b/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) \ diff --git a/v4/capsule/codegen.v4 b/v4/capsule/codegen.v4 index 014184cf..6bff312c 100644 --- a/v4/capsule/codegen.v4 +++ b/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,) diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 index 0aed9d2d..e0e87ac1 100644 --- a/v4/capsule/core.v4 +++ b/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 diff --git a/v4/capsule/dict.v4 b/v4/capsule/dict.v4 index 64835f10..134eaf0b 100644 --- a/v4/capsule/dict.v4 +++ b/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) diff --git a/v4/capsule/input.v4 b/v4/capsule/input.v4 index 54187f75..92c03bc0 100644 --- a/v4/capsule/input.v4 +++ b/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! ! ; diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h new file mode 100644 index 00000000..9da92798 --- /dev/null +++ b/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 + +#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 */ diff --git a/v4/tests/test_host_codegen.c b/v4/tests/test_host_codegen.c index 58a97657..1af129cb 100644 --- a/v4/tests/test_host_codegen.c +++ b/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); diff --git a/v4/tests/test_host_dict.c b/v4/tests/test_host_dict.c index 15fa6f74..ed52c5b5 100644 --- a/v4/tests/test_host_dict.c +++ b/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,32 +187,15 @@ 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" @@ -389,11 +352,11 @@ 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 ---- */ { @@ -403,7 +366,9 @@ int main(void) 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)) == 0, "linked in order"); + 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"); @@ -454,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); diff --git a/v4/tests/test_host_input.c b/v4/tests/test_host_input.c index 72630137..85769f0a 100644 --- a/v4/tests/test_host_input.c +++ b/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);