Star forth v4.0.0 #3
@@ -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