feat(v4): the ROM assembles text as text.c does -- words, labels, macros, FOR, directives, start
word.f18: (NEXT-TOKEN) reads the console or a macro being expanded; labels, branches by name (a label of the word, or a word, now or later), the table of branches waiting, end of word, FOR/NEXT/UNEXT, macros, &NAME, CONST+N, and (ONE), which dispatches a token. A forward branch to a name not yet defined waits on a placeholder symbol, filled in by (DEFINE). dir.f18: constant set here #, ", store, and start, which resolves, clears the tables the ROM used and runs the word it names. main.f18: the ROM itself, entry 12; on an error it stops at (ROM-FAILED) with the code and line in its state, for the loader to report. sym.f18 generalized: any counted string, placeholders, a hash of only a name's own cells. test_host_rom_asm.c gives test_text.c's own texts (accepted and refused), its four real definitions and the ROM's directives to text.c and to the ROM: the same words, the same errors on the same lines, at both widths. The ROM is 2036 words. 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
c233cb6536
commit
084c520a54
@@ -149,6 +149,38 @@
|
||||
#define ROM_PTR (OUT_W - 124) /* (SAME?), (DEFINE): where in a name */
|
||||
#define ROM_I (OUT_W - 123) /* where in the token */
|
||||
#define ROM_WI (OUT_W - 122) /* (WALK): which entry of a table */
|
||||
#define ROM_NREF (OUT_W - 121) /* word.f18: how many branches wait for a target */
|
||||
#define ROM_NLAB (OUT_W - 120) /* how many labels the word being assembled has */
|
||||
#define ROM_WNP (OUT_W - 119) /* cells of the word's name area used */
|
||||
#define ROM_NFOR (OUT_W - 118) /* how many FORs are open */
|
||||
#define ROM_FORS (OUT_W - 117) /* where each began, 8 cells */
|
||||
#define ROM_RDEPTH (OUT_W - 109) /* how many macros are being expanded */
|
||||
#define ROM_RPTRS (OUT_W - 108) /* where each is reading, 8 cells */
|
||||
#define ROM_T1 (OUT_W - 100) /* working cells */
|
||||
#define ROM_T2 (OUT_W - 99)
|
||||
#define ROM_T3 (OUT_W - 98)
|
||||
#define ROM_T4 (OUT_W - 97)
|
||||
#define ROM_CFROM (OUT_W - 96)
|
||||
#define ROM_CTO (OUT_W - 95)
|
||||
#define ROM_CN (OUT_W - 94)
|
||||
#define ROM_RAW (OUT_W - 93) /* in.f18: 1 while a token is read raw, ( and \ being names */
|
||||
#define ROM_T5 (OUT_W - 92)
|
||||
#define ROM_T6 (OUT_W - 91)
|
||||
#define ROM_MLEN (OUT_W - 90) /* the length of the token saved in ROM_MTEMP */
|
||||
#define ROM_ORIGIN 16 /* where the system's code begins */
|
||||
/* The ROM's other tables, used only while it assembles (cleared at `start`): in the block window, the branches
|
||||
* waiting -- four cells each: the word, the line, a symbol record (or, while local, a name), 1 if local -- the
|
||||
* labels of the word being assembled -- a name and an address -- and their names; in the text input buffer, a
|
||||
* saved token, a character to a cell, a macro's name and its body being collected. */
|
||||
#define ROM_REFS BUF0_W /* 128 entries */
|
||||
#define ROM_REFS_MAX 128
|
||||
#define ROM_LABELS (BUF0_W + 512) /* 64 entries */
|
||||
#define ROM_WNAMES (BUF0_W + 640) /* 384 cells */
|
||||
#define ROM_WN_SIZE 384
|
||||
#define ROM_TSAVE TIB_W /* 16 cells */
|
||||
#define ROM_MTEMP (TIB_W + 16) /* 64 cells */
|
||||
#define ROM_MBODY (TIB_W + 80) /* 180 cells */
|
||||
#define ROM_MBODY_SIZE 180
|
||||
/* THE ROM'S SYMBOL TABLE, used only while it assembles, in dictionary space (cleared at `start`): 256 hash heads,
|
||||
* then records growing up -- link, name, kind, value -- and names, as counted strings, growing down from the top. */
|
||||
#define ROM_SYMH DICT_W
|
||||
@@ -170,6 +202,23 @@
|
||||
#define ROM_ERR_NAMES 5 /* the symbol table is full: "too many names" */
|
||||
#define ROM_ERR_FIT 6 /* memory is full, or a branch cannot reach: "does not fit" */
|
||||
#define ROM_ERR_OPCODE 7 /* not an opcode the packer takes there */
|
||||
#define ROM_ERR_IN_MACRO 8 /* "not allowed in a macro" */
|
||||
#define ROM_ERR_MACRO 9 /* "macro without endmacro", "endmacro without macro" */
|
||||
#define ROM_ERR_LABEL_DUP 10 /* "label already defined in this word" */
|
||||
#define ROM_ERR_LABELS 11 /* "too many labels in one word" */
|
||||
#define ROM_ERR_FOR 12 /* FOR nested too deep, NEXT or UNEXT without FOR, FOR without NEXT */
|
||||
#define ROM_ERR_UNEXT 13 /* "FOR ... UNEXT must fit one instruction word and hold no literal" */
|
||||
#define ROM_ERR_TARGET 14 /* "not something to branch to" */
|
||||
#define ROM_ERR_UNDEFINED 15 /* "never defined" */
|
||||
#define ROM_ERR_BIG 16 /* "number does not fit a cell" */
|
||||
#define ROM_ERR_AMP 17 /* "& needs a word that is already defined" */
|
||||
#define ROM_ERR_FETCH_P 18 /* "write the number, not @p" */
|
||||
#define ROM_ERR_MISSING 19 /* a name, a target, a value or a string missing at the end */
|
||||
#define ROM_ERR_DEEP 20 /* "macros nested too deep" */
|
||||
#define ROM_ERR_REFS 21 /* "too many unresolved branches" */
|
||||
#define ROM_ERR_VALUE 22 /* "not a value", "not a number" */
|
||||
#define ROM_ERR_NO_START 23 /* the input ended with no start */
|
||||
#define ROM_ERR_START 24 /* start: not a word */
|
||||
#define ROM_ADDR_TOP ((v4_cell)(V4_NODE_WORDS + V4_ROM_WORDS - 1u)) /* the top of the address space */
|
||||
#define WORD_DEFINED (BUF0_W - 11) /* the xt of the word that is told of each new entry, or 0 */
|
||||
#define WORD_FORGOTTEN (BUF0_W - 12) /* the xt of the word that is told when entries go, or 0 */
|
||||
|
||||
@@ -0,0 +1,115 @@
|
||||
/* rom_asm_cases.h -- the texts of v4/tests/test_text.c, accepted and refused, that the ROM's language has
|
||||
* (no header and no flags). Extracted once from test_text.c; each is given to text.c and to the ROM, and
|
||||
* test_host_rom_asm.c requires the same outcome. */
|
||||
static const char *const rom_asm_cases[] = {
|
||||
": T 123 ;",
|
||||
": T -5 ;",
|
||||
": T $FF ;",
|
||||
": T $ff $Ab + ;",
|
||||
": T 0 ;",
|
||||
": T 1 2 3 4 5 6 7 + + + + + + ;",
|
||||
": T 4294967295 ;",
|
||||
": T -2147483648 ;",
|
||||
": T $FFFFFFFF ;",
|
||||
": T 4294967296 ;",
|
||||
": T -2147483649 ;",
|
||||
": T $100000000 ;",
|
||||
": T 18446744073709551615 ;",
|
||||
": T -9223372036854775808 ;",
|
||||
": T $FFFFFFFFFFFFFFFF ;",
|
||||
": T 18446744073709551616 ;",
|
||||
": T -9223372036854775809 ;",
|
||||
": T $10000000000000000 ;",
|
||||
": T 99999999999999999999999999 ;",
|
||||
": T VAR ;",
|
||||
": ST ( x -- ) VAR a! ! ; : LD ( -- x ) VAR a! @ ;",
|
||||
"\\ a line comment\n: T ( a stack comment ) 7 \\ another\n ( and\n one over two lines ) 8 + ; \\ the end",
|
||||
": (T) 5 ; : T (T) (T) + ;",
|
||||
": T 1 ( never closed",
|
||||
": T @p ;",
|
||||
": A 3 ; : T A A + ;",
|
||||
": T A A + ; : A 4 ;",
|
||||
": T jump A : A 9 ;",
|
||||
": T call A 1 + ; : A 9 ;",
|
||||
": A 1 ; : B A A + ; : C B B + ; : T C C + ;",
|
||||
": T 5 \n : U 1 + ;",
|
||||
": T ( n -- 1|2 ) if Z drop 1 ; Z: drop 2 ;",
|
||||
": T ( n -- 0 ) L: if DONE -1 + jump L DONE: ;",
|
||||
": T ( n -- f ) -if P drop -1 ; P: drop 0 ;",
|
||||
": A ( n -- 1|2 ) if L drop 1 ; L: drop 2 ; : T ( n -- 3|4 ) if L drop 3 ; L: drop 4 ;",
|
||||
": L 50 ; : T ( n -- x ) if L drop 1 ; L: drop 2 ;",
|
||||
": L 50 ; : T ( n -- x ) L: if DONE -1 + jump L DONE: drop 3 ;",
|
||||
": L drop 50 ; : T ( n -- x ) if L drop 1 ; : U 2 ;",
|
||||
": L drop 50 ; : T ( n -- x ) if L drop 1 ;",
|
||||
": T ( n -- x ) if OUT drop 1 ; : OUT drop 77 ;",
|
||||
": T L: 1 L: 2 ;",
|
||||
": T if NOWHERE ;\n: U 1 ;",
|
||||
"\n\n: T 1 MISSING + ;",
|
||||
": T jump",
|
||||
": T jump 5 ;",
|
||||
": T jump VAR ;",
|
||||
": T jump dup ;",
|
||||
": T ( n -- n+5 ) 4 FOR 1 + NEXT ;",
|
||||
": T ( n -- n*8 ) 2 FOR 2* UNEXT ;",
|
||||
": T ( n -- x ) 1 FOR 2 FOR 2* UNEXT NEXT ;",
|
||||
": T ( n -- x ) 2 FOR 2* UNEXT 1 + ;",
|
||||
": T ( n -- x ) 2 FOR dup + 2* nop UNEXT ;",
|
||||
": T 2 FOR dup + 2* nop nop nop UNEXT ;",
|
||||
": T 2 FOR 1 + UNEXT ;",
|
||||
": T NEXT ;",
|
||||
": T UNEXT ;",
|
||||
": T 3 FOR 1 + ;\n: U ;",
|
||||
": T 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR ;",
|
||||
"macro SWAP over push push drop pop pop endmacro : T ( a b -- b ) SWAP drop ;",
|
||||
"macro 1+ 1 + endmacro macro 2+ 1+ 1+ endmacro : T 2+ 2+ ;",
|
||||
"macro TEN ( a comment ) 10 \\ and another\n endmacro : T TEN TEN + ;",
|
||||
"macro SHL3 2 FOR 2* UNEXT endmacro : T SHL3 ;",
|
||||
": A 6 ; macro CALLS A A + endmacro : T CALLS ;",
|
||||
"macro NOTHING endmacro : T 5 NOTHING ;",
|
||||
"macro M L: endmacro",
|
||||
"macro M : X ; endmacro",
|
||||
"macro M macro N endmacro endmacro",
|
||||
"macro M 1 2 3",
|
||||
"macro",
|
||||
": T endmacro ;",
|
||||
"macro M M endmacro : T M ;",
|
||||
": A 1 ;\n: A 2 ;",
|
||||
": VAR 1 ;",
|
||||
"macro A 1 endmacro : A 2 ;",
|
||||
": dup 1 ;",
|
||||
": 12 1 ;",
|
||||
": FOR 1 ;",
|
||||
"macro + 1 endmacro",
|
||||
": X: 1 ;",
|
||||
":",
|
||||
": T THIS-NAME-IS-MUCH-TOO-LONG-TO-BE-A-NAME-IN-THIS-ASSEMBLER-BY-A-WIDE-MARGIN ;",
|
||||
": Dup 3 ; : T Dup Dup + ;",
|
||||
": 2DUP over over ; : 1+ 1 + ; : T ( a b -- 2a+2b+1 ) 2DUP + + + 1+ ;",
|
||||
": T VAR+3 ;",
|
||||
": T VAR+0 VAR+10 + ;",
|
||||
": VAR+1 77 ; : T VAR+1 ;",
|
||||
": T VAR+ ;",
|
||||
": T VAR+x ;",
|
||||
": T NOPE+1 ;",
|
||||
": A 5 ; : T &A ;",
|
||||
": A 5 ; : T &A push ;",
|
||||
": T &A ; : A 5 ;",
|
||||
": T &VAR ;",
|
||||
": &X 1 ;",
|
||||
": T 1 ;",
|
||||
": T 1 ;\n: T 2 ;",
|
||||
"constant SEVEN 7 constant MINUS -2 constant BIG $7F : T SEVEN MINUS + BIG + ;",
|
||||
"constant K 3 : T K+2 ;",
|
||||
"constant K 3 constant K 4",
|
||||
"constant dup 3",
|
||||
"constant K",
|
||||
"constant K x",
|
||||
": constant ;",
|
||||
"constant K 9 : T ; #, 5 #, -1 #, K #, K+2 #, &T \", ab \", ( \", abcde",
|
||||
": T dup #, 7 ;",
|
||||
"#, x",
|
||||
"#,",
|
||||
"\",",
|
||||
": #, ;",
|
||||
": \", ;",
|
||||
};
|
||||
@@ -30,7 +30,7 @@ extern const unsigned v4_rom_32_words;
|
||||
/* The entry table, in its fixed order: entry i is at V4_ROM_BASE + i. */
|
||||
static const char *const rom_entries[] = {
|
||||
"(KEY)", "(TOKEN)", "(NUMBER)", "(FIND)", "(DEFINE)", "(OPCODE)",
|
||||
"(OP)", "(LIT)", "(BRANCH)", "(BRANCH>)", "(RESOLVE)", "(LABEL)"
|
||||
"(OP)", "(LIT)", "(BRANCH)", "(BRANCH>)", "(RESOLVE)", "(LABEL)", "(ROM)"
|
||||
};
|
||||
#define ROM_ENTRIES (sizeof rom_entries / sizeof rom_entries[0])
|
||||
|
||||
|
||||
@@ -0,0 +1,191 @@
|
||||
/* test_host_rom_asm.c -- the ROM assembles text exactly as v4/src/text.c does.
|
||||
*
|
||||
* Plan Tasks 6 and 7. The ROM is started at its entry (12) and fed a text
|
||||
* through the console, ending with `start`; text.c assembles the same text.
|
||||
* Where text.c accepts it, the ROM must lay down the same words and jump to
|
||||
* the word start names; where text.c refuses it, the ROM must stop at
|
||||
* (ROM-FAILED) with the same class of error, on the same line. The texts
|
||||
* are test_text.c's own (rom_asm_cases.h), test_text.c's four real
|
||||
* definitions, and the ROM's own directives: set, here, store, start.
|
||||
*/
|
||||
#include "rom_harness.h"
|
||||
#include "v4/text.h"
|
||||
#include "rom_asm_cases.h"
|
||||
|
||||
static int failures = 0, checks = 0;
|
||||
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)
|
||||
|
||||
#define VARS ((v4_cell)(V4_NODE_WORDS - 16u)) /* test_text.c's VAR */
|
||||
|
||||
static v4_node a, b;
|
||||
static v4_text tx;
|
||||
static char in[1u << 16];
|
||||
|
||||
/* the ROM error code for one of text.c's messages */
|
||||
static v4_cell code_of(const char *m)
|
||||
{
|
||||
static const struct { const char *s; v4_cell c; } map[] = {
|
||||
{ "label already defined", ROM_ERR_LABEL_DUP }, { "& needs", ROM_ERR_AMP },
|
||||
{ "macros nested too deep", ROM_ERR_DEEP }, { "macro without", ROM_ERR_MACRO },
|
||||
{ "endmacro without", ROM_ERR_MACRO }, { "nested too deep", ROM_ERR_FOR },
|
||||
{ "NEXT without", ROM_ERR_FOR }, { "FOR without", ROM_ERR_FOR },
|
||||
{ "already defined", ROM_ERR_DEFINED }, { "cannot be used as a name", ROM_ERR_BAD_NAME },
|
||||
{ "does not fit a cell", ROM_ERR_BIG }, { "does not fit", ROM_ERR_FIT },
|
||||
{ "branch cannot reach", ROM_ERR_FIT }, { "name too long", ROM_ERR_TOO_LONG },
|
||||
{ "comment not closed", ROM_ERR_COMMENT }, { "not allowed in a macro", ROM_ERR_IN_MACRO },
|
||||
{ "too many labels", ROM_ERR_LABELS }, { "must fit one instruction word", ROM_ERR_UNEXT },
|
||||
{ "not something to branch to", ROM_ERR_TARGET }, { "never defined", ROM_ERR_UNDEFINED },
|
||||
{ "write the number", ROM_ERR_FETCH_P }, { "too many unresolved", ROM_ERR_REFS },
|
||||
{ "not a value", ROM_ERR_VALUE }, { "not a number", ROM_ERR_VALUE },
|
||||
{ "too many names", ROM_ERR_NAMES }, { "out of name space", ROM_ERR_NAMES },
|
||||
{ "without", ROM_ERR_MISSING },
|
||||
};
|
||||
unsigned i;
|
||||
for (i = 0; i < sizeof map / sizeof map[0]; i++) if (strstr(m, map[i].s)) return map[i].c;
|
||||
return -1;
|
||||
}
|
||||
|
||||
static unsigned line_of(const char *m)
|
||||
{
|
||||
unsigned l = 0;
|
||||
return sscanf(m, "line %u:", &l) == 1 ? l : 0;
|
||||
}
|
||||
|
||||
/* Run the ROM on `text` (EOT is added). 1: it started -- P left the ROM for
|
||||
* RAM; 0: it stopped at (ROM-FAILED); -1: neither within the steps allowed. */
|
||||
static int rom_run(const char *text)
|
||||
{
|
||||
static long failed_lo = -1, failed_hi = -1;
|
||||
size_t len = strlen(text), fed = 0;
|
||||
long steps = 0;
|
||||
if (failed_lo < 0) { /* where (ROM-FAILED) is: looked up once */
|
||||
FILE *f = fopen(V4_ROM_SYM, "r");
|
||||
char sym[80]; long ad, lo = -1, hi = -1;
|
||||
while (f && fscanf(f, "%79s %ld", sym, &ad) == 2) if (strcmp(sym, "(ROM-FAILED)") == 0) lo = ad;
|
||||
if (f) rewind(f);
|
||||
while (f && fscanf(f, "%79s %ld", sym, &ad) == 2) if (ad > lo && (hi < 0 || ad < hi)) hi = ad;
|
||||
if (f) fclose(f);
|
||||
failed_lo = lo; failed_hi = hi < 0 ? (long)V4_ROM_BASE + (long)ROM_IMAGE_WORDS : hi;
|
||||
}
|
||||
rom_boot(&b);
|
||||
b.p = V4_ROM_BASE + 12;
|
||||
while (steps++ < 50000000L) {
|
||||
if (fed <= len) fed += v4_node_console_feed(&b, text + fed, (unsigned)(len + 1 - fed));
|
||||
if (b.p < V4_ROM_BASE) return 1;
|
||||
if ((long)b.p >= failed_lo && (long)b.p < failed_hi) return 0;
|
||||
(void)v4_exec_step_word(&b, &rom_es, &rom_h);
|
||||
if (b.stopped) return -1;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* text.c and the ROM on the same text, with a word to start at after it */
|
||||
static void same(const char *text)
|
||||
{
|
||||
static char ta[1u << 15];
|
||||
int okA, rb;
|
||||
v4_cell w, hereA, endA;
|
||||
|
||||
snprintf(ta, sizeof ta, "constant VAR %ld\nconstant N-1 %d\n%s\n: ZZEND ;\n", (long)VARS, V4_CELL_BITS - 1, text);
|
||||
v4_node_reset(&a);
|
||||
v4_text_begin(&tx, &a, ROM_ORIGIN);
|
||||
okA = v4_text_assemble(&tx, ta) && v4_text_finish(&tx);
|
||||
snprintf(in, sizeof in, "%s", ta); /* start on ZZEND's line: the ROM sees as many lines as text.c */
|
||||
in[strlen(in) - 1] = 0;
|
||||
strcat(in, " start ZZEND\n\x04");
|
||||
rb = rom_run(in);
|
||||
if (okA) {
|
||||
hereA = v4_text_here(&tx);
|
||||
endA = v4_text_word(&tx, "ZZEND");
|
||||
CHECK(rb == 1, "[%s] text.c accepts; the ROM %s (code %ld line %ld)", text,
|
||||
rb == 0 ? "refused" : "did not finish", (long)b.mem[ROM_FAILED], (long)b.mem[ROM_ERRLINE] + 1);
|
||||
if (rb != 1) return;
|
||||
CHECK(b.p == endA, "[%s] the ROM started at ZZEND: P %ld, text.c %ld", text, (long)b.p, (long)endA);
|
||||
CHECK(b.mem[ROM_HERE] == hereA, "[%s] here: ROM %ld, text.c %ld", text, (long)b.mem[ROM_HERE], (long)hereA);
|
||||
for (w = ROM_ORIGIN; w < hereA; w++) if (a.mem[w] != b.mem[w]) break;
|
||||
CHECK(w == hereA, "[%s] word %ld differs: text.c %lx, ROM %lx", text, (long)w,
|
||||
(unsigned long)a.mem[w], (unsigned long)b.mem[w]);
|
||||
} else {
|
||||
const char *m = v4_text_error(&tx);
|
||||
v4_cell want = code_of(m);
|
||||
unsigned l = line_of(m);
|
||||
CHECK(rb == 0, "[%s] text.c refuses (%s); the ROM %s", text, m, rb == 1 ? "accepted" : "did not finish");
|
||||
if (rb != 0) return;
|
||||
CHECK(b.mem[ROM_FAILED] == want, "[%s] text.c: %s; ROM code %ld, want %ld", text, m, (long)b.mem[ROM_FAILED], (long)want);
|
||||
if (l > 2) CHECK((unsigned)b.mem[ROM_ERRLINE] + 1u == l, "[%s] line: text.c %u, ROM %ld", text, l, (long)b.mem[ROM_ERRLINE] + 1);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int main(void)
|
||||
{
|
||||
unsigned i;
|
||||
|
||||
for (i = 0; i < sizeof rom_asm_cases / sizeof rom_asm_cases[0]; i++) same(rom_asm_cases[i]);
|
||||
|
||||
/* test_text.c's four real definitions, and more of the notation together */
|
||||
same("macro SWAP over push push drop pop pop endmacro\n"
|
||||
": SWAP' ( a b -- b a ) SWAP ;\n"
|
||||
": UM/MOD ( ulo uhi ud -- urem uquot )\n"
|
||||
" a! N-1 FOR\n"
|
||||
" -if L0\n"
|
||||
" 2* over -if L1 drop 1 + jump L2\n"
|
||||
" L1: drop L2: push 2* pop\n"
|
||||
" jump SUB\n"
|
||||
" L0:\n"
|
||||
" 2* over -if L3 drop 1 + jump L4\n"
|
||||
" L3: drop L4: push 2* pop\n"
|
||||
" dup a xor -if L5\n"
|
||||
" drop -if NOSUB jump SUB\n"
|
||||
" L5: drop dup inv a + inv -if L6\n"
|
||||
" drop jump NOSUB\n"
|
||||
" L6: push drop pop jump SETBIT\n"
|
||||
" SUB: inv a + inv\n"
|
||||
" SETBIT: push 1 + pop\n"
|
||||
" NOSUB:\n"
|
||||
" NEXT\n"
|
||||
" SWAP ;\n"
|
||||
": C@ ( baddr -- c )\n"
|
||||
" dup 2/ 2/ a! 3 and\n"
|
||||
" if K0 -1 + if K1 -1 + if K2\n"
|
||||
" drop @ 23 FOR 2/ UNEXT 255 and ;\n"
|
||||
" K2: drop @ 15 FOR 2/ UNEXT 255 and ;\n"
|
||||
" K1: drop @ 7 FOR 2/ UNEXT 255 and ;\n"
|
||||
" K0: drop @ 255 and ;\n"
|
||||
": C! ( c baddr -- )\n"
|
||||
" dup 2/ 2/ a! 3 and push 255 and pop\n"
|
||||
" if K0 -1 + if K1 -1 + if K2\n"
|
||||
" drop 23 FOR 2* UNEXT @ 4278190080 inv and + ! ;\n"
|
||||
" K2: drop 15 FOR 2* UNEXT @ -16711681 and + ! ;\n"
|
||||
" K1: drop 7 FOR 2* UNEXT @ -65281 and + ! ;\n"
|
||||
" K0: drop @ -256 and + ! ;\n"
|
||||
": ROUNDTRIP ( c baddr -- c' ) dup push C! pop jump C@\n");
|
||||
same(": A B C ; : B jump D ; : C if E D E: ; : D ; macro TWO dup dup endmacro macro FOUR TWO TWO endmacro\n"
|
||||
": F FOUR &A VAR+3 \\ a comment\n ( and another ) ;\n#, 5 \", ( #, &F \", abcdefgh");
|
||||
|
||||
/* the ROM's own directives */
|
||||
CHECK(rom_run("set S 5 set S 9 : T S ;\nstore 7000 S store 7001 here\n#, here\n: Z ;\nstart Z\n\x04") == 1,
|
||||
"set, here and store assemble: code %ld", (long)b.mem[ROM_FAILED]);
|
||||
CHECK(b.mem[7000] == 9 && b.mem[7001] == 18 && b.mem[18] == 18, "set takes its last value, here is the next word: %ld %ld %ld",
|
||||
(long)b.mem[7000], (long)b.mem[7001], (long)b.mem[18]);
|
||||
CHECK(rom_run(": T ;\n\x04") == 0 && b.mem[ROM_FAILED] == ROM_ERR_NO_START, "no start: refused");
|
||||
CHECK(rom_run(": T ;\nconstant K 1\nstart K\n\x04") == 0 && b.mem[ROM_FAILED] == ROM_ERR_START, "start of a constant: refused");
|
||||
CHECK(rom_run(": T ;\nstart\n\x04") == 0 && b.mem[ROM_FAILED] == ROM_ERR_MISSING, "start alone: refused");
|
||||
CHECK(rom_run(": T here ;\n: Z ;\nstart Z\n\x04") == 0 && b.mem[ROM_FAILED] == ROM_ERR_TARGET, "here alone is not code");
|
||||
CHECK(rom_run("store 9000\n: Z ;\nstart Z\n\x04") == 0, "store needs two values");
|
||||
|
||||
/* a blob split over two feeds, and a forward call resolved in the second (Review Focus 1) */
|
||||
CHECK(rom_run(": A B ;\n: B 7 ;\n: Z ;\nstart Z\n\x04") == 1 && (b.mem[ROM_ORIGIN] & 0xFFFFFFFF) != 0, "a forward call across words");
|
||||
|
||||
/* the tables are cleared at start (Review Focus 4) */
|
||||
rom_run(": A B ;\n: B 7 ;\nmacro M dup endmacro\n: Z M ;\nstart Z\n\x04");
|
||||
for (i = 0; i < (unsigned)(DICT_END_W - DICT_W); i++) if (b.mem[DICT_W + (v4_cell)i] != 0) break;
|
||||
CHECK(i == (unsigned)(DICT_END_W - DICT_W), "the symbol table is cleared: cell %u is not", i);
|
||||
for (i = 0; i < 1024u; i++) if (b.mem[BUF0_W + (v4_cell)i] != 0) break;
|
||||
CHECK(i == 1024u, "the block window is cleared: cell %u is not", i);
|
||||
for (i = 0; i < 260u; i++) if (b.mem[TIB_W + (v4_cell)i] != 0) break;
|
||||
CHECK(i == 260u, "the text input buffer is cleared: cell %u is not", i);
|
||||
|
||||
printf("test_host_rom_asm: %d checks, %d failures\n", checks, failures);
|
||||
return failures != 0;
|
||||
}
|
||||
Reference in New Issue
Block a user