refactor(v4.0.0): the capsule's inner words keep their state in memory
WORD, the dictionary words and the code generator run underneath whatever the user has on the stacks, which are ten and nine deep (D-2). Measured, they used five to seven data cells of their own, leaving a line about three. Each now keeps what it works on in its file's scratch cells and has at most three cells on the data stack; , calls nothing; and the longest chains of calls are shorter. The public words of core.v4, input.v4 and dict.v4 get dictionary headers. NUMBER is split so the interpreter can have a flag instead of NODE-ERROR. The host-node tests share one memory map, host_map.h. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
44ffd261bb
commit
bbd1b4047f
@@ -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). |
|
||||
|
||||
+2
-2
@@ -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) \
|
||||
|
||||
+49
-37
@@ -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,)
|
||||
|
||||
@@ -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
|
||||
|
||||
+87
-34
@@ -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)
|
||||
|
||||
+71
-47
@@ -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! ! ;
|
||||
|
||||
@@ -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 */
|
||||
@@ -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);
|
||||
|
||||
+14
-49
@@ -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);
|
||||
|
||||
@@ -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);
|
||||
|
||||
|
||||
Reference in New Issue
Block a user