feat(v4): the system's UM*, UM/MOD, D+, DNEGATE, Q.* and Q./ call the ROM
MACHINE.md 2.2. Each is its entry's address, push and ;. Every node the tests make carries the host ROM (host_load, Hera's births, the depth and mesh tests' own nodes), and a division by zero inside the ROM returns to the prompt (hosted-check). test_host_quit's fetch outside memory moves past the ROM's range: 16384 is the ROM's first word now the tests' system has its ROM, as the product's always had. dict_hash 0xfec8c47cfc6f437f. 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
11b5d402b1
commit
afd9d46d29
@@ -33,34 +33,14 @@ macro NIP push drop pop endmacro
|
||||
|
||||
\ ---- section 4: multiply ------------------------------------------------
|
||||
set HDR-NFA here ", UM* #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: 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
|
||||
push over 2/ pop \ u1 u2 s t0 s = u1 2/
|
||||
L: +* unext \ u1 u2 s hi A: lo
|
||||
push drop pop \ u1 u2 hi
|
||||
2* a -if L0 drop 1 + jump L1 L0: drop L1: push
|
||||
over -if L2 drop dup jump L3 L2: drop 0 L3: push
|
||||
dup -if L4 drop over 1 and jump L5 L4: drop 0 L5:
|
||||
pop + pop + push
|
||||
and 1 and a 2* + pop ;
|
||||
: UM* ROM-UM* push ; \ ( u1 u2 -- ulo uhi ) the ROM's entry 0 (MACHINE.md 2.2)
|
||||
|
||||
\ ---- section 5.7: doubles ------------------------------------------------
|
||||
set HDR-NFA here ", D+ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: D+ ( d1 d2 -- d3 )
|
||||
push over push push drop pop \ al bl R: bh ah
|
||||
over over xor -if L1
|
||||
drop + -if C1 jump C0
|
||||
L1: drop over -if L2
|
||||
drop + jump C1
|
||||
L2: drop +
|
||||
C0: pop pop + ;
|
||||
C1: pop pop + 1 + ;
|
||||
: D+ ROM-D+ push ; \ ( d1 d2 -- d3 ) the ROM's entry 2
|
||||
|
||||
set HDR-NFA here ", DNEGATE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: DNEGATE ( d -- -d )
|
||||
inv over if L1 drop push inv 1 + pop ;
|
||||
L1: drop 1 + ;
|
||||
: DNEGATE ROM-DNEGATE push ; \ ( d -- -d ) the ROM's entry 3
|
||||
|
||||
\ ---- section 5.3: bytes --------------------------------------------------
|
||||
\ The shifts are written out, eight to a line, where DECOMPOSITION.md 5.3 has
|
||||
|
||||
@@ -114,5 +114,11 @@ constant DSTACK-DEPTH 16369
|
||||
constant RSTACK-DEPTH 16368
|
||||
constant CFBASE 16288
|
||||
constant CFEND 16320
|
||||
constant ROM-UM* 16384
|
||||
constant ROM-UM/MOD 16385
|
||||
constant ROM-D+ 16386
|
||||
constant ROM-DNEGATE 16387
|
||||
constant ROM-Q.* 16388
|
||||
constant ROM-Q./ 16389
|
||||
constant DICT-W 8192
|
||||
constant (IMG) 14593
|
||||
|
||||
@@ -114,5 +114,11 @@ constant DSTACK-DEPTH 16369
|
||||
constant RSTACK-DEPTH 16368
|
||||
constant CFBASE 16288
|
||||
constant CFEND 16320
|
||||
constant ROM-UM* 16384
|
||||
constant ROM-UM/MOD 16385
|
||||
constant ROM-D+ 16386
|
||||
constant ROM-DNEGATE 16387
|
||||
constant ROM-Q.* 16388
|
||||
constant ROM-Q./ 16389
|
||||
constant DICT-W 8192
|
||||
constant (IMG) 14593
|
||||
|
||||
@@ -17,26 +17,8 @@
|
||||
macro (-ROT) SWAP push SWAP pop endmacro
|
||||
|
||||
\ ---- unsigned division (section 4) ----
|
||||
\ One step a bit, the divisor in A. Exact for uhi < ud.
|
||||
: UM/MOD ( ulo uhi ud -- urem uquot )
|
||||
a! N-1 FOR
|
||||
-if L0
|
||||
2* over -if L1 drop 1 + jump L2
|
||||
L1: drop L2: push 2* pop
|
||||
jump SUB
|
||||
L0:
|
||||
2* over -if L3 drop 1 + jump L4
|
||||
L3: drop L4: push 2* pop
|
||||
dup a xor -if L5
|
||||
drop -if NOSUB jump SUB
|
||||
L5: drop dup inv a + inv -if L6
|
||||
drop jump NOSUB
|
||||
L6: push drop pop jump SETBIT
|
||||
SUB: inv a + inv
|
||||
SETBIT: push 1 + pop
|
||||
NOSUB:
|
||||
NEXT
|
||||
over push push drop pop pop ;
|
||||
\ Exact for uhi < ud. The ROM's entry 1 (MACHINE.md 2.2).
|
||||
: UM/MOD ROM-UM/MOD push ; \ ( ulo uhi ud -- urem uquot )
|
||||
|
||||
\ ---- pictured output ----
|
||||
set HDR-NFA here ", <# #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
|
||||
@@ -15,12 +15,12 @@
|
||||
\ HIMASK every bit but the top sixteen
|
||||
\ 2N+15 N-18 N-17 loop counts, N the cell width in bits
|
||||
\ (Q/) (QE) (QR) (QL) (QT) (QP) word addresses of the words' scratch
|
||||
\ cells: 5, 8, 5, 7, 6 and 4 of them
|
||||
\ cells: 5, 8, 5, 7, 6 and 4 of them; (Q/) is the ROM's Q./'s
|
||||
\ ROM-Q.* ROM-Q./ the ROM's entries (MACHINE.md 2.2)
|
||||
|
||||
\ the logical double shift right: one +* step with S = 0, the top bit cleared
|
||||
macro (UD2/) push a! 0 pop +* MAXHI and push drop a pop endmacro
|
||||
|
||||
: (QERR11) NODE-ERROR b! 11 !b ;
|
||||
: (QERR12) NODE-ERROR b! 12 !b ;
|
||||
|
||||
\ ---- conversion and constants ----
|
||||
@@ -46,72 +46,13 @@ set HDR-NFA here ", Q.MIN #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here :
|
||||
|
||||
\ ---- multiply ----
|
||||
set HDR-NFA here ", Q.* #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: Q.* ( a b -- c )
|
||||
SWAP push over over UM* drop
|
||||
push push over pop
|
||||
-if L1 SWAP jump L2 L1: SWAP drop 0 L2:
|
||||
pop SWAP - push
|
||||
push over pop UM* pop +
|
||||
ROT pop dup push
|
||||
over -if L3 drop dup jump L4 L3: drop 0 L4:
|
||||
push UM* pop - D+
|
||||
ROT pop UM*
|
||||
SWAP push 0 D+ pop
|
||||
push over pop SWAP Q.TO-INT push Q.TO-INT pop SWAP ;
|
||||
: Q.* ROM-Q.* push ; \ ( a b -- c ) the ROM's entry 4 (MACHINE.md 2.2)
|
||||
|
||||
\ ---- divide ----
|
||||
: D2*C ( lo hi cin -- lo' hi' cout )
|
||||
a! dup -if L1 drop 1 jump L2 L1: drop 0 L2: push
|
||||
over -if L3 drop 1 jump L4 L3: drop 0 L4:
|
||||
over + +
|
||||
push 2* a + pop pop ;
|
||||
|
||||
: (UQ/) ( a0 a1 b0 b1 -- q0 q1 )
|
||||
(Q/)+2 a! SWAP !+ ! (Q/) a! SWAP !+ ! 0 0 0
|
||||
2N+15 FOR
|
||||
push (Q/) a! @+ @ pop D2*C
|
||||
push (Q/)+1 a! ! (Q/) a! ! pop D2*C
|
||||
if CMP drop jump TAKE
|
||||
CMP: drop (Q/)+3 b! @b
|
||||
over over xor if EQH -if SAMEH
|
||||
drop drop -if NT1 jump TAKE NT1: jump NOTAKE
|
||||
SAMEH: drop over SWAP push inv pop + inv
|
||||
-if T2 drop jump NOTAKE T2: drop jump TAKE
|
||||
EQH: drop drop over (Q/)+2 b! @b
|
||||
over over xor -if SAMEL
|
||||
drop drop -if NT3 drop jump TAKEL NT3: drop jump NOTAKEL
|
||||
SAMEL: drop push inv pop + inv
|
||||
-if T4 drop jump NOTAKEL T4: drop jump TAKEL
|
||||
TAKEL: drop (Q/)+2 b! @b push inv pop + inv 0 1 jump END
|
||||
NOTAKEL: 0 jump END
|
||||
TAKE: push (Q/)+2 b! @b over over push inv pop + inv push
|
||||
over over xor -if SB drop NIP -if NB drop 1 jump BD NB: drop 0 jump BD
|
||||
SB: drop push inv pop + inv -if NB2 drop 1 jump BD NB2: drop 0
|
||||
BD: pop pop (Q/)+3 b! @b push inv pop + inv
|
||||
push SWAP pop SWAP - 1 jump END
|
||||
NOTAKE: 0
|
||||
END:
|
||||
NEXT
|
||||
push (Q/) a! @+ @ pop D2*C drop push push drop drop pop pop ;
|
||||
\ D2*C and (UQ/), Q./'s core, are the ROM's (capsules/v4/rom/math.f18).
|
||||
|
||||
set HDR-NFA here ", Q./ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: Q./ ( a b -- q )
|
||||
over over OR if ZERO drop
|
||||
push over pop SWAP over xor (Q/)+4 b! !b
|
||||
-if L1 DNEGATE L1: push push -if L2 DNEGATE L2: pop pop
|
||||
dup if CHK drop jump DIV
|
||||
CHK: drop over -131072 and if CHK2 drop jump DIV
|
||||
CHK2: drop push push dup pop dup push N-18 FOR 2* UNEXT
|
||||
over over xor -if SAME drop drop -if NOOV jump OV
|
||||
SAME: drop push inv pop + inv -if OV
|
||||
NOOV: drop pop pop jump DIV
|
||||
OV: drop drop drop pop pop drop drop
|
||||
(Q/)+4 b! @b -if OVP drop 0 MSB ; OVP: drop -1 MAXHI ;
|
||||
DIV: (UQ/) (Q/)+4 b! @b -if L3 drop DNEGATE ; L3: drop ;
|
||||
ZERO: drop drop drop
|
||||
over over OR if Z0 drop -if ZP drop drop 0 MSB jump (QERR11)
|
||||
ZP: drop drop -1 MAXHI jump (QERR11)
|
||||
Z0: drop jump (QERR11)
|
||||
: Q./ ROM-Q./ push ; \ ( a b -- q ) the ROM's entry 5
|
||||
|
||||
\ ---- e to the x ----
|
||||
set HDR-NFA here ", Q.EXP #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
|
||||
+9
-6
@@ -99,18 +99,19 @@ ENGINE_SRCS := $(addprefix $(HERE)/src/,node.c exec.c stack.c iword.c heat.c gua
|
||||
# code in capsules/v4/rom, assembled off the node by tools/mkrom.c, as a
|
||||
# bitstream is built. tools/mkmap.c writes the memory map's constants it is
|
||||
# assembled with, from tests/host_map.h. main.f18 comes first: the ROM's
|
||||
# entry table is at its base. math.f18, the shared math, is in both: tools/mkrom.c
|
||||
# builds mesh-rom-<w>.c from mesh.f18 and math.f18 (MACHINE.md 2.2). Tests named test_host_rom_*.c, and
|
||||
# test_host_unit.c, whose host builds the system with it, link the ROM of
|
||||
# their width and read its symbols.
|
||||
# entry table is at its base. math.f18, the shared math, is in both ROMs:
|
||||
# tools/mkrom.c builds mesh-rom-<w>.c, a mesh node's ROM, from mesh.f18 and
|
||||
# math.f18 (MACHINE.md 2.2). Every test named test_host_*.c links the ROMs
|
||||
# of its width and reads their symbols: the system calls its math in the ROM,
|
||||
# so host_load (tests/host_map.h) attaches it where V4_ROM_LINKED is defined.
|
||||
ROM_DIR := $(ROOT)/capsules/v4/rom
|
||||
ROM_FILES := $(wildcard $(addprefix $(ROM_DIR)/,main.f18 in.f18 num.f18 sym.f18 pack.f18 word.f18 dir.f18 math.f18))
|
||||
# A mesh node's ROM (MACHINE.md 2.2): its entry table, then the shared math.
|
||||
MESH_ROM_FILES := $(wildcard $(addprefix $(ROM_DIR)/,mesh.f18 math.f18))
|
||||
MKROM_WORDS := $(shell expr $(HOST_WORDS) + $(HOST_ROM_WORDS))
|
||||
uses_rom = $(or $(findstring /test_host_rom_,$(1)),$(findstring /test_host_unit,$(1)))
|
||||
uses_rom = $(findstring /test_host_,$(1))
|
||||
rom_src = $(if $(call uses_rom,$(1)),$(BINDIR)/rom-$(2).c $(BINDIR)/mesh-rom-$(2).c)
|
||||
rom_sym = $(if $(call uses_rom,$(1)),-DV4_ROM_SYM='"$(BINDIR)/rom-$(2).sym"' -DV4_MESH_ROM_SYM='"$(BINDIR)/mesh-rom-$(2).sym"')
|
||||
rom_sym = $(if $(call uses_rom,$(1)),-DV4_ROM_LINKED -DV4_ROM_SYM='"$(BINDIR)/rom-$(2).sym"' -DV4_MESH_ROM_SYM='"$(BINDIR)/mesh-rom-$(2).sym"')
|
||||
# THE SYSTEM'S SOURCE as the ROM reads it (MACHINE.md 3): capsules/v4/sys. Its
|
||||
# map, map-<width>.f18, is written by tools/mkmap.c from tests/host_map.h
|
||||
# (`make sysmap`) and kept in the tree, as capsules/BLOCK_MAP.md is.
|
||||
@@ -245,6 +246,8 @@ hosted-check: $(foreach i,$(HOSTED_ISAS),$(BINDIR)/boot-$(i).txt) $(BINDIR)/star
|
||||
@grep -q "^ok> UNKNOWN WORD: 'T{'$$" $(BINDIR)/after-post-amd64.txt || { echo "hosted-check: POST's harness is on the node"; exit 1; }
|
||||
@printf '5 7 PORT!\n1 2 + .\n' | $(BINDIR)/starforth4-amd64 > $(BINDIR)/noone-amd64.txt 2>&1; true
|
||||
@grep -q '^ok> No one on that port$$' $(BINDIR)/noone-amd64.txt && grep -q '^ok> 3 ok$$' $(BINDIR)/noone-amd64.txt || { echo "hosted-check: a write to a port with no one on it was not an error the node came back from"; cat $(BINDIR)/noone-amd64.txt | tail -4; exit 1; }
|
||||
@printf '65536 0 0 0 Q./\n3 .\n' | $(BINDIR)/starforth4-amd64 > $(BINDIR)/qdiv-amd64.txt 2>&1; true
|
||||
@grep -q '^ok> Division by zero$$' $(BINDIR)/qdiv-amd64.txt && grep -q '^ok> 3 ok$$' $(BINDIR)/qdiv-amd64.txt || { echo "hosted-check: a division by zero inside the ROM's Q./ was not an error the node came back from"; tail -4 $(BINDIR)/qdiv-amd64.txt; exit 1; }
|
||||
@printf '5 AWAIT\n1 2 + .\n7 8 * .\n' | $(BINDIR)/starforth4-amd64 > $(BINDIR)/await-amd64.txt 2>&1; true
|
||||
@grep -q '^ok> Interrupted$$' $(BINDIR)/await-amd64.txt && grep -q '^ok> 3 ok$$' $(BINDIR)/await-amd64.txt && grep -q '^ok> 56 ok$$' $(BINDIR)/await-amd64.txt || { echo "hosted-check: a line typed while the node waited did not break the wait and then run"; tail -6 $(BINDIR)/await-amd64.txt; exit 1; }
|
||||
@printf '1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29\n1 2 + .\n' | $(BINDIR)/starforth4-amd64 > $(BINDIR)/deep-amd64.txt 2>&1; true
|
||||
|
||||
@@ -13,6 +13,7 @@
|
||||
#define V4_TESTS_HOST_MAP_H
|
||||
|
||||
#include "v4/rom_errors.h"
|
||||
#include "v4/rom_entries.h"
|
||||
#include "v4/blocks.h"
|
||||
#include "v4/text.h"
|
||||
#include <stdio.h>
|
||||
@@ -361,6 +362,25 @@ static unsigned host_branch_slots(void)
|
||||
X("CFBASE", CFS_W) \
|
||||
X("CFEND", CFS_W + CFS_CELLS)
|
||||
|
||||
/* The host node's ROM (MACHINE.md 2), which the tests that link it attach:
|
||||
* the system calls its math there (MACHINE.md 2.2). */
|
||||
#if V4_CELL_BITS == 64
|
||||
extern const v4_cell v4_rom_64[];
|
||||
extern const unsigned v4_rom_64_words;
|
||||
#define ROM_IMAGE v4_rom_64
|
||||
#define ROM_IMAGE_WORDS v4_rom_64_words
|
||||
#else
|
||||
extern const v4_cell v4_rom_32[];
|
||||
extern const unsigned v4_rom_32_words;
|
||||
#define ROM_IMAGE v4_rom_32
|
||||
#define ROM_IMAGE_WORDS v4_rom_32_words
|
||||
#endif
|
||||
|
||||
/* The shared ROM entries (MACHINE.md 2.2), as constants ROM-UM* ...: each
|
||||
* the address of its entry, from the one list (v4/rom_entries.h). The
|
||||
* system's six words of those names call these. */
|
||||
#define HOST_ROM_ENTRY_CONSTANT(i, routine, forth, effect) v4_text_constant(tx, "ROM-" forth, V4_ROM_BASE + (v4_cell)(i));
|
||||
|
||||
static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned count)
|
||||
{
|
||||
char path[512];
|
||||
@@ -372,7 +392,11 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
#define HOST_CONSTANT(name, value) v4_text_constant(tx, name, (v4_cell)(value));
|
||||
HOST_CONSTANTS(HOST_CONSTANT)
|
||||
#undef HOST_CONSTANT
|
||||
V4_ROM_MATH_ENTRIES(HOST_ROM_ENTRY_CONSTANT)
|
||||
v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG);
|
||||
#ifdef V4_ROM_LINKED
|
||||
v4_node_rom_attach(n, ROM_IMAGE, ROM_IMAGE_WORDS); /* the system calls its math in the ROM (MACHINE.md 2.2) */
|
||||
#endif
|
||||
for (i = 0; i < count; i++) {
|
||||
snprintf(path, sizeof path, "%s/%s", V4_SYS_DIR, files[i]);
|
||||
if (!v4_text_assemble_file(tx, path)) {
|
||||
|
||||
@@ -18,18 +18,6 @@
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#if V4_CELL_BITS == 64
|
||||
extern const v4_cell v4_rom_64[];
|
||||
extern const unsigned v4_rom_64_words;
|
||||
#define ROM_IMAGE v4_rom_64
|
||||
#define ROM_IMAGE_WORDS v4_rom_64_words
|
||||
#else
|
||||
extern const v4_cell v4_rom_32[];
|
||||
extern const unsigned v4_rom_32_words;
|
||||
#define ROM_IMAGE v4_rom_32
|
||||
#define ROM_IMAGE_WORDS v4_rom_32_words
|
||||
#endif
|
||||
|
||||
/* A mesh node's ROM (MACHINE.md 2.2): the shared math only. */
|
||||
#if V4_CELL_BITS == 64
|
||||
extern const v4_cell v4_mesh_rom_64[];
|
||||
|
||||
@@ -144,6 +144,7 @@ static unsigned starforth_node(unsigned k)
|
||||
int id = v4_fabric_add(&f, &pool[k], PORT);
|
||||
v4_node *n = &pool[k].n;
|
||||
memcpy(n->mem, nucleus.mem, sizeof n->mem);
|
||||
v4_node_rom_attach(n, ROM_IMAGE, ROM_IMAGE_WORDS); /* the nucleus calls its math in the ROM (MACHINE.md 2.2) */
|
||||
v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG);
|
||||
v4_node_error_attach(n, NODE_ERROR);
|
||||
v4_node_fault_attach(n, w_fault);
|
||||
|
||||
@@ -174,6 +174,7 @@ static unsigned starforth_node(unsigned k)
|
||||
int id = v4_fabric_add(&f, &pool[k], PORT);
|
||||
v4_node *n = &pool[k].n;
|
||||
memcpy(n->mem, nucleus.mem, sizeof n->mem);
|
||||
v4_node_rom_attach(n, ROM_IMAGE, ROM_IMAGE_WORDS); /* the nucleus calls its math in the ROM (MACHINE.md 2.2) */
|
||||
v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG);
|
||||
v4_node_error_attach(n, NODE_ERROR);
|
||||
v4_node_fault_attach(n, w_fault);
|
||||
|
||||
@@ -985,7 +985,7 @@ int main(void)
|
||||
/* ---- an address outside memory (D-14): a message, ERROR, and the prompt ---- */
|
||||
{
|
||||
static const char *const lines[] = {
|
||||
"65 EMIT -1 @ 66 EMIT\n", "65 EMIT 5 -1 ! 66 EMIT\n", "65 EMIT 16384 @ 66 EMIT\n", "65 EMIT 5 16384 ! 66 EMIT\n",
|
||||
"65 EMIT -1 @ 66 EMIT\n", "65 EMIT 5 -1 ! 66 EMIT\n", "65 EMIT 20480 @ 66 EMIT\n", "65 EMIT 5 16384 ! 66 EMIT\n",
|
||||
"65 EMIT 99999999 C@ 66 EMIT\n", "65 EMIT 7 -4 C! 66 EMIT\n", "65 EMIT -1 EXECUTE 66 EMIT\n", "65 EMIT 1 -1 +! 66 EMIT\n",
|
||||
"65 EMIT PAD -8 4 CMOVE 66 EMIT\n", "65 EMIT -9 COUNT 66 EMIT\n", "65 EMIT -9 3 TYPE 66 EMIT\n",
|
||||
": F0 -1 @ ; : F1 F0 ; : F2 F1 ; : F3 65 EMIT F2 66 EMIT ; F3 67 EMIT\n",
|
||||
|
||||
@@ -126,6 +126,65 @@ static int entry_jumps_to(const v4_cell *rom, unsigned i, const char *sym, const
|
||||
&& v4_iword_branch(V4_ROM_BASE + (v4_cell)i, w, 0) == (v4_cell)target;
|
||||
}
|
||||
|
||||
/* THE SYSTEM CALLS THE ROM. The system as text.c builds it (host_load, the
|
||||
* ROM attached): each of the six words is a literal of its entry's address,
|
||||
* then push, then ; -- it goes to the entry and the entry's ; returns to the
|
||||
* word's caller -- and it gives the table's results. On a node with no ROM
|
||||
* the call faults rather than computing anything. */
|
||||
static v4_text tx;
|
||||
static int system_cases(void)
|
||||
{
|
||||
static const char *const files[] = {
|
||||
#define SYS_FILE_NAME(file) #file ".f18",
|
||||
V4_SYS_FILES(SYS_FILE_NAME)
|
||||
#undef SYS_FILE_NAME
|
||||
};
|
||||
unsigned k;
|
||||
if (!host_load(&tx, &n, files, (unsigned)(sizeof files / sizeof files[0])) || !v4_text_finish(&tx)) {
|
||||
printf(" the system does not assemble: %s\n", v4_text_error(&tx));
|
||||
return 0;
|
||||
}
|
||||
#define CHECK_CALLS(i, routine, forth, effect) { \
|
||||
v4_cell w = v4_text_word(&tx, forth); \
|
||||
v4_iword iw = w >= 0 ? (v4_iword)((v4_ucell)n.mem[w] & 0xFFFFFFFFu) : 0; \
|
||||
CHECK(w >= 0 && v4_iword_op(iw, 0) == V4_OP_FETCH_P && v4_iword_op(iw, 1) == V4_OP_PUSH && v4_iword_op(iw, 2) == V4_OP_SEMI \
|
||||
&& n.mem[w + 1] == V4_ROM_BASE + (v4_cell)(i), "the system's %s is the ROM's entry %d, then push and ;", forth, i); }
|
||||
V4_ROM_MATH_ENTRIES(CHECK_CALLS)
|
||||
#undef CHECK_CALLS
|
||||
for (k = 0; k < CASES; k++) {
|
||||
static const char *const forth_of[] = {
|
||||
#define FORTH_NAME(i, routine, forth, effect) forth,
|
||||
V4_ROM_MATH_ENTRIES(FORTH_NAME)
|
||||
#undef FORTH_NAME
|
||||
};
|
||||
const math_case *c = &cases[k];
|
||||
v4_cell got[2] = { 0, 0 };
|
||||
unsigned i;
|
||||
int ok;
|
||||
v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&rom_es); v4_heat_reset(&rom_h);
|
||||
n.mem[NODE_ERROR] = 0;
|
||||
v4_dstack_push(&n.ds, CANARY);
|
||||
for (i = 0; i < c->argc; i++) v4_dstack_push(&n.ds, c->in[i]);
|
||||
ok = v4_test_call(&n, &rom_es, &rom_h, v4_text_word(&tx, forth_of[c->entry]), 10000000L) > 0;
|
||||
for (i = c->outc; i-- > 0; ) got[i] = v4_dstack_pop(&n.ds);
|
||||
CHECK(ok && v4_dstack_pop(&n.ds) == CANARY && got[0] == c->out[0] && got[1] == c->out[1] && n.mem[NODE_ERROR] == c->error,
|
||||
"the system's %s, case %u: got %lld %lld error %lld", forth_of[c->entry], k,
|
||||
(long long)got[0], (long long)got[1], (long long)n.mem[NODE_ERROR]);
|
||||
}
|
||||
/* the same system with its ROM taken away: UM* does not return */
|
||||
v4_node_rom_attach(&n, ROM_IMAGE, 0u);
|
||||
v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&rom_es); v4_heat_reset(&rom_h);
|
||||
v4_dstack_push(&n.ds, 12345); v4_dstack_push(&n.ds, 67890);
|
||||
{
|
||||
unsigned faults = n.faults;
|
||||
long r = v4_test_call(&n, &rom_es, &rom_h, v4_text_word(&tx, "UM*"), 100000L);
|
||||
CHECK(r <= 0 && n.faults > faults && n.fault_kind == V4_FAULT_ADDRESS && n.fault_addr == V4_ROM_BASE,
|
||||
"with no ROM, the system's UM* faults at the ROM's address and computes nothing: returned %ld, %u faults, kind %u at %lld",
|
||||
r, n.faults - faults, n.fault_kind, (long long)n.fault_addr);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
printf("v4 ROM math tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
|
||||
@@ -151,6 +210,8 @@ int main(void)
|
||||
cases_on("host", ROM_IMAGE, ROM_IMAGE_WORDS);
|
||||
cases_on("mesh", MESH_ROM, MESH_ROM_WORDS);
|
||||
|
||||
CHECK(system_cases(), "the system the tests build with text.c");
|
||||
|
||||
printf(" %d checks, %d failures\n", checks, failures);
|
||||
return failures != 0;
|
||||
}
|
||||
|
||||
@@ -143,6 +143,7 @@ static int host_born(void *self)
|
||||
v4_node_stack_regs_attach(&pool[k].n, DSTACK_REG, RSTACK_REG);
|
||||
v4_node_error_attach(&pool[k].n, NODE_ERROR);
|
||||
v4_node_fault_attach(&pool[k].n, w_fault);
|
||||
v4_node_rom_attach(&pool[k].n, ROM_IMAGE, ROM_IMAGE_WORDS); /* the nucleus calls its math in the ROM (MACHINE.md 2.2) */
|
||||
v4_blocks_init(&node_blocks[k], BUF0_W);
|
||||
if (k != 0) { /* Hera's kernel is wired where she is made */
|
||||
node_kernel[k].take = node_kernel_take; node_kernel[k].give = 0; node_kernel[k].self = &pool[k];
|
||||
|
||||
@@ -31,6 +31,9 @@ static int system_map(void)
|
||||
#define SYS_CONSTANT(name, value) constant(name, (long)(v4_cell)(value));
|
||||
HOST_CONSTANTS(SYS_CONSTANT)
|
||||
#undef SYS_CONSTANT
|
||||
#define SYS_ROM_ENTRY(i, routine, forth, effect) constant("ROM-" forth, (long)(V4_ROM_BASE + (v4_cell)(i)));
|
||||
V4_ROM_MATH_ENTRIES(SYS_ROM_ENTRY)
|
||||
#undef SYS_ROM_ENTRY
|
||||
constant("DICT-W", (long)DICT_W);
|
||||
constant("(IMG)", (long)ROM_IMG);
|
||||
return 0;
|
||||
|
||||
Reference in New Issue
Block a user