admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d5b72354645ccc8773fc8193d0e646c507605d1a
LithosAnanake/v4/tests/test_host_quit.c
T
rajamesandClaude Opus 5.5 d5b7235464 feat(v4.0.0): every node asks the kernel for its blocks; a born node is not POSTed 
A block is a kernel request, as ENGINE.md 3.3 has it: the node puts the
block's number and the address of 256 cells on its stack and writes the
request to port 0, and the kernel leaves the status there.  The requests
are -1, read, and -2, write, the same for every node.  v4/system/blocks.c
serves them from the kernel's block subsystem, which is v3's.  The four
storage registers are gone from the engine.

The device that spoke block messages (4a505a15) is withdrawn with its
test and its message types: Captain Bob ruled on 2026-10-07 that it, a
node's own drive, and nodes with no storage had left the OS as designed
(docs/v4.0.0/MESH.md 8.5).

Hera no longer sends POST to the nodes she births: POST is the kernel's,
once.  Every node has its kernel on port 0; it serves a node's blocks and,
for Hera alone, her requests for nodes and capsules.

Bare metal: the node boots and is POSTed against POST's own block RAM,
and the kernel's chain -- fast RAM, the ramdrive, the virtio disk -- is
set up after POST and before the prompt, as on the v3 path.  The disk is
read and not written: nothing in v4 yet gives the owner's word that it
may be formatted.  A hosted program has the chain's fast RAM, as hosted
v3 has with no disk.  Error 17 is Storage refused.

make -C v4 test and sanitize pass at both widths; hosted-check passes on
three ISAs; amd64, aarch64 and riscv64 boot, POST 538 of 538, with the
typed session: logs/20261007-081603, -081839, -082226.  The hashes are
the same on all six.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-07 08:24:47 -04:00

1551 lines
108 KiB
C
Raw Blame History

/* test_host_quit.c -- the prompt, executed on the host node.
*
* capsule/quit.v4 on top of the earlier layers: QUIT, ABORT, ABORT" and ." .
* For the first time the node is not handed a line: it is started at QUIT and
* left running, characters are fed to its console, and what it prints is
* read back. Nothing here calls INTERPRET or pokes TIB.
*
* A session is some lines of input and everything the node printed until it
* was waiting for more. The sessions marked v3 were piped through the v3
* binary on 2026-10-04 and the text is what v3 printed, less its colours and
* the time stamp and "ERROR: " its log puts before a message.
*
* Where v4 parts from v3 here:
* - QUIT is FORTH-79's: it stops the line, from inside any word, and says
* nothing. v3's goes on with the rest of the line, and cannot be
* compiled into a definition at all.
* - a line that fails while a definition is open ends the definition.
* v3 goes on compiling the lines that follow into it.
* - ABORT" at the prompt stops the line when its flag is true. v3 prints
* the text and carries on. Compiled into a word, v3's crashes (SIGSEGV).
* - LOAD goes on with the rest of its line afterwards, and there is BLK
* (both FORTH-79); v3's LOAD drops the rest of the line and it has no
* BLK. A block number that does not exist says so.
* - vocabularies are FORTH-79's: a word defined in one is found only when
* that vocabulary is CONTEXT, and FORTH is searched after it. v3 finds
* every word everywhere, and a word redefined in a vocabulary replaces
* FORTH's for good.
* - every error has a message (D-18), but v4's says what was wrong, not
* which word: "Control structure mismatch" where v3 says
* "LOOP: missing DO".
* - QUERY takes 80 characters (FORTH-79); v3's line is 255.
* - an address outside memory says so (D-14); v3 gives ERROR alone.
* - M/MOD by zero says so (D-15); v3 gives ERROR alone.
* - the host node's stacks hold 32 values and 32 return entries (D-17),
* and one more is an error (D-16). This file is written for whatever
* size it is built with. A stack fault names the stack,
* not the word: "Stack underflow" where v3 says "DROP: Stack underflow".
* - any fault empties the data stack; v3 keeps what the failing word had
* not taken.
* - PICK and ROLL count from one, as FORTH-79 has them: 1 PICK is DUP and
* 3 ROLL is ROT. v3's count from zero.
*/
#include "v4/text.h"
#include "v4/message.h"
#include "v4/testcode.h"
#include <stdint.h>
#include <stdio.h>
#include <string.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 CANARY ((v4_cell)0x0C0FFEE5)
#include "v4/blocks.h"
#include "block_subsystem.h"
#include "host_map.h"
static v4_node n;
static v4_exec_state es;
static v4_heat h;
static v4_text tx;
static v4_cell w_key, w_key_end, w_fault, capsule_latest;
static v4_cell w_idle; /* (IDLE): where the node waits for a message */
static char out[V4_CONSOLE_CAP + 1];
/* STORAGE (MESH.md section 8). The node asks its kernel for its blocks, and
* these tests are its kernel (kernel_serve): the blocks are the kernel's
* block subsystem (v3/src/block_subsystem.c). The chain is fast RAM,
* blocks 0 to 2047; a device of 64 blocks, 2048 to 2111; and after that a
* disk the subsystem has not been told it may format, which it reads and
* will not write. The RAM and the device are zeros at every switch-on.
* `disk` is where the chain keeps block 0, so disk + n * 1024 is block n of
* it for any n below 2048, as the chain itself holds it. */
#define DISK_BLOCKS 64u
#define RAM_BYTES ((size_t)BLK_RAM_BLOCKS * BLK_FORTH_SIZE)
#define REFUSING_BLOCKS 2048u /* room for the subsystem's own reserved device blocks and some of the node's */
#define REFUSING_FIRST "2112" /* its first block */
static unsigned char ram[RAM_BYTES], common_dev[DISK_BLOCKS * V4_BLOCK_BYTES], refusing_dev[REFUSING_BLOCKS * V4_BLOCK_BYTES];
#define disk (ram + (size_t)BLK_FORTH_SYS_RESERVED * BLK_FORTH_SIZE)
static unsigned long block_requests; /* how many the node has made */
extern void sf_time_init(void);
extern void log_set_level(int level);
extern size_t blkio_ram_state_size(void);
extern int blkio_ram_init_state(void *state_mem, size_t state_len, uint8_t *base, uint32_t total_blocks, uint32_t fbs, uint8_t read_only, void **out_opaque);
extern const blkio_vtable_t *blkio_ram_vtable(void);
/* The chain is made once: the subsystem keeps what it allocates. */
static int storage_made(void)
{
static blkio_dev_t dev;
static unsigned char state[256];
blkio_params_t params;
void *opaque = 0;
sf_time_init();
log_set_level(-1);
if (blkio_ram_state_size() > sizeof state) return 0;
if (blk_subsys_init(ram, sizeof ram) != BLK_OK || blk_subsys_add_raw_device(common_dev, DISK_BLOCKS) != BLK_OK) return 0;
if (blkio_ram_init_state(state, sizeof state, refusing_dev, REFUSING_BLOCKS, 0, 0, &opaque) != BLKIO_OK) return 0;
params.forth_block_size = 0; params.total_blocks = REFUSING_BLOCKS; params.opaque = opaque;
return blkio_open(&dev, blkio_ram_vtable(), &params) == BLKIO_OK && blk_subsys_attach_device(&dev) == BLK_OK;
}
/* A block holding `text`, the rest of it blanks. */
static void put_block(unsigned num, const char *text)
{
memset(disk + num * V4_BLOCK_BYTES, ' ', V4_BLOCK_BYTES);
memcpy(disk + num * V4_BLOCK_BYTES, text, strlen(text));
}
static long last_steps;
/* THE KERNEL. A node asks its kernel by writing to its port (node.h), and
* these tests are that too. Request 1 is "an entry has been made" ( xt -- )
* and request 2 "the entries from here up have gone" ( w -- ): the kernel's
* record of the words on the node (ENGINE.md 3b), kept here as the list of
* their xts. Any other request is noted and nothing is done. */
static v4_cell known[1024];
static unsigned known_n;
static v4_cell last_request;
static void kernel_serve(void)
{
last_request = n.request;
if (v4_blocks_serve(&n, n.request)) { block_requests++; return; } /* a block, as for any node (blocks.h) */
if (n.request == 1) {
v4_cell xt = v4_dstack_pop(&n.ds);
if (known_n < 1024) known[known_n++] = xt;
} else if (n.request == 2) {
v4_cell w = v4_dstack_pop(&n.ds);
unsigned i, kept = 0;
for (i = 0; i < known_n; i++) if (known[i] < w) known[kept++] = known[i];
known_n = kept;
}
}
/* Every entry on the node above the capsule's own, in every vocabulary:
* FORTH's list from LATEST, and each vocabulary's from its head. */
static unsigned node_words(v4_cell *out, unsigned max)
{
unsigned count = 0;
v4_cell xt, voc;
for (xt = n.mem[LATEST]; xt >= DICT_W; xt = n.mem[xt - 1]) if (count < max) out[count++] = xt;
for (voc = n.mem[VOC_LINK]; voc != 0; voc = n.mem[voc + 1])
for (xt = n.mem[voc]; xt >= DICT_W; xt = n.mem[xt - 1]) if (count < max) out[count++] = xt;
return count;
}
/* True if the kernel's record is exactly the words that are on the node. */
static int kernel_agrees(void)
{
static v4_cell there[1024];
unsigned count = node_words(there, 1024), i, k;
if (count != known_n) return 0;
for (i = 0; i < count; i++) {
for (k = 0; k < known_n && known[k] != there[i]; k++) { }
if (k == known_n) return 0;
}
return 1;
}
/* The name of the entry whose code is at xt, as the kernel reads it: the
* word before the link holds the word address of the counted name, its
* bytes four to a cell. */
static const char *node_name(v4_cell xt)
{
static char name[40];
v4_cell at = n.mem[xt - 2] * 4;
unsigned len, i;
len = (unsigned)(((v4_ucell)n.mem[at / 4] >> (8 * (at % 4))) & 0xFFu);
if (len > 31) len = 31;
for (i = 0; i < len; i++) {
v4_cell b = at + 1 + (v4_cell)i;
name[i] = (char)(((v4_ucell)n.mem[b / 4] >> (8 * (b % 4))) & 0xFFu);
}
name[len] = 0;
return name;
}
/* THE CONSOLE. A node is sent text as a message and sends back what it
* prints (MESH.md section 6); these tests are its console, on its port 1,
* and do what tools/hosted.c does: take what is typed a line at a time,
* send each line as a message, show what comes back, and say " ok" or
* " ERROR" and the next prompt. What is typed after a line is there for a
* word in it that reads the keyboard, and what such a word does not take is
* the next line. */
#define CONSOLE_PORT 1u
static char typed[8192]; /* typed and not yet taken */
static unsigned typed_len;
static int line_open; /* a line has been sent and has not ended */
static v4_message to_node, from_node; /* the message going in, and the one coming out */
static unsigned to_sent; /* how many words of to_node the node has taken */
static char shown[V4_CONSOLE_CAP]; /* what the node has printed since the console last looked */
static unsigned shown_len;
static int shown_dropped;
static int text_ended; /* how the text ended, when it has */
/* 1 if the node is where it waits for a message, with nothing given it. */
static int node_idle(void)
{
return n.reading && !n.given && n.read_port == V4_PORT_ANY && n.p > w_idle && n.p <= w_idle + 8; /* in the first words of (IDLE), where it reads */
}
/* Run until the text ends, or until it has been inside KEY with nothing to
* read for 64 instruction words; or until `max` words. 1: ended, 2: waiting
* for a character, 0: neither. */
static int run_line(long max)
{
long steps = 0;
unsigned idle = 0;
while (steps < max && idle < 64) {
(void)v4_exec_step_word(&n, &es, &h);
steps++;
if (n.asking && n.ask_port == 0) { kernel_serve(); v4_node_port_served(&n); continue; } /* a request */
if (n.asking && n.ask_port == CONSOLE_PORT) { /* a word of a message from the node */
v4_cell word = n.request;
v4_node_port_served(&n);
if (v4_message_word(&from_node, word)) {
unsigned i, chars = v4_message_length(&from_node);
if (v4_message_type(&from_node) == V4_MSG_OUTPUT) {
for (i = 0; i < chars; i++) {
if (shown_len < sizeof shown) shown[shown_len++] = v4_message_char(&from_node, i);
else shown_dropped = 1;
}
} else if (v4_message_type(&from_node) == V4_MSG_DONE) {
text_ended = (int)from_node.word[V4_MSG_HEADER];
from_node.count = 0;
last_steps = steps;
return 1;
}
from_node.count = 0;
}
continue;
}
if (n.reading && !n.given && to_sent < to_node.count && (n.read_port == CONSOLE_PORT || n.read_port == V4_PORT_ANY)) {
v4_node_port_give(&n, CONSOLE_PORT, to_node.word[to_sent++]); /* a word of the message to the node */
continue;
}
if (n.input_pos == n.input_len && n.p >= w_key && n.p < w_key_end) idle++; else idle = 0;
}
last_steps = steps;
return idle >= 64 ? 2 : 0;
}
/* A node just switched on: an empty dictionary above the capsule's words,
* `depth` marked cells and the canary on the data stack, started at QUIT. */
static void boot_with(unsigned depth)
{
unsigned i;
for (v4_cell k = DICT_W; k < DICT_END_W; k++) n.mem[k] = 0;
n.mem[DP] = DICT_W * 4;
n.mem[LATEST] = capsule_latest;
n.mem[STATE] = 0;
n.mem[CFP] = CFS_W;
n.mem[BASE] = 10;
n.mem[NODE_ERROR] = 0;
n.mem[BOOT_CELLS] = n.mem[DP];
n.mem[BOOT_CELLS + 1] = capsule_latest;
n.mem[FENCE] = DICT_W;
n.mem[LOG_LEVEL] = 2;
n.mem[ACL_HOOK] = 0;
for (v4_cell xt = capsule_latest; xt != 0; xt = n.mem[xt - 1]) n.mem[xt - 3] &= 31; /* the capsule's words: no access control fields set */
n.mem[CONTEXT] = LATEST;
n.mem[CURRENT] = LATEST;
n.mem[VOC_LINK] = 0;
n.mem[SRC] = TIB;
for (v4_cell k = BVARS; k < BVARS + 14; k++) if (k != SRC) n.mem[k] = 0; /* empty buffers, SCR and BLK 0, no hook */
memset(ram, 0, sizeof ram); memset(common_dev, 0, sizeof common_dev);
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
v4_node_fault_attach(&n, w_fault);
v4_node_error_attach(&n, NODE_ERROR);
v4_dstack_reset(&n.ds);
v4_rstack_reset(&n.rs);
v4_exec_reset(&es);
v4_heat_reset(&h);
for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
v4_dstack_push(&n.ds, CANARY);
v4_node_port_attach(&n, PORT);
v4_node_port_status(&n, 0, 1u | 1u << CONSOLE_PORT); /* the kernel and the console take what is written when it is written */
n.mem[WORD_DEFINED] = 0; /* no one is told of entries, until a test says so */
n.mem[WORD_FORGOTTEN] = 0;
known_n = 0;
last_request = 0;
n.mem[LINE_STATUS] = 1;
n.mem[ME] = 0; /* it has no number yet: a message to 0 is for it */
HOST_MESSAGES_EMPTY(&n);
n.mem[REPLY] = PORT + CONSOLE_PORT;
n.p = w_idle; /* waiting for a message */
typed_len = 0;
line_open = 0;
to_node.count = 0; to_sent = 0; from_node.count = 0;
shown_len = 0; shown_dropped = 0;
for (i = 0; i < 8 && !n.reading; i++) (void)v4_exec_step_word(&n, &es, &h); /* no message waits: it reads its ports, and is blocked */
}
static void boot(void) { boot_with(0); }
/* The same with nothing at all on the data stack. */
static void boot_bare(void)
{
boot();
v4_dstack_reset(&n.ds);
}
/* While the node waits for a character, EXPECT's own cells are on top of the
* data stack. Pop them: true if the canary is under no more than four. */
static int canary_under_expect(void)
{
unsigned k;
for (k = 0; k < 5; k++) if (v4_dstack_pop(&n.ds) == CANARY) return 1;
return 0;
}
/* Type `input` and return what the console then shows: what each line
* printed, the host's " ok" or " ERROR" after it, and the next prompt. A
* line that has not been ended shows nothing; nor does one that is waiting
* for a character. */
static const char *say(const char *input)
{
unsigned ilen = (unsigned)strlen(input), olen = 0;
if (typed_len + ilen > sizeof typed) return "(input queue full)";
memcpy(typed + typed_len, input, ilen);
typed_len += ilen;
out[0] = 0;
for (;;) {
const char *tail;
unsigned took;
int ended;
if (!line_open) {
char *nl = (char *)memchr(typed, '\n', typed_len);
unsigned len;
if (!nl) break;
len = (unsigned)(nl - typed);
if (!v4_message_text(&to_node, 0, 1, V4_MSG_TEXT, typed, len)) return "(line too long)";
to_sent = 0;
memmove(typed, nl + 1, typed_len - len - 1);
typed_len -= len + 1;
line_open = 1;
}
shown_len = 0; shown_dropped = 0;
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); /* empties the keyboard */
if (v4_node_console_feed(&n, typed, typed_len) != typed_len) return "(input queue full)";
ended = run_line(40000000);
took = n.input_pos; /* what a word in the line read */
memmove(typed, typed + took, typed_len - took);
typed_len -= took;
if (shown_dropped || olen + shown_len + 16 > sizeof out) return "(too much output)";
memcpy(out + olen, shown, shown_len);
olen += shown_len;
out[olen] = 0;
if (ended == 0) return "(still running)";
if (ended == 2) break;
line_open = 0;
tail = text_ended == V4_TEXT_COMPLETED ? " ok\nok> " : text_ended == V4_TEXT_ERROR ? " ERROR\nok> " : "ok> ";
memcpy(out + olen, tail, strlen(tail) + 1);
olen += (unsigned)strlen(tail);
}
return out;
}
/* Feed a file of FORTH source to the prompt, a line at a time, as if typed.
* True if every line was accepted: the node said " ok" and nothing else. */
static int load_source(const char *name)
{
char path[512], line[160];
FILE *f;
unsigned num = 0;
snprintf(path, sizeof path, "%s/%s", V4_CAPSULE_DIR, name);
f = fopen(path, "r");
if (!f) { printf(" cannot open %s\n", path); return 0; }
while (fgets(line, sizeof line, f)) {
size_t len = strlen(line);
num++;
if (len == 0 || line[len - 1] != '\n' || len > 80) { printf(" %s line %u: too long\n", name, num); fclose(f); return 0; }
(void)say(line);
/* every line is accepted: whatever it printed, it ended with " ok" and never with ERROR */
if (strlen(out) < 9 || strcmp(out + strlen(out) - 9, "\n ok\nok> ") != 0 || strstr(out, " ERROR\n")) {
if (strcmp(out, " ok\nok> ") != 0) { printf(" %s line %u: %s", name, num, line); printf(" -> "); fputs(out, stdout); printf("\n"); fclose(f); return 0; }
}
}
fclose(f);
return n.mem[STATE] == 0;
}
/* What the editor's L prints for a screen of blanks. */
static const char *blank_screen(int num)
{
static char text[2048];
size_t at = (size_t)snprintf(text, sizeof text, "Screen %d:\n", num);
for (unsigned k = 0; k < 16; k++) at += (size_t)snprintf(text + at, sizeof text - at, "%2u: %-64s\n", k, "");
snprintf(text + at, sizeof text - at, " ok\nok> ");
return text;
}
static void show(const char *label, const char *s)
{
printf(" %s\"", label);
for (; *s; s++) if (*s == '\n') printf("\\n"); else putchar(*s);
printf("\"\n");
}
static int is(const char *got, const char *want)
{
if (strcmp(got, want) == 0) return 1;
show("got: ", got);
show("wanted: ", want);
return 0;
}
/* What v3 prints starts with its first prompt; the node's first prompt is
* printed at switch-on, before the input, so a v4 session lacks the leading
* "ok> " and is otherwise the same. */
typedef struct { const char *in, *want; int v3; } transcript;
static const transcript script[] = {
{ "65 EMIT\n", "A ok\nok> ", 1 },
{ "\n \n", " ok\nok> ok\nok> ", 1 },
{ ": HI .\" Hello\" ; HI\n", "Hello ok\nok> ", 1 },
{ "NOSUCH\n66 EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> B ok\nok> ", 1 },
{ "1 2 NOSUCH 3 4\n+ 48 + EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 3 ok\nok> ", 1 },
{ ": T 67 EMIT ABORT 68 EMIT ; T 70 EMIT\n69 EMIT\n", "C ok\nok> E ok\nok> ", 1 },
{ ": M 70 EMIT\n71 EMIT ;\nM\n", " ok\nok> ok\nok> FG ok\nok> ", 1 },
{ "IF\n72 EMIT\n", "IF: compile-only\n ERROR\nok> H ok\nok> ", 1 },
{ ".\" hi there\"\n", "hi there ok\nok> ", 1 },
{ "1 2 3\n+ + 48 + EMIT\n", " ok\nok> 6 ok\nok> ", 1 },
{ ": T .\" A\" .\" B\" CR .\" C\" ; T\n", "AB\nC ok\nok> ", 1 },
{ ": T1 ABORT ; : T2 T1 66 EMIT ; : T3 65 EMIT T2 67 EMIT ; T3\n68 EMIT\n", "A ok\nok> D ok\nok> ", 1 },
{ "0 ABORT\" not\" 65 EMIT\n", "A ok\nok> ", 1 },
{ ": P .\" two spaces \" 124 EMIT ; P\n", " two spaces | ok\nok> ", 1 },
{ "65 EMIT CR 66 EMIT\n", "A\nB ok\nok> ", 1 },
{ ": E .\" \" 65 EMIT ; E\n", "A ok\nok> ", 1 },
{ "65 EMIT 1 0 / 66 EMIT\n67 EMIT\n", "A/: Division by zero\n ERROR\nok> C ok\nok> ", 1 },
{ "1 0 MOD\n", "MOD: Division by zero\n ERROR\nok> ", 1 },
{ "1 0 /MOD\n", "/MOD: Division by zero\n ERROR\nok> ", 1 },
{ "1 1 0 */\n", "*/: Division by zero\n ERROR\nok> ", 1 },
{ "1 1 0 */MOD\n", "*/MOD: Division by zero\n ERROR\nok> ", 1 },
{ ": T 1 0 / 65 EMIT ; T 66 EMIT\n67 EMIT\n", "/: Division by zero\n ERROR\nok> C ok\nok> ", 1 },
{ "0 0 /\n7 2 / 48 + EMIT\n", "/: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "DEPTH 48 + EMIT 5 6 DEPTH 48 + EMIT\n", "02 ok\nok> ", 1 },
{ "1 2 3 NOSUCH\nDEPTH 48 + EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 3 ok\nok> ", 1 },
{ "5 6 7 1 0 MOD\nDEPTH 48 + EMIT\n", "MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "5 6 7 1 1 0 */MOD\nDEPTH 48 + EMIT\n", "*/MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "1 2 3 ABORT\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 1 },
{ "1 2 3 . . .\n", "3 2 1 ok\nok> ", 1 },
{ "-5 . 0 . 2147483647 .\n", "-5 0 2147483647 ok\nok> ", 1 },
{ "1 2 3 .S\n", "<3> 1 2 3 \n ok\nok> ", 1 },
{ ".S\n", "<0> \n ok\nok> ", 1 },
{ "1 2 3 .S . . .\n", "<3> 1 2 3 \n3 2 1 ok\nok> ", 1 },
{ "7 5 U.R 124 EMIT\n", " 7| ok\nok> ", 0 },
{ "HEX FF . DECIMAL 255 .\n", "FF 255 ok\nok> ", 1 },
{ "255 HEX . DECIMAL\n", "FF ok\nok> ", 1 },
{ "255 OCTAL . DECIMAL\n", "377 ok\nok> ", 1 },
{ "VARIABLE X 42 X ! X ?\n", "42 ok\nok> ", 1 },
{ "3 SPACES 65 EMIT 0 SPACES 66 EMIT -2 SPACES 67 EMIT\n", " ABC ok\nok> ", 1 },
{ "2 BASE ! 5 . DECIMAL\n", "UNKNOWN WORD: '5'\n ERROR\nok> ", 1 },
{ ": T 10 0 DO I . LOOP ; T\n", "0 1 2 3 4 5 6 7 8 9 ok\nok> ", 1 },
{ "DEPTH . 1 2 DEPTH . . .\n", "0 2 2 1 ok\nok> ", 1 },
/* qmath.v4: every result printed by Q.PRINT, which shows all sixteen bits of the fraction */
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "1.00000 ok\nok> ", 1 },
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.00000 ok\nok> ", 1 },
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.00000 ok\nok> ", 1 },
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "2.71823 ok\nok> ", 1 },
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.84147 ok\nok> ", 1 },
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.54028 ok\nok> ", 1 },
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "2.00000 ok\nok> ", 1 },
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.41424 ok\nok> ", 1 },
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.69314 ok\nok> ", 1 },
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "7.38894 ok\nok> ", 1 },
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.90930 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.PRINT\n", "1.50000 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.22473 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.40550 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "4.48153 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.99748 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.07073 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.PRINT\n", "0.33332 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.57733 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.39553 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.32719 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.94496 ok\nok> ", 1 },
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.PRINT\n", "1.75000 ok\nok> ", 1 },
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.32298 ok\nok> ", 1 },
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.55966 ok\nok> ", 1 },
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "5.75444 ok\nok> ", 1 },
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.98399 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "10.00000 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.16235 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.30261 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "12842.30421 ok\nok> ", 1 },
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.PRINT\n", "3.14285 ok\nok> ", 1 },
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.77279 ok\nok> ", 1 },
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "1.14517 ok\nok> ", 1 },
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "23.15980 ok\nok> ", 1 },
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.PRINT\n", "0.00999 ok\nok> ", 1 },
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.09996 ok\nok> ", 1 },
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.01004 ok\nok> ", 1 },
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.00999 ok\nok> ", 1 },
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.99995 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ Q.PRINT\n", "15.93750 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.99217 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.76870 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.PRINT\n", "333.33332 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "18.25744 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "5.80915 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.31947 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.94760 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.PRINT\n", "0.62500 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.79055 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.86820 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.58511 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.81095 ok\nok> ", 1 },
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "9.00000 ok\nok> ", 1 },
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.00003 ok\nok> ", 1 },
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.19726 ok\nok> ", 1 },
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "5720.68249 ok\nok> ", 1 },
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.41204 ok\nok> ", 1 },
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "15.00000 ok\nok> ", 1 },
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.87297 ok\nok> ", 1 },
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.70808 ok\nok> ", 1 },
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "387262.21916 ok\nok> ", 1 },
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.65025 ok\nok> ", 1 },
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.PRINT\n", "0.14285 ok\nok> ", 1 },
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.37799 ok\nok> ", 1 },
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.15351 ok\nok> ", 1 },
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.14237 ok\nok> ", 1 },
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.98982 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.* Q.PRINT\n", "2.62500 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "3.25000 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q./ Q.PRINT\n", "0.85713 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "1.75000 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "1.50000 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.< .\n", "-1 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.* Q.PRINT\n", "0.99998 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "3.33332 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q./ Q.PRINT\n", "0.11109 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "3.00000 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "0.33332 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.< .\n", "-1 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.* Q.PRINT\n", "50.08920 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "19.08035 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q./ Q.PRINT\n", "5.07102 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "15.93750 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "3.14285 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.> .\n", "-1 ok\nok> ", 1 },
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.* Q.PRINT\n", "3.33149 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "333.34332 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q./ Q.PRINT\n", "33351.65342 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "333.33332 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "0.00999 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.> .\n", "-1 ok\nok> ", 1 },
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.* Q.PRINT\n", "0.39062 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "1.25000 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q./ Q.PRINT\n", "1.00000 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "0.62500 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "0.62500 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.= .\n", "-1 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.* Q.PRINT\n", "100.00000 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "20.00000 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q./ Q.PRINT\n", "1.00000 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "10.00000 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "10.00000 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.= .\n", "-1 ok\nok> ", 1 },
{ "Q.1 Q.PRINT Q.0 Q.PRINT Q.SCALE Q.PRINT\n", "1.00000 0.00000 1.00000 ok\nok> ", 1 },
{ "7 Q.FROM-INT 2 Q.FROM-INT Q./ Q.TO-INT . 100 Q.FROM-INT Q.TO-INT .\n", "3 100 ok\nok> ", 1 },
{ "Q.0 Q.0= . Q.1 Q.0= . Q.0 Q.SQRT Q.PRINT Q.1 Q.SQRT Q.PRINT Q.0 Q.EXP Q.PRINT\n", "-1 0 0.00000 1.00000 1.00000 ok\nok> ", 1 },
{ "5 Q.FROM-INT 3 Q.FROM-INT Q.- Q.PRINT Q.1 Q.ABS Q.PRINT\n", "2.00000 1.00000 ok\nok> ", 1 },
{ "HEX 10 Q.FROM-INT Q.PRINT 10 . DECIMAL\n", "16.00000 10 ok\nok> ", 1 },
{ "20 Q.FROM-INT Q.EXP Q.0= . Q.1 Q.LOG Q.PRINT\n", "0 0.00000 ok\nok> ", 1 },
/* v4's own: signed values (D-8), which v3 prints as large unsigned numbers, and the errors */
{ "-3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.PRINT -7 Q.FROM-INT Q.PRINT\n", "-1.50000 -7.00000 ok\nok> ", 0 },
{ "3 Q.FROM-INT -2 Q.FROM-INT Q.* Q.PRINT -3 Q.FROM-INT -2 Q.FROM-INT Q.* Q.PRINT\n", "-6.00000 6.00000 ok\nok> ", 0 },
{ "-5 Q.FROM-INT Q.ABS Q.PRINT 5 Q.FROM-INT Q.NEG Q.PRINT\n", "5.00000 -5.00000 ok\nok> ", 0 },
{ "-1 Q.FROM-INT Q.1 Q.< . -1 Q.FROM-INT Q.1 Q.MAX Q.PRINT\n-1 Q.FROM-INT Q.1 Q.MIN Q.PRINT\n", "-1 1.00000 ok\nok> -1.00000 ok\nok> ", 0 },
{ "-1 Q.FROM-INT Q.EXP Q.PRINT -3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.TO-INT .\n", "0.36787 -2 ok\nok> ", 0 },
{ "4 Q.FROM-INT Q.SIN Q.PRINT 2 Q.FROM-INT Q.COS Q.PRINT\n-1 Q.FROM-INT Q.SIN Q.PRINT\n", "-0.75680 -0.41615 ok\nok> -0.84147 ok\nok> ", 0 },
{ "1 Q.FROM-INT 2 Q.FROM-INT Q./ Q.LOG Q.PRINT\n", "-0.69314 ok\nok> ", 0 },
{ "-1 Q.FROM-INT 3 Q.FROM-INT Q./ -1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.* . .\n", "0 3120 ok\nok> ", 0 },
{ "-4 Q.FROM-INT Q.SIN . . 4 Q.FROM-INT Q.COS . .\n", "0 49598 -1 -42838 ok\nok> ", 0 },
{ "Q.0 Q.0 Q./ 65 EMIT\nDEPTH .\n", "Division by zero\n ERROR\nok> 2 ok\nok> ", 0 },
{ "7 Q.1 Q.0 Q./ 65 EMIT\nDEPTH .\n", "Division by zero\n ERROR\nok> 3 ok\nok> ", 0 },
{ "7 -4 Q.FROM-INT Q.SQRT 65 EMIT\nDEPTH . . . .\n", "Argument out of range\n ERROR\nok> 3 0 0 7 ok\nok> ", 0 },
{ "Q.0 Q.LOG 65 EMIT\n-1 Q.FROM-INT Q.LOG\n", "Argument out of range\n ERROR\nok> Argument out of range\n ERROR\nok> ", 0 },
{ "7 PAD -1 DUMP 65 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ "PAD 0 DUMP\n", " ok\nok> ", 1 },
/* acl.v4: the fields of an entry, and the check, as v3 */
{ ": FOO 65 EMIT ; ' FOO ACL-MODE@ . ' FOO ACL-TTL@ . ' FOO ACL-ALLOW@ .\n' FOO ACL-PINNED? .\n", "0 0 -1 ok\nok> 0 ok\nok> ", 1 },
{ ": FOO 65 EMIT ; 1 ' FOO ACL-MODE! 77 ' FOO ACL-TTL! ' FOO ACL-MODE@ .\n' FOO ACL-TTL@ . FOO ' FOO ACL-TTL@ .\n", "1 ok\nok> 77 A76 ok\nok> ", 1 },
{ ": FOO 65 EMIT ; ' FOO ACL-PIN ' FOO ACL-PINNED? . 5 ' FOO ACL-TTL!\n0 ' FOO ACL-ALLOW! 1 ' FOO ACL-MODE!\n' FOO ACL-TTL@ . ' FOO ACL-ALLOW@ . ' FOO ACL-MODE@ .\n",
"-1 ok\nok> ok\nok> 0 -1 0 ok\nok> ", 1 },
{ ": A 1 ; : B 2 ; 1 ' A ACL-MODE! ' A ACL-PIN ' B ACL-PIN ' A ' B ACL-INHERIT\n' B ACL-MODE@ . ' B ACL-PINNED? . ' B ACL-TTL@ . ' B ACL-ALLOW@ .\n",
" ok\nok> 1 0 0 -1 ok\nok> ", 1 },
{ "-5 ' DUP ACL-TTL! ' DUP ACL-TTL@ . 3 ' DUP ACL-MODE! ' DUP ACL-MODE@ .\n", "0 3 ok\nok> ", 1 },
{ "' DUP ACL-TTL@ . ' DUP ACL-MODE@ . ' DUP ACL-ALLOW@ . ' DUP ACL-PINNED? .\n", "0 0 -1 0 ok\nok> ", 1 },
{ ": FOO 65 EMIT ; 5 ' FOO ACL-TTL! 0 ' FOO ACL-ALLOW! 1 2 FOO 66 EMIT\n.S ' FOO ACL-TTL@ .\n",
"\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> <0> \n4 ok\nok> ", 1 },
/* v4's own: the TTL is sixteen bits; a denied word cannot be compiled; with no policy a recheck allows */
{ ": BAZ 67 EMIT ; 0 ' BAZ ACL-ALLOW! BAZ ' BAZ ACL-TTL@ . ' BAZ ACL-ALLOW@ .\n", "C65535 -1 ok\nok> ", 0 },
{ ": FOO 65 EMIT ; 5 ' FOO ACL-TTL! 0 ' FOO ACL-ALLOW! : BAR FOO ; 66 EMIT\nBAR\n' FOO ACL-TTL@ .\n",
"\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> UNKNOWN WORD: 'BAR'\n ERROR\nok> 4 ok\nok> ", 0 },
{ ": FOO 65 EMIT ; : BAR FOO ; 5 ' FOO ACL-TTL! 0 ' FOO ACL-ALLOW! BAR\n", "A ok\nok> ", 0 },
{ "99999 ' DUP ACL-TTL! ' DUP ACL-TTL@ . 65535 ' DUP ACL-TTL! ' DUP ACL-TTL@ .\n", "65535 65535 ok\nok> ", 0 },
{ "258 ' DUP ACL-MODE! ' DUP ACL-MODE@ . 0 ' DUP ACL-ALLOW! ' DUP ACL-ALLOW@ .\n7 ' DUP ACL-ALLOW! ' DUP ACL-ALLOW@ . ' DUP ACL-TTL@ .\n", "2 0 ok\nok> -1 0 ok\nok> ", 0 },
{ "7 0 ACL-MODE@ 65 EMIT\n0 ACL-PIN\n1 0 ACL-TTL!\n.S\n", "Not a word\n ERROR\nok> Not a word\n ERROR\nok> Not a word\n ERROR\nok> <2> 7 1 \n ok\nok> ", 0 },
{ ": W1 ; ' W1 ACL-WORD-ID ' W1 = . ' W1 ACL-HEAT@ .\n", "-1 0 ok\nok> ", 0 },
{ ": IM 65 EMIT ; IMMEDIATE 3 ' IM ACL-TTL! 0 ' IM ACL-ALLOW! : U IM ;\n", "\033[33mWARN: \033[0mACL: denied 'IM'\n ERROR\nok> ", 0 },
{ ": P1 ; : P2 ; VOCABULARY VV VV DEFINITIONS : P3 ; FORTH DEFINITIONS\n9 ' P1 ACL-TTL! 1 ' P2 ACL-MODE! ' P2 ACL-PIN VV 9 ' P3 ACL-TTL!\nACL-INIT-PRIMITIVES ' P1 ACL-TTL@ . ' P2 ACL-MODE@ . ' P3 ACL-TTL@ . FORTH\n",
" ok\nok> ok\nok> 0 1 0 ok\nok> ", 0 },
/* log.v4: v3's lines, colours and all, without its time of day */
{ "LOG-LEVEL@ . LOG-ERROR . LOG-WARN . LOG-INFO . LOG-TEST . LOG-DEBUG .\n",
"2 0 1 2 3 4 ok\nok> ", 1 },
{ "LOG-INFO\" hello info\"\nLOG-WARN\" careful\"\nLOG-ERROR\" bad\"\nLOG-DEBUG\" dbg\"\nLOG-TEST\" tst\"\n",
"\033[32mINFO: \033[0mhello info\n ok\nok> \033[33mWARN: \033[0mcareful\n ok\nok> \033[31mERROR: \033[0mbad\n ok\nok> ok\nok> ok\nok> ", 1 },
{ ": T LOG-INFO\" from a word\" 65 EMIT ; T\n",
"\033[32mINFO: \033[0mfrom a word\nA ok\nok> ", 1 },
{ "S\" a string\" LOG-INFO-STR\nS\" w\" LOG-WARN-STR S\" e\" LOG-ERROR-STR\nS\" d\" LOG-DEBUG-STR S\" t\" LOG-TEST-STR\n",
"\033[32mINFO: \033[0ma string\n ok\nok> \033[33mWARN: \033[0mw\n\033[31mERROR: \033[0me\n ok\nok> ok\nok> ", 1 },
{ "0 LOG-LEVEL! LOG-LEVEL@ . LOG-ERROR\" e0\" LOG-WARN\" w0\"\n",
/* v3 prints the 0 after the message: its log goes to stderr at once and its numbers to stdout when the line ends */
"0 \033[31mERROR: \033[0me0\n ok\nok> ", 0 },
{ "99 LOG-LEVEL! LOG-LEVEL@ . 4 LOG-LEVEL! LOG-DEBUG\" d\" 5 LOG-LEVEL! LOG-LEVEL@ .\n", "4 \033[34mDEBUG: \033[0md\n4 ok\nok> ", 0 },
{ "7 S\" abc\" LOG-DEBUG-STR 8 PAD -1 LOG-DEBUG-STR .S\n", "<2> 7 8 \n ok\nok> ", 0 },
{ "7 PAD -1 LOG-ERROR-STR 65 EMIT\n.S\n", "\033[31mERROR: \033[0mNegative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ "LOG-WARN\" no closing quote\n", "\033[33mWARN: \033[0mno closing quote\n ok\nok> ", 0 },
{ ": L3 LOG-INFO\" abcd\" 65 EMIT LOG-DEBUG\" hidden\" 66 EMIT ; L3 .S\n", "\033[32mINFO: \033[0mabcd\nAB<0> \n ok\nok> ", 0 },
{ "(LOG\")\n", "(LOG\"): compile-only\n ERROR\nok> ", 0 },
{ "1 LOG-LEVEL! LOG-ERROR\" e1\" LOG-WARN\" w1\" LOG-INFO\" i1\"\n",
"\033[31mERROR: \033[0me1\n\033[33mWARN: \033[0mw1\n ok\nok> ", 1 },
{ "2 LOG-LEVEL! LOG-ERROR\" e2\" LOG-WARN\" w2\" LOG-INFO\" i2\" LOG-TEST\" t2\"\n",
"\033[31mERROR: \033[0me2\n\033[33mWARN: \033[0mw2\n\033[32mINFO: \033[0mi2\n ok\nok> ", 1 },
{ "3 LOG-LEVEL! LOG-INFO\" i3\" LOG-TEST\" t3\" LOG-DEBUG\" d3\"\n",
"\033[32mINFO: \033[0mi3\n\033[35mTEST: \033[0mt3\n ok\nok> ", 1 },
{ "-1 LOG-LEVEL! LOG-LEVEL@ .\n",
"0 ok\nok> ", 1 },
{ "LOG-INFO\" \"\n",
"\033[32mINFO: \033[0m\n ok\nok> ", 1 },
{ ": W LOG-ERROR\" e\" LOG-WARN\" w\" LOG-TEST\" t\" ; W 3 LOG-LEVEL! W\n",
"\033[31mERROR: \033[0me\n\033[33mWARN: \033[0mw\n\033[31mERROR: \033[0me\n\033[33mWARN: \033[0mw\n\033[35mTEST: \033[0mt\n ok\nok> ", 1 },
/* blocks.v4 */
{ "20 BLOCK 1024 BLANK 65 20 BLOCK C! UPDATE SAVE-BUFFERS 20 BLOCK C@ .\n",
"65 ok\nok> ", 1 },
{ "20 BLOCK 1024 BLANK 20 BLOCK 16 65 FILL UPDATE 20 LIST\nSCR @ .\n",
"\nBlock 20\n00: AAAAAAAAAAAAAAAA \n01: \n02: \n03: \n04: \n05: \n06: \n07: \n08: \n09: \n10: \n11: \n12: \n13: \n14: \n15: \n\n ok\nok> 20 ok\nok> ", 1 },
{ "30 BLOCK 1024 BLANK S\" 65 EMIT 66 EMIT\" 30 BLOCK SWAP CMOVE UPDATE 30 LOAD\n",
"AB ok\nok> ", 1 },
{ "30 BLOCK 1024 BLANK S\" 65 EMIT -->\" 30 BLOCK SWAP CMOVE UPDATE\n31 BLOCK 1024 BLANK S\" 66 EMIT\" 31 BLOCK SWAP CMOVE UPDATE 30 LOAD\n",
" ok\nok> AB ok\nok> ", 1 },
{ "30 BLOCK 1024 BLANK S\" 65 EMIT\" 30 BLOCK SWAP CMOVE UPDATE\n31 BLOCK 1024 BLANK S\" 66 EMIT\" 31 BLOCK SWAP CMOVE UPDATE 30 31 THRU\n",
" ok\nok> AB ok\nok> ", 1 },
{ "30 BLOCK 1024 BLANK S\" : SQ DUP * ;\" 30 BLOCK SWAP CMOVE UPDATE 30 LOAD\n7 SQ .\n",
" ok\nok> 49 ok\nok> ", 1 },
{ "30 BLOCK 1024 BLANK S\" 1 2 NOSUCH 3\" 30 BLOCK SWAP CMOVE UPDATE 30 LOAD\n.S\n",
"UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> <2> 1 2 \n ok\nok> ", 1 },
{ "20 BLOCK 16 65 FILL EMPTY-BUFFERS 20 BLOCK C@ .\n",
"0 ok\nok> ", 1 },
{ "20 BLOCK 1024 66 FILL UPDATE FLUSH 20 BLOCK C@ .\n",
"66 ok\nok> ", 1 },
{ "20 BLOCK 1024 BLANK 66 20 BLOCK C! UPDATE 21 BLOCK DROP 22 BLOCK DROP\n20 BLOCK C@ .\n",
" ok\nok> 66 ok\nok> ", 1 },
/* CASE, ['], S", FORGET */
{ ": C1 CASE 1 OF 65 EMIT ENDOF 2 OF 66 EMIT ENDOF 67 EMIT ENDCASE ;\n1 C1 2 C1 3 C1\n.S\n", " ok\nok> ABC ok\nok> <0> \n ok\nok> ", 1 },
{ ": C2 CASE 1 OF 10 ENDOF 2 OF 20 ENDOF DUP 100 + SWAP ENDCASE ;\n1 C2 . 2 C2 . 7 C2 .\n.S\n", " ok\nok> 10 20 107 ok\nok> <0> \n ok\nok> ", 1 },
{ ": C3 CASE ENDCASE ; 5 C3 .S\n", "<0> \n ok\nok> ", 1 },
{ ": T1 11 ; : T2 ['] T1 EXECUTE ; T2 .\n", "11 ok\nok> ", 1 },
{ ": S1 S\" hello\" TYPE ; S1\n", "hello ok\nok> ", 1 },
{ ": S2 S\" abc\" ; S2 . DROP .S\n", "3 <0> \n ok\nok> ", 1 },
{ "S\" xyz\" TYPE\n", "xyz ok\nok> ", 1 },
{ ": A1 1 ; : A2 2 ; : A3 3 ; FORGET A2 A1 .\nA3\nA2\n", "1 ok\nok> UNKNOWN WORD: 'A3'\n ERROR\nok> UNKNOWN WORD: 'A2'\n ERROR\nok> ", 1 },
{ ": L1 [ 5 ] [LITERAL] ; L1 .\n", "5 ok\nok> ", 1 },
{ "CASE\n", "CASE: compile-only\n ERROR\nok> ", 1 },
/* v4's own */
{ ": C4 CASE 1 OF 65 EMIT ENDCASE ;\n: C5 1 OF ;\n: C6 CASE ENDOF ;\n: C7 ENDCASE ;\n",
"Control structure mismatch\n ERROR\nok> Control structure mismatch\n ERROR\nok> Control structure mismatch\n ERROR\nok> "
"Control structure mismatch\n ERROR\nok> ", 0 },
{ "7 FORGET DUP 65 EMIT\nFORGET NOSUCH\nDUP . .\n", "Protected word\n ERROR\nok> UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 7 7 ok\nok> ", 0 },
{ ": S3 S\" \" SWAP DROP . S\" ab\" S\" cde\" TYPE TYPE ; S3\n", "0 cdeab ok\nok> ", 0 },
{ ": T3 ['] NOSUCH ;\n['] DUP\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> [']: compile-only\n ERROR\nok> ", 0 },
/* words.v4 */
{ "1 2 3 4 2SWAP . . . .\n", "2 1 4 3 ok\nok> ", 1 },
{ "1 2 3 4 2OVER . . . . . .\n", "2 1 4 3 2 1 ok\nok> ", 1 },
{ "1 2 3 4 5 6 2ROT . . . . . .\n", "2 1 6 5 4 3 ok\nok> ", 1 },
{ ": T 1 2 2>R 2R@ 2R> . . . . ; T\n", "2 1 2 1 ok\nok> ", 1 },
{ "TRUE . FALSE . 5 INVERT . NOP\n", "-1 0 -6 ok\nok> ", 1 },
{ "VARIABLE X 0 , 11 22 X 2! X 2@ . . X @ .\n", "22 11 11 ok\nok> ", 1 },
{ "VARIABLE Y 10 Y ! 3 Y -! Y @ .\n", "7 ok\nok> ", 1 },
{ "0 0<> . 5 0<> . -5 0<> .\n", "0 -1 -1 ok\nok> ", 1 },
{ "0 0> . 5 0> . -5 0> .\n", "0 -1 0 ok\nok> ", 1 },
{ "1 2 <> . 2 2 <> .\n", "-1 0 ok\nok> ", 1 },
{ "1 2 <= . 2 2 <= . 3 2 <= .\n", "-1 -1 0 ok\nok> ", 1 },
{ "1 2 >= . 2 2 >= . 3 2 >= .\n", "0 -1 -1 ok\nok> ", 1 },
{ "1 2 U< . 2 1 U< . -1 1 U< . 1 -1 U< . 3 3 U< .\n", "-1 0 0 -1 0 ok\nok> ", 1 },
{ "1 2 U> . -1 1 U> . 1 -1 U> .\n", "0 -1 0 ok\nok> ", 1 },
{ "-5 ABS . 5 ABS . 0 ABS .\n", "5 5 0 ok\nok> ", 1 },
{ "3 9 MAX . -3 -9 MAX . 3 9 MIN . -3 -9 MIN .\n", "9 -3 3 -9 ok\nok> ", 1 },
{ "5 0 9 WITHIN . 9 0 9 WITHIN . 0 0 9 WITHIN . 5 9 0 WITHIN . -1 0 9 WITHIN .\n", "-1 0 -1 0 0 ok\nok> ", 1 },
{ "1 4 LSHIFT . 3 0 LSHIFT . 256 4 RSHIFT . 1 1 RSHIFT .\n", "16 3 16 0 ok\nok> ", 1 },
{ "5 0 3 0 D- . . 3 0 5 0 D- . .\n", "0 2 -1 -2 ok\nok> ", 1 },
{ "-5 -1 DABS . . 5 0 DABS . .\n", "0 5 0 5 ok\nok> ", 1 },
{ "0 0 D0= . 1 0 D0= . 0 1 D0= .\n", "-1 0 0 ok\nok> ", 1 },
{ "-1 -1 D0< . 5 0 D0< .\n", "-1 0 ok\nok> ", 1 },
{ "5 0 5 0 D= . 5 0 6 0 D= . 5 0 5 1 D= .\n", "-1 0 0 ok\nok> ", 1 },
{ "3 0 D2* . . -1 0 D2* . .\n", "0 6 1 -2 ok\nok> ", 1 },
{ "6 0 D2/ . . -6 -1 D2/ . .\n", "0 3 -1 -3 ok\nok> ", 1 },
{ "1 0 2 0 D< . 2 0 1 0 D< . -1 -1 0 0 D< . 5 0 5 0 D< .\n", "-1 0 -1 0 ok\nok> ", 1 },
{ "1 0 2 0 DMAX . . 1 0 2 0 DMIN . . -1 -1 3 0 DMAX . . -1 -1 3 0 DMIN . .\n", "0 2 0 1 0 3 -1 -1 ok\nok> ", 1 },
{ "PAD 8 65 FILL PAD 4 + C@ . PAD 7 + C@ .\n", "65 65 ok\nok> ", 1 },
{ "PAD 8 65 FILL PAD 4 ERASE PAD C@ . PAD 4 + C@ .\n", "0 65 ok\nok> ", 1 },
{ "PAD 8 65 FILL PAD 2 + 3 BLANK PAD 8 TYPE 124 EMIT\n", "AA AAA| ok\nok> ", 1 },
{ "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 16 -TRAILING . PAD - .\n", " ok\nok> 3 0 ok\nok> ", 1 },
{ "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 3 PAD 3 COMPARE . PAD 3 PAD 2 COMPARE . PAD 2 PAD 3 COMPARE .\nPAD 3 PAD 1+ 2 COMPARE .\n", " ok\nok> 0 1 -1 ok\nok> -1 ok\nok> ", 1 },
{ "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 16 98 SCAN . PAD - . PAD 16 97 SKIP . PAD - . PAD 16 122 SCAN . PAD - .\n", " ok\nok> 15 1 15 1 0 16 ok\nok> ", 1 },
{ "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 16 PAD 1+ 2 SEARCH . . PAD - .\n122 PAD 20 + C! PAD 16 PAD 20 + 1 SEARCH . . PAD - .\n", " ok\nok> -1 15 1 ok\nok> 0 16 0 ok\nok> ", 1 },
{ "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD PAD 1+ 3 CMOVE> PAD 4 TYPE 124 EMIT\n", " ok\nok> aabc| ok\nok> ", 1 },
{ "PAD 0 65 FILL PAD 0 -TRAILING . DROP PAD 0 PAD 0 COMPARE .\n", "0 0 ok\nok> ", 1 },
/* v4's own: FORTH-79's MOVE and the standard order for M- (v3's differ), and the errors */
{ "VARIABLE A 1 , 2 , VARIABLE B 0 , 0 , 5 A ! A B 3 MOVE B @ . B 1+ @ . B 2+ @ .\n", "5 1 2 ok\nok> ", 0 },
{ "VARIABLE A 7 A ! A A 0 MOVE A A -3 MOVE A @ .\n", "7 ok\nok> ", 0 },
{ "5 0 3 M- . . 5 0 -7 M- . . 0 0 1 M- . .\n", "0 2 0 12 -1 -1 ok\nok> ", 0 },
{ "5 0 3 M+ . . 5 0 -7 M+ . .\n", "0 8 -1 -2 ok\nok> ", 0 },
{ "0 -1 D0< . -1 0 D0< .\n", "-1 0 ok\nok> ", 0 },
{ "?TERMINAL . 65 EMIT\n?TERMINAL .\n", "-1 A ok\nok> 0 ok\nok> ", 0 },
{ "7 1 -1 LSHIFT 65 EMIT\n.S\n", "Shift count out of range\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ "7 1 -1 RSHIFT 65 EMIT\n.S\n", "Shift count out of range\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ "7 PAD -1 65 FILL 66 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ "7 PAD PAD -1 CMOVE> 66 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ "PAD 4 65 FILL PAD -5 -TRAILING . DROP PAD -1 PAD -1 COMPARE .\nPAD -3 65 SCAN . DROP\n", "0 0 ok\nok> 0 ok\nok> ", 0 },
/* v4's own */
{ "5 3 .R 124 EMIT -5 6 .R 124 EMIT 12345 2 .R 124 EMIT\n", " 5| -5|12345| ok\nok> ", 0 },
{ "1234 0 <# # # #S #> TYPE\n", "1234 ok\nok> ", 0 },
{ "-7 DUP 0< IF NEGATE THEN 0 <# #S ROT SIGN #> TYPE\n", "IF: compile-only\n ERROR\nok> ", 0 },
{ ": SN DUP DUP 0< IF NEGATE THEN 0 <# #S ROT SIGN #> TYPE ; -7 SN 7 SN\n", "-77 ok\nok> ", 0 },
{ "65 0 <# 42 HOLD #S 36 HOLD #> TYPE\n", "$65* ok\nok> ", 0 },
{ "2 BASE ! 101 1010 + . DECIMAL\n", "1111 ok\nok> ", 0 },
{ "5 0 D. -1 -1 D. 7 0 4 D.R 124 EMIT\n", "5 -1 7| ok\nok> ", 0 },
{ "36 BASE ! ZZ DECIMAL . 1295 36 BASE ! . DECIMAL\n", "1295 ZZ ok\nok> ", 0 },
{ ": S5 1 2 3 4 5 .S 2DROP 2DROP DROP .S ; S5\n", "<5> 1 2 3 4 5 \n<0> \n ok\nok> ", 0 },
{ "-1 -2 -3 .S\n", "<3> -1 -2 -3 \n ok\nok> ", 0 },
{ "1 2 3 QUIT\nDEPTH 48 + EMIT\n", "\nok> 3 ok\nok> ", 0 },
{ "65 EMIT DROP 66 EMIT\n67 EMIT\n", "AStack underflow\n ERROR\nok> C ok\nok> ", 0 },
{ "+\n1 +\nDUP\nOVER\n1 OVER\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> "
"Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 },
{ ": OV 65 EMIT 1000 0 DO I LOOP 66 EMIT ; 7 8 9 OV\nDEPTH 48 + EMIT\n", "AStack overflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ "1 2 3 -1 @\nDEPTH 48 + EMIT\n", "Address out of range\n ERROR\nok> 0 ok\nok> ", 0 },
{ ": RU R> DROP R> DROP ; 65 EMIT RU 66 EMIT\n67 EMIT\n", "AReturn stack underflow\n ERROR\nok> C ok\nok> ", 0 },
/* a word that runs itself, through EXECUTE, until the return stack is full */
{ "VARIABLE V : RR V @ EXECUTE ; ' RR V ! 65 EMIT RR 66 EMIT\n67 EMIT\n", "AReturn stack overflow\n ERROR\nok> C ok\nok> ", 0 },
{ ": DEEP 65 EMIT BEGIN 1 >R AGAIN ; DEEP\n", "AReturn stack overflow\n ERROR\nok> ", 0 },
{ "65 66 67 1 PICK EMIT EMIT EMIT EMIT\n", "CCBA ok\nok> ", 0 },
{ "65 66 67 2 PICK EMIT EMIT EMIT EMIT\n", "BCBA ok\nok> ", 0 },
{ "65 66 67 3 PICK EMIT EMIT EMIT EMIT\n", "ACBA ok\nok> ", 0 },
{ "65 66 67 1 ROLL EMIT EMIT EMIT\n", "CBA ok\nok> ", 0 },
{ "65 66 67 2 ROLL EMIT EMIT EMIT\n", "BCA ok\nok> ", 0 },
{ "65 66 67 3 ROLL EMIT EMIT EMIT\nDEPTH 48 + EMIT\n", "ACB ok\nok> 0 ok\nok> ", 0 },
{ "65 66 0 PICK\nDEPTH 48 + EMIT\n", "PICK: Invalid index\n ERROR\nok> 2 ok\nok> ", 0 },
{ "65 66 -3 ROLL\n65 66 0 ROLL\n", "ROLL: Invalid index\n ERROR\nok> ROLL: Invalid index\n ERROR\nok> ", 0 },
{ "65 66 3 PICK\nDEPTH 48 + EMIT\n", "Stack underflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ "65 66 5 ROLL\n1 PICK\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 },
{ "65 66 67 68 69 5 ROLL EMIT EMIT EMIT EMIT EMIT\n", "AEDCB ok\nok> ", 0 },
{ "65 66 67 68 69 4 ROLL EMIT EMIT EMIT EMIT EMIT\n", "BEDCA ok\nok> ", 0 },
{ ": P5 65 66 67 68 69 5 PICK EMIT 3 PICK EMIT EMIT EMIT EMIT EMIT EMIT ; P5\n", "ACEDCBA ok\nok> ", 0 },
{ ": T1 QUIT ; : T2 1 2 3 4 T1 ; T2\nDEPTH 48 + EMIT\n", "\nok> 4 ok\nok> ", 0 },
{ ": T3 1 2 3 4 5 6 7 8 9 ABORT ; T3\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 0 },
{ "1 0 0 M/MOD\n", "M/MOD: Division by zero\n ERROR\nok> ", 0 },
{ ": Z0 0 / ; : Z1 65 EMIT 9 Z0 66 EMIT ; Z1\n: Z2 1 IF [ 5 0 MOD ]\nZ2\n",
"A/: Division by zero\n ERROR\nok> MOD: Division by zero\n ERROR\nok> UNKNOWN WORD: 'Z2'\n ERROR\nok> ", 0 },
{ ": Z3 5 0 DO 9 3 I - / DROP LOOP 65 EMIT ; Z3\n66 EMIT\n", "/: Division by zero\n ERROR\nok> B ok\nok> ", 0 },
{ ": BAD 1 NOSUCH 2 ;\nBAD\n65 EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> UNKNOWN WORD: 'BAD'\n ERROR\nok> A ok\nok> ", 0 },
{ "1 ABORT\" now\" 65 EMIT\n66 EMIT\n", "now\n ok\nok> B ok\nok> ", 0 },
{ ": B1 IF LOOP ;\n65 EMIT\n", "Control structure mismatch\n ERROR\nok> A ok\nok> ", 0 },
{ ": A2 0 ABORT\" boom\" 67 EMIT ; A2\n", "C ok\nok> ", 0 },
{ ": A1 ABORT\" boom\" 65 EMIT ; 1 A1 66 EMIT\n0 A1\n", "boom\n ok\nok> A ok\nok> ", 0 },
{ "1 2 3 QUIT 68 EMIT\n+ + 48 + EMIT\n", "\nok> 6 ok\nok> ", 0 },
{ ": Q1 QUIT ; : Q2 65 EMIT Q1 66 EMIT ; : Q3 Q2 67 EMIT ; Q3 68 EMIT\n69 EMIT\n", "A\nok> E ok\nok> ", 0 },
{ ": HALF 1 2 [ QUIT\n65 EMIT\nHALF\n", "\nok> A ok\nok> UNKNOWN WORD: 'HALF'\n ERROR\nok> ", 0 },
{ ": HALF 1 2 [ ABORT\n65 EMIT\n", " ok\nok> A ok\nok> ", 0 },
/* every error stops the line at once, says what it was, and leaves the data stack (D-18) */
{ "1 2 3 PAD PAD -1 CMOVE 65 EMIT\n66 EMIT .S\n", "Negative count\n ERROR\nok> B<3> 1 2 3 \n ok\nok> ", 0 },
{ "7 PAD -5 TYPE 65 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
/* NUMBER takes a counted string: "-12" and "-1x", built at PAD */
{ "3 PAD C! 45 PAD 1+ C! 49 PAD 2+ C! 50 PAD 3 + C! 0 PAD 4 + C! PAD NUMBER D.\n", "-12 ok\nok> ", 0 },
{ "3 PAD C! 45 PAD 1+ C! 49 PAD 2+ C! 120 PAD 3 + C! 7 PAD NUMBER 65 EMIT\n.S\n", "Not a number\n ERROR\nok> <3> 7 0 0 \n ok\nok> ", 0 },
{ "7 <# 300 HOLD 65 EMIT\n.S\n", "Not a character\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ ": HH <# 70 0 DO 65 HOLD LOOP ; HH 66 EMIT\n67 EMIT\n", "Number too long\n ERROR\nok> C ok\nok> ", 0 },
{ "7 : \n.S\n", "Name missing\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ "VARIABLE\nCREATE\n5 CONSTANT\n", "Name missing\n ERROR\nok> Name missing\n ERROR\nok> Name missing\n ERROR\nok> ", 0 },
{ "7 ' NOSUCH 65 EMIT\n.S\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
{ ": X1 COMPILE NOSUCH ;\n: X2 [COMPILE] NOPE ;\n65 EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> UNKNOWN WORD: 'NOPE'\n ERROR\nok> A ok\nok> ", 0 },
{ ": X3 THEN ;\n: X4 BEGIN IF UNTIL ;\n: X5 DO REPEAT ;\n", "Control structure mismatch\n ERROR\nok> Control structure mismatch\n ERROR\nok> "
"Control structure mismatch\n ERROR\nok> ", 0 },
{ ": X6 IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF 65 EMIT ;\n66 EMIT\n", "Control structures too deep\n ERROR\nok> B ok\nok> ", 0 },
{ ".\" no closing quote\n65 EMIT\n", "no closing quote ok\nok> A ok\nok> ", 0 },
{ ".\" \"\n", " ok\nok> ", 0 },
{ ": T ABORT\" \" ; 1 T\n", "\n ok\nok> ", 0 },
{ "5 >R\n;\n", ">R: compile-only\n ERROR\nok> ;: compile-only\n ERROR\nok> ", 0 },
{ "16 BASE ! FF 2/ 2/ EMIT\n", "? ok\nok> ", 0 },
};
#define NSCRIPT (sizeof script / sizeof script[0])
int main(void)
{
unsigned i;
printf("v4 host prompt tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
CHECK(storage_made(), "the chains behind the storage port are made");
{
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" };
CHECK(host_load(&tx, &n, files, 14), "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(" capsule: %ld words\n", (long)v4_text_here(&tx) - 16);
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
w_idle = v4_text_word(&tx, "(IDLE)");
w_key = v4_text_word(&tx, "KEY");
w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.v4 */
w_fault = v4_text_word(&tx, "(FAULTS)");
capsule_latest = v4_text_latest(&tx);
CHECK(w_key_end > w_key && w_key_end - w_key <= 12, "KEY is the few words before CR");
/* ---- switch-on ---- */
boot();
CHECK(node_idle() && n.mem[OUT_PTR] == OUT_W, "the node is waiting at its ports and has printed nothing: the prompt is its console's");
{ v4_uheat_t clock = es.anticlock;
CHECK(run_line(5000) == 0 && es.anticlock == clock, "and goes on waiting, executing nothing"); }
CHECK(canary_under_expect(), "with the data stack as it found it");
(void)v4_exec_step_word(&n, &es, &h);
CHECK(node_idle(), "it stays waiting however long it is run");
/* ---- the sessions ---- */
for (i = 0; i < NSCRIPT; i++) {
const transcript *t = &script[i];
boot_bare();
CHECK(is(say(t->in), t->want), "%ssession %u", t->v3 ? "v3: " : "", i);
CHECK(n.mem[STATE] == 0, "session %u ends interpreting", i);
}
/* ---- one line at a time: the node keeps its state between them ---- */
boot();
CHECK(is(say("VARIABLE V 7 V !\n"), " ok\nok> "), "a variable is set on one line");
CHECK(is(say(": SHOW V @ 48 + EMIT ;\n"), " ok\nok> "), "a word defined on the next");
CHECK(is(say("SHOW 1 V +! SHOW\n"), "78 ok\nok> "), "and both used on a third");
CHECK(is(say("1 2 3 4 5 6\n"), " ok\nok> ") && is(say("+ + + + + 48 + EMIT\n"), "E ok\nok> "), "six values wait on the stack between lines");
CHECK(is(say("SHOW"), ""), "nothing happens until the line is ended");
CHECK(is(say(" SHOW\n"), "88 ok\nok> "), "and then all of it is read");
CHECK(canary_under_expect(), "the data stack is as it was at switch-on");
/* ---- a definition over several lines, and an error in the middle of one ---- */
boot();
CHECK(is(say(": LONG\n"), " ok\nok> ") && n.mem[STATE] != 0, "a line that leaves a definition open still says ok");
CHECK(is(say("65 EMIT\n"), " ok\nok> ") && is(say("66 EMIT ;\n"), " ok\nok> ") && n.mem[STATE] == 0, "it is finished two lines later");
CHECK(is(say("LONG\n"), "AB ok\nok> "), "and runs");
CHECK(is(say(": BROKEN 1 IF\n"), " ok\nok> ") && n.mem[STATE] != 0 && n.mem[CFP] != CFS_W, "a definition with an IF open");
CHECK(is(say("NOSUCH\n"), "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W,
"an error ends it and empties the control-flow stack");
CHECK(is(say("BROKEN\n"), "UNKNOWN WORD: 'BROKEN'\n ERROR\nok> "), "and it was never defined");
CHECK(is(say("LONG\n"), "AB ok\nok> "), "what was defined before is still there");
/* ---- QUIT, ABORT and a failed line each end a definition that is open ---- */
boot();
CHECK(is(say(": IQ QUIT ; IMMEDIATE : IA ABORT ; IMMEDIATE\n"), " ok\nok> "), "QUIT and ABORT as immediate words");
CHECK(is(say(": H1 1 IF IQ\n"), "\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "QUIT while compiling stops compiling");
CHECK(is(say("65 EMIT\n"), "A ok\nok> ") && is(say("H1\n"), "UNKNOWN WORD: 'H1'\n ERROR\nok> "), "and the definition is gone");
CHECK(is(say(": H2 1 IF IA\n"), " ok\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "ABORT while compiling stops compiling");
CHECK(is(say("66 EMIT\n"), "B ok\nok> ") && is(say("H2\n"), "UNKNOWN WORD: 'H2'\n ERROR\nok> "), "and the definition is gone");
CHECK(is(say(": H3 1 IF [ PAD PAD -1 CMOVE ]\n"), "Negative count\n ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W,
"a word that raises an error while a definition is open ends it");
CHECK(is(say("67 EMIT\n"), "C ok\nok> ") && is(say("H3\n"), "UNKNOWN WORD: 'H3'\n ERROR\nok> "), "and the definition is gone");
CHECK(is(say(": H4 68 EMIT ; H4\n"), "D ok\nok> "), "the next definition compiles and runs");
/* ---- 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 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",
": G0 9 0 DO I 3 = IF 0 -1 ! THEN LOOP ; : G1 65 EMIT G0 66 EMIT ; G1\n",
};
boot();
for (i = 0; i < sizeof lines / sizeof lines[0]; i++) {
unsigned before = n.faults;
CHECK(is(say(lines[i]), "AAddress out of range\n ERROR\nok> "), "fault %u", i);
CHECK(n.faults == before + 1 && !n.stopped && n.mem[STATE] == 0, "fault %u: one fault, and the node is at its prompt", i);
CHECK(is(say("1 2 + 48 + EMIT\n"), "3 ok\nok> "), "and the next line runs, after fault %u", i);
}
CHECK(is(say("16383 @ DROP 0 @ DROP 67 EMIT\n"), "C ok\nok> "), "the first and last words of memory are not faults");
CHECK(is(say(": H5 1 IF [ -1 @ ]\n"), "Address out of range\n ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W,
"a fault while a definition is open ends it");
CHECK(is(say("H5\n"), "UNKNOWN WORD: 'H5'\n ERROR\nok> ") && is(say(": H6 68 EMIT ; H6\n"), "D ok\nok> "), "and the next definition compiles and runs");
CHECK(v4_node_guards_intact(&n), "guards intact after the faults");
}
/* ---- the text is in the definition, a counted string after the call ---- */
boot();
for (v4_cell k = n.mem[DP] / 4; k < DICT_END_W; k++) n.mem[k] = (v4_cell)-1; /* memory that was not zero */
CHECK(is(say(": T .\" ABCDE\" ;\n"), " ok\nok> "), "a word that prints five characters");
{
v4_cell xt = n.mem[LATEST];
CHECK((uint32_t)n.mem[xt + 1] == (5u | ('A' << 8) | ('B' << 16) | ((uint32_t)'C' << 24)) && (uint32_t)n.mem[xt + 2] == ('D' | ('E' << 8)),
"the count and the characters follow the call, four to a cell, zeros after");
CHECK((n.mem[DP] + 3) / 4 == xt + 4, "then the rest of the word: four cells in all");
}
/* every length from 0 to 12: the word goes on at the right cell */
for (i = 0; i <= 12; i++) {
char line[96], want[32];
boot();
snprintf(line, sizeof line, ": T 60 EMIT .\" %.*s\" 62 EMIT ; T\n", (int)i, "abcdefghijkl");
snprintf(want, sizeof want, "<%.*s> ok\nok> ", (int)i, "abcdefghijkl");
CHECK(is(say(line), want), ".\" with %u characters", i);
snprintf(line, sizeof line, ": U 60 EMIT ABORT\" %.*s\" 62 EMIT ; 0 U 1 U 33 EMIT\n", (int)i, "abcdefghijkl");
snprintf(want, sizeof want, "<><%.*s\n ok\nok> ", (int)i, "abcdefghijkl");
CHECK(is(say(line), want), "ABORT\" with %u characters, false then true", i);
}
/* 76 characters after ." and a space make a line of 80. That was the most
* the node's own QUERY would take; a line the host hands over is whole. */
{
char line[128], want[128], text[80];
for (i = 0; i < 76; i++) text[i] = (char)('#' + i); /* no " in it */
text[76] = 0;
boot();
snprintf(line, sizeof line, ".\" %s\"\n", text);
snprintf(want, sizeof want, "%s ok\nok> ", text);
CHECK(is(say(line), want), "a string that fills an 80-character line");
boot();
snprintf(line, sizeof line, ".\" %s\"\n", text + 1);
snprintf(want, sizeof want, "%s ok\nok> ", text + 1);
CHECK(is(say(line), want), "and one that fills a 79-character line");
}
/* ---- a line is handed over whole, up to 1024 characters: a block, as v3 ---- */
boot();
{
static char line[1100];
memset(line, ' ', 100);
memcpy(line, "65 EMIT", 7);
memcpy(line + 70, "66 EMIT", 7);
memcpy(line + 80, "67 EMIT 68 EMIT", 15);
line[100] = '\n'; line[101] = 0;
CHECK(is(say(line), "ABCD ok\nok> "), "a line of 100 characters is one line");
boot();
memset(line, ' ', 1024);
memcpy(line, "65 EMIT", 7);
memcpy(line + 1017, "66 EMIT", 7);
line[1024] = '\n'; line[1025] = 0;
CHECK(is(say(line), "AB ok\nok> "), "a line of 1024 characters is interpreted to its end");
boot();
memset(line, ' ', 1025);
memcpy(line, "65 EMIT", 7);
line[1025] = '\n'; line[1026] = 0;
CHECK(is(say(line), "(line too long)"), "one of 1025 is not taken: the node's input buffer holds a block");
CHECK(node_idle() && n.mem[OUT_PTR] == OUT_W, "and nothing of it was sent");
}
/* ---- ABORT and QUIT from deep in a programme, again and again ---- */
boot();
CHECK(is(say(": A0 ABORT ; : A1 A0 ; : A2 A1 ; : A3 A2 ; : A4 A3 ; : A5 A4 ;\n"), " ok\nok> "), "ABORT six calls down");
CHECK(is(say(": Q0 QUIT ; : Q1 Q0 ; : Q2 Q1 ; : Q3 Q2 ; : Q4 Q3 ; : Q5 Q4 ;\n"), " ok\nok> "), "QUIT six calls down");
CHECK(is(say(": L0 10 0 DO I 5 = IF ABORT THEN LOOP ; : L1 3 0 DO L0 LOOP ;\n"), " ok\nok> "), "ABORT inside two loops");
for (i = 0; i < 40; i++) {
CHECK(is(say("65 EMIT A5 66 EMIT\n"), "A ok\nok> "), "ABORT from six deep, time %u", i);
CHECK(is(say("67 EMIT Q5 68 EMIT\n"), "C\nok> "), "QUIT from six deep, time %u", i);
CHECK(is(say("L1 69 EMIT\n"), " ok\nok> "), "ABORT out of two loops, time %u", i);
CHECK(is(say(": SQ DUP * ; 7 SQ EMIT\n"), "1 ok\nok> "), "and the next line compiles and runs, time %u", i);
}
CHECK(is(say("DEPTH 48 + EMIT\n"), "0 ok\nok> "), "ABORT has emptied the data stack");
/* ---- how deep words may call each other from the prompt ----
* The prompt's call of INTERPRET is one return entry, so a chain of words
* one shorter than the return stack runs, and the next is a fault. */
{
unsigned deepest = 0;
char line[64], want[16];
boot();
CHECK(is(say(": N0 1+ ;\n"), " ok\nok> "), "a word that calls nothing");
for (i = 1; i <= V4_RET_DEPTH; i++) {
snprintf(line, sizeof line, ": N%u N%u 1+ ;\n", i, i - 1u);
CHECK(is(say(line), " ok\nok> "), "and one that calls it, %u deep", i + 1u);
}
for (i = 0; i <= V4_RET_DEPTH; i++) {
snprintf(line, sizeof line, "33 N%u EMIT 33 EMIT\n", i);
snprintf(want, sizeof want, "%c! ok\nok> ", (char)(34 + i));
if (strcmp(say(line), want) != 0) break;
deepest = i + 1;
}
printf(" from the prompt, words may call each other %u deep\n", deepest);
CHECK(deepest == V4_RET_DEPTH - 1u, "a word run from the prompt has all the return stack but the prompt's one entry");
CHECK(is(out, "Return stack overflow\n ERROR\nok> "), "and one more is reported");
}
/* ---- the exits, taken with the return stack full ----
* RR runs itself through EXECUTE; each level holds one return entry, and
* EXECUTE one more while it starts the next. With C at its largest and
* one >R besides, there is room for exactly the action's own call. An
* exit that did not empty the return stack before it printed would
* overflow it. */
{
static const struct { const char *action, *want; } e[] = {
{ "1 ABORT\" x\"", "x\n ok\nok> " },
{ "5 0 PICK", "PICK: Invalid index\n ERROR\nok> " },
{ "5 0 ROLL", "ROLL: Invalid index\n ERROR\nok> " },
{ "5 0 /", "/: Division by zero\n ERROR\nok> " },
{ "5 5 0 */MOD", "*/MOD: Division by zero\n ERROR\nok> " },
{ "ABORT", " ok\nok> " },
{ "QUIT", "\nok> " },
};
char line[96];
for (i = 0; i < sizeof e / sizeof e[0]; i++) {
boot_bare();
CHECK(is(say("VARIABLE V VARIABLE C\n"), " ok\nok> "), "two variables");
snprintf(line, sizeof line, ": RR C @ 1- DUP C ! IF V @ EXECUTE EXIT THEN 1 >R %s ;\n", e[i].action);
CHECK(is(say(line), " ok\nok> "), "a word that runs itself C times and then: %s", e[i].action);
snprintf(line, sizeof line, "' RR V ! %u C ! RR\n", (unsigned)(V4_RET_DEPTH - 3u));
CHECK(is(say(line), e[i].want), "%s with the return stack full", e[i].action);
CHECK(n.faults == 0, "%s: and it was not a fault", e[i].action);
CHECK(is(say("65 EMIT\n"), "A ok\nok> "), "and the next line runs");
/* one level more and the action's own call does not fit */
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)(V4_RET_DEPTH - 2u));
CHECK(is(say(line), "Return stack overflow\n ERROR\nok> "), "%s one level deeper is a return stack overflow", e[i].action);
}
}
/* ---- the data stack, full ----
* P1 P2 P4 P8 P16 push that many values and call nothing while they do, so
* a word can fill the stack to any depth in a short line. */
{
char line[128], want[32], fill[64];
unsigned c, bit;
#define FILL(count) do { size_t at_ = 0; fill[0] = 0; \
for (c = (count), bit = 16; bit; bit >>= 1) if (c >= bit) { at_ += (size_t)snprintf(fill + at_, sizeof fill - at_, "P%u ", bit); c -= bit; } \
for (; c >= 16; c -= 16) at_ += (size_t)snprintf(fill + at_, sizeof fill - at_, "P16 "); } while (0)
boot_bare();
CHECK(is(say(": P1 7 ; : P2 7 7 ; : P4 7 7 7 7 ; : P8 7 7 7 7 7 7 7 7 ;\n"), " ok\nok> ")
&& is(say(": P16 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 ;\n"), " ok\nok> "), "words that push 1, 2, 4, 8 and 16 values");
/* 65, then DEPTH-2 more, then n = DEPTH-1: the stack is full when PICK and ROLL start */
FILL(V4_DATA_DEPTH - 2u);
snprintf(line, sizeof line, ": PF 65 %s%u PICK >R DROP R> EMIT ABORT ; PF\n", fill, (unsigned)(V4_DATA_DEPTH - 1u));
CHECK(is(say(line), "A ok\nok> ") && n.faults == 0, "PICK of the deepest value of a full stack");
snprintf(line, sizeof line, ": RF 65 %s%u ROLL EMIT DROP DEPTH 33 + EMIT ABORT ; RF\n", fill, (unsigned)(V4_DATA_DEPTH - 1u));
snprintf(want, sizeof want, "A%c ok\nok> ", (char)(33 + V4_DATA_DEPTH - 3u));
CHECK(is(say(line), want) && n.faults == 0, "ROLL of the deepest value of a full stack");
/* exactly full is not a fault; one more is */
FILL(V4_DATA_DEPTH);
snprintf(line, sizeof line, ": F1 %s2DROP ABORT ; F1\n", fill);
CHECK(is(say(line), " ok\nok> ") && n.faults == 0, "a stack exactly full is not a fault");
snprintf(line, sizeof line, ": F2 %s7 ; F2\n", fill);
CHECK(is(say(line), "Stack overflow\n ERROR\nok> ") && n.fault_kind == V4_FAULT_DATA_OVER, "one value more is");
CHECK(is(say("DEPTH 48 + EMIT\n"), "0 ok\nok> "), "and the stack is empty afterwards");
#undef FILL
}
/* and with text printed at the bottom of the chain */
boot();
CHECK(is(say(": P0 .\" deep\" ; : P1 P0 ; : P2 P1 ; : P3 P2 ; : P4 P3 ; P4\n"), "deep ok\nok> "), ".\" five calls down");
/* ---- how many values may wait on the stack from one line to the next ---- */
{
unsigned k, most = 0;
for (k = 1; k < V4_DATA_DEPTH; k++) {
char line[4 * V4_DATA_DEPTH + 16], want[16];
size_t at = 0;
unsigned m;
boot_bare();
for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "1 ");
snprintf(line + at, sizeof line - at, "\n");
if (strcmp(say(line), " ok\nok> ") != 0) break;
for (at = 0, m = 1; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "+ ");
snprintf(line + at, sizeof line - at, "32 + EMIT\n");
snprintf(want, sizeof want, "%c ok\nok> ", (char)(32 + k));
if (strcmp(say(line), want) != 0) break;
most = k;
}
printf(" %u values may wait on the stack while the next line is typed and interpreted\n", most);
CHECK(most + 4u >= V4_DATA_DEPTH, "the prompt and the interpreter take no more than four cells of the stack");
}
/* ---- how much of the data stack a line has ---- */
{
unsigned d;
for (d = 0; d < V4_DATA_DEPTH; d++) {
unsigned k, good = 1;
boot_with(d + 1);
if (strcmp(say(": Z1 .\" x\" 1 2 + ; Z1 Z1 + 48 + EMIT\n"), "xx6 ok\nok> ") != 0) break;
if (!canary_under_expect()) break;
for (k = d + 1; k-- > 0; ) if (v4_dstack_pop(&n.ds) != (v4_cell)(0x5A000000 + k)) good = 0;
if (!good) break;
}
printf(" defining and running a word from the prompt leaves %u data cells under it untouched\n", d);
CHECK(d >= 3, "the prompt leaves room on the data stack");
}
/* ---- numbers at the ends of the range, which depend on the cell width ---- */
boot_bare();
#if V4_CELL_BITS == 32
CHECK(is(say("-1 U. -2147483648 . 2147483647 .\n"), "4294967295 -2147483648 2147483647 ok\nok> "), "the largest and smallest numbers");
CHECK(is(say("HEX -1 U. DECIMAL\n"), "FFFFFFFF ok\nok> ") && is(say("2 BASE ! -1 U. DECIMAL\n"), "11111111111111111111111111111111 ok\nok> "), "in hex and in binary");
#else
CHECK(is(say("-1 U.\n"), "18446744073709551615 ok\nok> "), "the largest number (as v3)");
CHECK(is(say("-9223372036854775808 . 9223372036854775807 .\n"), "-9223372036854775808 9223372036854775807 ok\nok> "), "the smallest and largest signed");
CHECK(is(say("HEX -1 U. DECIMAL\n"), "FFFFFFFFFFFFFFFF ok\nok> "), "in hex");
/* 64 binary digits are one more than the hold buffer's 63 (D-13): an error, and nothing is printed */
CHECK(is(say("2 BASE ! -1 U. DECIMAL\n"), "Number too long\n ERROR\nok> "), "in binary, its 64 digits are one too many");
CHECK(is(say("DECIMAL\n"), " ok\nok> "), "(back to decimal)");
CHECK(is(say("9223372036854775807 2 BASE ! U. DECIMAL\n"), "111111111111111111111111111111111111111111111111111111111111111 ok\nok> "), "a 63-digit number prints whole");
#endif
/* the shifts, to the last bit */
{
char line[96], want[64];
boot_bare();
snprintf(line, sizeof line, "1 %d LSHIFT .\n", V4_CELL_BITS);
CHECK(is(say(line), "Shift count out of range\n ERROR\nok> "), "a shift by the cell's width is out of range");
snprintf(line, sizeof line, "1 %d LSHIFT 0< . -1 %d RSHIFT . -8 1 RSHIFT 2* 8 + .\n", V4_CELL_BITS - 1, V4_CELL_BITS - 1);
CHECK(is(say(line), "-1 1 0 ok\nok> "), "a shift by one less reaches the top bit, and RSHIFT brings zeros in");
snprintf(line, sizeof line, "-1 1 RSHIFT .\n");
#if V4_CELL_BITS == 32
snprintf(want, sizeof want, "2147483647 ok\nok> ");
#else
snprintf(want, sizeof want, "9223372036854775807 ok\nok> ");
#endif
CHECK(is(say(line), want), "-1 1 RSHIFT is the largest positive number");
}
/* .S works on the stack it is printing, so it needs some of it free */
{
char line[4 * V4_DATA_DEPTH + 16], want[8 * V4_DATA_DEPTH + 32];
unsigned k, m, most = 0;
for (k = 1; k < V4_DATA_DEPTH; k++) {
size_t at = 0, wt;
boot_bare();
for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "7 ");
snprintf(line + at, sizeof line - at, "\n");
if (strlen(line) > 80 || strcmp(say(line), " ok\nok> ") != 0) break;
wt = (size_t)snprintf(want, sizeof want, "<%u> ", k);
for (m = 0; m < k; m++) wt += (size_t)snprintf(want + wt, sizeof want - wt, "7 ");
snprintf(want + wt, sizeof want - wt, "\n ok\nok> ");
if (strcmp(say(".S\n"), want) != 0) break;
snprintf(want, sizeof want, "%u ok\nok> ", k);
CHECK(is(say("DEPTH .\n"), want), "after .S the %u values are still there", k);
most = k;
}
printf(" .S prints a stack of up to %u values; it needs %u cells free\n", most, (unsigned)V4_DATA_DEPTH - most);
CHECK(most + 8u >= V4_DATA_DEPTH, ".S works with all but eight cells of the stack in use");
}
/* ---- nested CASE, by value ---- */
boot_bare();
CHECK(is(say(": IN CASE 1 OF 65 ENDOF 2 OF 66 ENDOF 63 SWAP ENDCASE ;\n"), " ok\nok> ")
&& is(say(": OUT CASE 1 OF IN ENDOF 2 OF DROP 90 ENDOF DROP 33 SWAP ENDCASE EMIT ;\n"), " ok\nok> "), "a CASE that calls a CASE");
CHECK(is(say("1 1 OUT 2 1 OUT 9 1 OUT 5 2 OUT 5 7 OUT .S\n"), "AB?Z!<0> \n ok\nok> "), "every path through both");
CHECK(is(say(": NC CASE 1 OF CASE 5 OF 65 ENDOF 66 SWAP ENDCASE ENDOF 67 SWAP ENDCASE EMIT ;\n"), " ok\nok> ")
&& is(say("5 1 NC 6 1 NC 7 2 NC .S\n"), "ABC<1> 7 \n ok\nok> "), "a CASE inside a clause of a CASE");
/* ---- FORGET gives the space back, and FENCE protects ---- */
boot_bare();
{
v4_cell dp0 = n.mem[DP], latest0 = n.mem[LATEST];
CHECK(is(say(": F1 1 ; VARIABLE F2 : F3 F1 F2 ;\n"), " ok\nok> ") && n.mem[DP] > dp0, "three words");
CHECK(is(say("FORGET F1\n"), " ok\nok> ") && n.mem[DP] == dp0 && n.mem[LATEST] == latest0, "FORGET of the first puts HERE and LATEST back where they were");
CHECK(is(say(": G1 65 EMIT ; : G2 66 EMIT ;\n"), " ok\nok> ") && is(say("HERE FENCE ! : G3 67 EMIT ;\n"), " ok\nok> "), "two words, the fence, and a third");
CHECK(is(say("FORGET G2\n"), "Protected word\n ERROR\nok> ") && is(say("G1 G2 G3\n"), "ABC ok\nok> "), "a word below the fence cannot be forgotten");
CHECK(is(say("FORGET G3 G1 G2\n"), "AB ok\nok> ") && is(say("G3\n"), "UNKNOWN WORD: 'G3'\n ERROR\nok> "), "one above it can");
}
/* ---- storage that refuses a write (MESH.md 8.2) ---- */
boot();
CHECK(is(say(REFUSING_FIRST " BLOCK DROP UPDATE SAVE-BUFFERS 65 EMIT\n"), "Storage refused\n ERROR\nok> "), "a write storage will not take says so, and the prompt returns");
{
unsigned long before = block_requests;
CHECK(is(say(REFUSING_FIRST " BLOCK DROP\n"), " ok\nok> ") && block_requests == before + 1, "the buffer was emptied: the next BLOCK asks the kernel again");
CHECK(is(say(REFUSING_FIRST " BLOCK DROP\n"), " ok\nok> ") && block_requests == before + 1, "and the one after finds it in the buffer");
}
/* ---- blocks: text loaded from storage ---- */
boot_bare();
put_block(5, "65 EMIT 66 EMIT");
CHECK(is(say("5 LOAD 67 EMIT BLK @ .\n"), "ABC0 ok\nok> "), "LOAD interprets the block and then the rest of the line");
put_block(6, "BLK @ . 7 LOAD BLK @ .");
put_block(7, "BLK @ . 68 EMIT");
CHECK(is(say("6 LOAD BLK @ .\n"), "6 7 D6 0 ok\nok> "), "a block may LOAD another; BLK is the block being interpreted");
put_block(8, "65 EMIT 9 LOAD 66 EMIT");
put_block(9, "67 EMIT 10 LOAD 68 EMIT");
put_block(10, "69 EMIT");
CHECK(is(say("8 LOAD\n"), "ACEDB ok\nok> "), "three deep, with two buffers: each block is fetched again when it is come back to");
put_block(11, ": W1 1 ; -->");
put_block(12, ": W2 W1 1+ ; W2 . -->");
put_block(13, "W2 W2 + .");
CHECK(is(say("11 LOAD 70 EMIT\n"), "2 4 F ok\nok> "), "--> goes on with the next block");
CHECK(is(say("11 13 THRU 9 8 THRU 71 EMIT\n"), "2 4 2 4 4 G ok\nok> "), "THRU loads each in turn (here the --> chain from 11 and 12, then 13); an empty range loads nothing");
memset(disk + 14 * V4_BLOCK_BYTES, ' ', V4_BLOCK_BYTES);
memcpy(disk + 14 * V4_BLOCK_BYTES, "65 EMIT \\ 66 EMIT and the rest of this line", 43);
memcpy(disk + 14 * V4_BLOCK_BYTES + 64, "67 EMIT ( a comment", 19);
memcpy(disk + 14 * V4_BLOCK_BYTES + 128, "over two lines ) 68 EMIT : LONGDEF", 34);
memcpy(disk + 14 * V4_BLOCK_BYTES + 192, "69 EMIT ; LONGDEF", 17);
CHECK(is(say("14 LOAD\n"), "ACDE ok\nok> "), "in a block \\ skips to the next 64-character line; ( and : run across lines");
put_block(15, "1 16 LOAD 2");
put_block(16, "3 NOSUCH 4");
CHECK(is(say("15 LOAD 99 .\n"), "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> "), "an error in a loaded block ends everything");
CHECK(is(say("BLK @ . .S\n"), "0 <2> 1 3 \n ok\nok> ") && n.mem[SRC] == TIB, "and the terminal is the input again");
put_block(17, ": HALFDONE 1 2");
CHECK(is(say("17 LOAD\n"), " ok\nok> ") && n.mem[STATE] != 0 && is(say("+ ; HALFDONE .\n"), "3 ok\nok> "), "a definition begun in a block can be finished at the terminal");
/* errors */
CHECK(is(say("ABORT\n"), " ok\nok> "), "(an empty stack)");
CHECK(is(say("7 0 BLOCK 65 EMIT\n"), "Block out of range\n ERROR\nok> ") && is(say("-1 BLOCK\n"), "Block out of range\n ERROR\nok> ")
&& is(say("9000 BLOCK\n"), "Block out of range\n ERROR\nok> ") && is(say("2111 BLOCK DROP .S\n"), "<1> 7 \n ok\nok> "), "a block number below 1 or past the chain's last");
CHECK(is(say("0 LOAD\n"), "Block out of range\n ERROR\nok> ") && is(say("-5 LOAD\n"), "Block out of range\n ERROR\nok> ")
&& is(say("0 BUFFER\n"), "Block out of range\n ERROR\nok> ") && is(say("9000 LIST\n"), "Block out of range\n ERROR\nok> "), "LOAD, BUFFER and LIST the same");
CHECK(is(say("-->\n"), "No block is being loaded\n ERROR\nok> ") && is(say("65 EMIT\n"), "A ok\nok> "), "--> at the terminal");
put_block(18, "1 9000 LOAD 2");
CHECK(is(say("ABORT\n"), " ok\nok> "), "(an empty stack)");
CHECK(is(say("18 LOAD\n.S\n"), "Block out of range\n ERROR\nok> <1> 1 \n ok\nok> "), "a block that loads one that is not there");
/* ---- blocks: what is written, and when ---- */
boot_bare();
CHECK(is(say("3 BLOCK 1024 BLANK 72 3 BLOCK C! 73 3 BLOCK 1023 + C! UPDATE\n"), " ok\nok> ") && disk[3 * V4_BLOCK_BYTES] == 0,
"an UPDATEd block is not written yet");
CHECK(is(say("FLUSH\n"), " ok\nok> ") && disk[3 * V4_BLOCK_BYTES] == 'H' && disk[3 * V4_BLOCK_BYTES + 1] == ' ' && disk[3 * V4_BLOCK_BYTES + 1023] == 'I'
&& disk[2 * V4_BLOCK_BYTES + 1023] == 0 && disk[4 * V4_BLOCK_BYTES] == 0, "FLUSH writes it, all 1024 bytes and no others");
CHECK(is(say("74 3 BLOCK C! UPDATE 4 BLOCK DROP\n"), " ok\nok> ") && disk[3 * V4_BLOCK_BYTES] == 'H', "with two buffers a second block does not disturb it");
CHECK(is(say("5 BLOCK DROP\n"), " ok\nok> ") && disk[3 * V4_BLOCK_BYTES] == 'J', "a third takes its buffer, and it is written first");
CHECK(is(say("3 BLOCK C@ . 75 3 BLOCK C! UPDATE EMPTY-BUFFERS FLUSH 3 BLOCK C@ .\n"), "74 74 ok\nok> ") && disk[3 * V4_BLOCK_BYTES] == 'J',
"EMPTY-BUFFERS forgets a change without writing it");
CHECK(is(say("76 3 BLOCK C! 5 BLOCK DROP 6 BLOCK DROP 3 BLOCK C@ .\n"), "74 ok\nok> "), "a change without UPDATE is lost when the buffer is taken");
CHECK(is(say("3 BLOCK 4 BLOCK 1024 CMOVE UPDATE SAVE-BUFFERS\n"), " ok\nok> ") && memcmp(disk + 3 * V4_BLOCK_BYTES, disk + 4 * V4_BLOCK_BYTES, V4_BLOCK_BYTES) == 0
&& disk[4 * V4_BLOCK_BYTES] == 'J', "two blocks in memory at once: one copied to the other");
put_block(40, "this is on the device");
CHECK(is(say("40 BUFFER 1024 65 FILL UPDATE FLUSH\n"), " ok\nok> ") && disk[40 * V4_BLOCK_BYTES] == 'A' && disk[40 * V4_BLOCK_BYTES + 1023] == 'A',
"BUFFER gives a buffer for a block without reading it");
{
v4_cell k, wide = 0;
(void)say("3 BLOCK DROP\n");
for (k = 0; k < 2 * 256; k++) if ((v4_ucell)n.mem[BUF0_W + k] > 0xFFFFFFFFu) wide = 1;
CHECK(!wide, "a block's bytes are four to a cell at every cell width");
}
{
v4_cell before[8], k;
CHECK(is(say("VOCABULARY KEEP KEEP DEFINITIONS : KEPT 75 EMIT ; FORTH DEFINITIONS\n"), " ok\nok> "), "a vocabulary, before blocks are listed and loaded");
for (k = 0; k < 8; k++) before[k] = n.mem[TOP - 56 + k]; /* the cells around (Q)'s old place */
put_block(41, "66 EMIT");
(void)say("41 LIST 41 LOAD\n");
for (k = 0; k < 8; k++) CHECK(n.mem[TOP - 56 + k] == before[k], "LIST and LOAD leave cell TOP-%d alone", (int)(56 - k));
CHECK(is(say("KEEP KEPT FORTH\n"), "K ok\nok> ") && n.mem[VOC_LINK] != 0, "and the vocabulary is intact");
}
CHECK(strncmp(say("50 LIST\n"), "\nBlock 50\n00: \n01: ", 81) == 0 && n.mem[SCR] == 50,
"a block of zeros lists as blanks, and SCR is the block listed");
/* ---- the editor: FORTH source, compiled by the node ---- */
boot_bare();
CHECK(load_source("editor.fth"), "editor.fth compiles, every line of it");
CHECK(is(say("ORDER .S\n"), "Search order: FORTH \nCurrent: FORTH\n<0> \n ok\nok> "), "and leaves FORTH as it found it");
{
char want[2048], blank[65];
size_t at;
unsigned k;
memset(blank, ' ', 64); blank[64] = 0;
#define SCREEN(num, ...) do { static const char *const t_[] = { __VA_ARGS__ }; \
at = (size_t)snprintf(want, sizeof want, "Screen %d:\n", num); \
for (k = 0; k < 16; k++) at += (size_t)snprintf(want + at, sizeof want - at, "%2u: %-64s\n", k, k < sizeof t_ / sizeof t_[0] ? t_[k] : ""); \
snprintf(want + at, sizeof want - at, " ok\nok> "); } while (0)
SCREEN(9, "");
CHECK(is(say("9 EDIT\n"), want), "EDIT lists the screen");
CHECK(is(say("ORDER\n"), "Search order: EDITOR FORTH\nCurrent: FORTH\n ok\nok> ") && n.mem[SCR] == 9, "and the editor's words are now found first");
CHECK(is(say("0 P first line\n"), " ok\nok> ") && is(say("1 P second, with blanks before it\n"), " ok\nok> ")
&& is(say("3 P fourth\n"), " ok\nok> ") && is(say("15 P last\n"), " ok\nok> "), "P puts text on a line");
SCREEN(9, "first line", " second, with blanks before it", "", "fourth", "", "", "", "", "", "", "", "", "", "", "", "last");
CHECK(is(say("L\n"), want), "L lists it");
CHECK(is(say("1 T 2 T\n"), " 1: second, with blanks before it \n 2: \n ok\nok> "), "T types a line");
CHECK(is(say("2 S\n"), " ok\nok> ") && is(say("2 P put in the gap\n"), " ok\nok> "), "S spreads");
SCREEN(9, "first line", " second, with blanks before it", "put in the gap", "", "fourth", "", "", "", "", "", "", "", "", "", "", "");
CHECK(is(say("L\n"), want), "the lines below move down and the last is lost");
CHECK(is(say("1 D\n"), " ok\nok> "), "D deletes");
SCREEN(9, "first line", "put in the gap", "", "fourth");
CHECK(is(say("L\n"), want), "the lines below move up");
CHECK(is(say("5 I 0 H 7 R 2 E\n"), " ok\nok> "), "I inserts the deleted line; H and R copy one; E erases one");
SCREEN(9, "first line", "put in the gap", "", "fourth", "", " second, with blanks before it", "", "first line");
CHECK(is(say("L\n"), want), "as it should be");
CHECK(is(say("0 D 0 D 0 D 0 D 0 D 15 S 15 D 0 S 0 D\n"), " ok\nok> "), "at the ends");
SCREEN(9, " second, with blanks before it", "", "first line");
CHECK(is(say("L\n"), want), "nothing is disturbed");
CHECK(disk[9 * V4_BLOCK_BYTES] == 0, "nothing has reached storage yet");
CHECK(is(say("16 T\n"), "Line out of range\n ok\nok> ") && is(say("-1 E\n"), "Line out of range\n ok\nok> ") && is(say("16 P x\n"), "Line out of range\n ok\nok> "),
"a line that is not there");
CHECK(is(say("9 EDIT\n"), want), "(ABORT left FORTH as CONTEXT; EDIT again)");
CHECK(is(say("DONE ORDER\n"), "Search order: FORTH \nCurrent: FORTH\n ok\nok> ") && memcmp(disk + 9 * V4_BLOCK_BYTES, " second, with blanks", 21) == 0
&& disk[9 * V4_BLOCK_BYTES + 128] == 'f' && disk[9 * V4_BLOCK_BYTES + 1023] == ' ', "DONE writes the screen and goes back to FORTH");
/* text typed into a screen is a programme */
CHECK(is(say("20 EDIT\n"), blank_screen(20)) && is(say("0 P : HELLO .\" Hello from a block\" ;\n"), " ok\nok> ")
&& is(say("1 P HELLO \\ and say it\n"), " ok\nok> ") && is(say("2 P 3 4 + .\n"), " ok\nok> ") && is(say("DONE 20 LOAD\n"), "Hello from a block7 ok\nok> "),
"a screen that has been edited can be loaded");
CHECK(is(say("9 21 COPY 21 LIST\n"), out) && strstr(out, "Block 21\n00: second, with blanks before it") && strstr(out, "02: first line "), "COPY copies a screen");
CHECK(is(say("FLUSH\n"), " ok\nok> ") && memcmp(disk + 21 * V4_BLOCK_BYTES, disk + 9 * V4_BLOCK_BYTES, V4_BLOCK_BYTES) == 0, "and the copy reaches storage");
/* each change on its own reaches storage */
CHECK(is(say("30 EDIT\n"), blank_screen(30)) && is(say("0 P only this\n"), " ok\nok> ") && is(say("DONE\n"), " ok\nok> ")
&& memcmp(disk + 30 * V4_BLOCK_BYTES, "only this ", 10) == 0, "P alone is written");
CHECK(is(say("30 EDIT\n"), out) && is(say("0 E DONE\n"), " ok\nok> ") && disk[30 * V4_BLOCK_BYTES] == ' ', "E alone is written");
/* D and I with every line in use */
CHECK(is(say("31 EDIT\n"), blank_screen(31)), "another screen");
for (k = 0; k < 16; k++) {
char line[32];
snprintf(line, sizeof line, "%u P line %c\n", k, 'A' + k);
CHECK(is(say(line), " ok\nok> "), "line %u", k);
}
CHECK(is(say("3 D\n"), " ok\nok> "), "delete line 3 of a full screen");
SCREEN(31, "line A", "line B", "line C", "line E", "line F", "line G", "line H", "line I", "line J", "line K", "line L", "line M", "line N", "line O", "line P", "");
CHECK(is(say("L\n"), want), "every line below moved up, the last is blank");
CHECK(is(say("1 I\n"), " ok\nok> "), "insert the deleted line at 1");
SCREEN(31, "line A", "line D", "line B", "line C", "line E", "line F", "line G", "line H", "line I", "line J", "line K", "line L", "line M", "line N", "line O", "line P");
CHECK(is(say("L DONE\n"), want), "every line from 1 moved down");
CHECK(is(say("21 EDIT\n"), out) && is(say("WIPE N\n"), blank_screen(22)) && is(say("B\n"), blank_screen(21)), "WIPE blanks it; N and B move to the next and back");
CHECK(is(say("9000 EDIT\n"), "Block out of range\n ERROR\nok> ") && n.mem[SCR] == 21, "EDIT of a block that is not there");
/* v3's three, in FORTH */
CHECK(is(say("FORTH 9 SCR ! 0 L 3 L\n"), " second, with blanks before it \n \n ok\nok> "),
"FORTH's L shows a line, as v3's");
CHECK(is(say("S\" a much longer line than hello\" 3 S\n"), " ok\nok> ")
&& is(say("S\" hello world\" 3 S 3 L\n"), "hello world \n ok\nok> "), "and S sets one from a string, blanks after it");
SCREEN(9, " second, with blanks before it", "", "first line", "hello world");
CHECK(is(say("SHOW\n"), want), "and SHOW shows the screen");
CHECK(is(say("7 PAD 3 16 S\n"), "Line out of range\n ok\nok> "), "a line out of range");
#undef SCREEN
}
/* ---- SEE: FORTH source too ---- */
boot_bare();
CHECK(load_source("tools.fth"), "tools.fth compiles, every line of it");
CHECK(is(say(": SQ DUP * ; SEE SQ\n"), ": SQ\n dup call * \n ; \n ok\nok> "), "a definition: an in-line word, a call by name, the return");
CHECK(is(say("SEE DUP\n"), ": DUP\n dup ; \n ok\nok> ") && is(say("SEE EMIT\n"), out) && strncmp(out, ": EMIT\n @p ", 12) == 0 && strstr(out, " b! @b \n if ") && strstr(out, " pop a! ; \n"),
"the capsule's own words; a literal's value follows its @p");
CHECK(is(say("VARIABLE V 7 V ! SEE V\n"), ": V\n data: 7 \n ok\nok> ") && is(say("5 CONSTANT K SEE K\n"), ": K\n data: 5 \n ok\nok> "), "a variable and a constant show what they hold");
CHECK(is(say(": IM 1 ; IMMEDIATE SEE IM\n"), ": IM\n @p 1 ; \nIMMEDIATE\n ok\nok> "), "an immediate word says so");
CHECK(is(say(": ST .\" hi\" 300 + ; SEE ST\n"), ": ST\n call (.\") \"hi\" \n @p 300 + ; \n ok\nok> "), "text in a definition is shown as text, and the code after it as code");
CHECK(is(say(": S3 S\" abcdefg\" 0 ABORT\" x\" ; SEE S3\n"), ": S3\n call (S\") \"abcdefg\" \n @p 0 call (ABORT\") \"x\" \n ; \n ok\nok> "), "S\" and ABORT\" the same");
{
/* branches: the addresses are this node's, so they are read back rather than written here */
const char *o = say(": AB DUP 0< IF NEGATE THEN ; SEE AB\n");
long a1, a2;
CHECK(sscanf(o, ": AB\n dup call 0< \n if %ld \n drop inv @p 1 + \n jump %ld \n drop \n ; \n ok", &a1, &a2) == 2 && a2 == a1 + 1
&& a1 > (long)DICT_W && a1 < (long)DICT_END_W, "IF and THEN: the if goes to the drop, the jump to the word after it");
CHECK(is(say("7 AB -7 AB + .\n"), "14 ok\nok> "), "(and the word works)");
o = say(": LP 10 0 DO I . LOOP ; SEE LP\n");
CHECK(strstr(o, ": LP\n @p 10 @p 0 over push push drop \n pop dup push \n call . \n") == o && strstr(o, "\n drop drop drop ; \n ok\nok> "),
"a loop runs to its last return, past the returns inside it");
o = say("SEE SEE\n");
CHECK(strstr(o, ": SEE\n call FIND \n dup call 0= \n call (ABORT\") \"SEE: not found\" \n call (.\") \": \" \n") == o
&& strstr(o, "call (SEE-CODE) ") && strstr(o, "\"IMMEDIATE\" \n call CR \n") && strlen(o) < 700, "SEE shows itself");
}
CHECK(is(say(": S4 .\" abcd\" 65 EMIT ; SEE S4\n"), ": S4\n call (.\") \"abcd\" \n @p 65 call EMIT \n ; \n ok\nok> "), "text that fills its last cell but for the count");
CHECK(is(say("SEE *\n"), out) && strstr(out, " +* unext drop drop a ; \n"), "the longest opcode name, in the capsule's multiply");
CHECK(is(say(": LG LOG-WARN\" look\" 65 EMIT ; SEE LG\n"), ": LG\n @p 1 call (LOG\") \"look\" \n @p 65 call EMIT \n ; \n ok\nok> "), "a logged message is shown as text, after its level");
CHECK(is(say("SEE NOSUCH\n"), "SEE: not found\n ok\nok> ") && is(say("SEE\n"), "SEE: not found\n ok\nok> "), "a word that is not there");
CHECK(is(say("(.\")\n"), "(.\"): compile-only\n ERROR\nok> ") && is(say("(S\")\n"), "(S\"): compile-only\n ERROR\nok> "), "the string run-time words have names but cannot be run from the prompt");
/* ---- access control with its policy loaded: ACL.fth, FORTH source ---- */
boot_bare();
CHECK(load_source("ACL.fth"), "ACL.fth compiles, every line of it");
CHECK(strstr(out, "\033[32mINFO: \033[0mACL: active\n") == out && n.mem[ACL_HOOK] != 0, "and its last line switches access control on");
CHECK(is(say(": FOO 65 EMIT ; FOO ' FOO ACL-TTL@ . FOO ' FOO ACL-TTL@ .\n"), "A256 A255 ok\nok> "), "a word's first use is rechecked and earns it a TTL, which is then counted down");
CHECK(is(say(": SFOO 66 EMIT ; ' SFOO ACL-STRICT SFOO SFOO ' SFOO ACL-TTL@ .\n"), "BB0 ok\nok> ") && is(say("' SFOO ACL-MODE@ .\n"), "1 ok\nok> "),
"a strict word is rechecked every time: its TTL stays 0");
CHECK(is(say("' SFOO ACL-TTL-MODE SFOO ' SFOO ACL-TTL@ . ' SFOO ACL-MODE@ .\n"), "B256 0 ok\nok> "), "and can be put back in TTL mode");
CHECK(is(say("' ACL-RECHECK ACL-PINNED? . ' ACL-BOOT ACL-PINNED? .\n"), "-1 -1 ok\nok> ") && is(say("' ACL-INIT-PRIMITIVES ACL-PINNED? .\n"), "-1 ok\nok> "),
"the policy's own words are pinned");
CHECK(is(say("0 ' ACL-RECHECK ACL-ALLOW! ' ACL-RECHECK ACL-STRICT ' ACL-RECHECK ACL-ALLOW@ .\n"), "-1 ok\nok> ")
&& is(say("' ACL-RECHECK ACL-MODE@ . FOO\n"), "0 A ok\nok> "), "so they cannot be denied or changed");
CHECK(is(say("0 ' FOO ACL-ALLOW! 67 EMIT FOO 68 EMIT\n"), "C\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> "), "a denied word is refused while its TTL lasts");
CHECK(is(say("0 ' FOO ACL-TTL! FOO\n"), "A ok\nok> "), "and when its TTL runs out the policy is asked again: this one allows");
CHECK(is(say(": NOFOO DUP ['] FOO = IF 0 SWAP ACL-ALLOW! ELSE ACL-RECHECK THEN ;\n"), " ok\nok> ")
&& is(say("' NOFOO ACL-HOOK ! 0 ' FOO ACL-TTL!\n"), " ok\nok> "), "a policy that denies one word");
CHECK(is(say("69 EMIT FOO\n"), "E\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> ") && is(say("SFOO : G FOO ;\n"), "B\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> ")
&& is(say("1 2 + . SFOO\n"), "3 B ok\nok> "), "that word is refused, interpreted or compiled, and nothing else is");
CHECK(is(say("1 2 HERMES-CHANNEL-OPEN? . ACL-CA-KEY-LO . ' DUP ACL-ENTRY ' DUP = .\n"), "1 0 -1 ok\nok> "), "the rest of v3's policy file is there");
CHECK(is(say("COLD\n"), "FORTH-79 Cold Start\nSystem initialized.\n ok\nok> ") && n.mem[ACL_HOOK] == 0 && is(say("ACL-BOOT\n"), "UNKNOWN WORD: 'ACL-BOOT'\n ERROR\nok> "),
"COLD takes the policy away with everything else that was loaded");
/* ---- the small system words ---- */
boot_bare();
CHECK(is(say("79-STANDARD .S\n"), "<0> \n ok\nok> "), "79-STANDARD is satisfied, and says nothing");
{
char want[64];
snprintf(want, sizeof want, "StarForth v4.0.0 F18 %d-bit\n ok\nok> ", V4_CELL_BITS);
CHECK(is(say("VERSION\n"), want), "VERSION");
}
CHECK(is(say("65 EMIT PAGE 66 EMIT\n"), "A\x1b[2J\x1b[HB ok\nok> "), "PAGE, as v3");
CHECK(is(say(": KEEPME 1 ; 1 2 3 WARM 65 EMIT\n.S KEEPME .\n"), "FORTH-79 Warm Start\nSystem restarted.\n ok\nok> <0> \n1 ok\nok> "), "WARM empties the stacks and keeps the dictionary");
{
v4_cell dp = n.mem[BOOT_CELLS];
CHECK(is(say("VOCABULARY VV VV DEFINITIONS : INVV 1 ; HEX 20 BLOCK DROP UPDATE 5 SCR !\n"), " ok\nok> ")
&& is(say("4 LOG-LEVEL!\n"), " ok\nok> "), "a vocabulary, a base, a block, a screen, a log level");
CHECK(is(say("1 2 COLD 65 EMIT\n"), "FORTH-79 Cold Start\nSystem initialized.\n ok\nok> "), "COLD says so");
CHECK(n.mem[DP] == dp && n.mem[LATEST] == capsule_latest && n.mem[CONTEXT] == LATEST && n.mem[CURRENT] == LATEST && n.mem[VOC_LINK] == 0
&& n.mem[BASE] == 10 && n.mem[SCR] == 0 && n.mem[BVARS] == 0 && n.mem[FENCE] == dp / 4 && n.mem[LOG_LEVEL] == 2, "and everything is as the loader left it");
CHECK(is(say("KEEPME\n"), "UNKNOWN WORD: 'KEEPME'\n ERROR\nok> ") && is(say("VV\n"), "UNKNOWN WORD: 'VV'\n ERROR\nok> ")
&& is(say(".S : NEW 16 . ; NEW\n"), "<0> \n16 ok\nok> "), "what was defined is gone, and the system works");
}
/* deferred words */
boot_bare();
CHECK(is(say("DEFER FOO : BAR 65 EMIT ; ' BAR IS FOO FOO\n"), "A ok\nok> "), "a deferred word does what it is given");
CHECK(is(say("DEFER@ FOO ' BAR = .\n"), "-1 ok\nok> "), "DEFER@ leaves it");
CHECK(is(say(": BAZ 66 EMIT ; : U FOO FOO ; U ' BAZ IS FOO U\n"), "AABB ok\nok> "), "a word that uses it follows the change");
CHECK(is(say(": SETB ['] BAR IS FOO ; : GET DEFER@ FOO ; SETB FOO GET ' BAR = .\n"), "A-1 ok\nok> "), "IS and DEFER@ in a definition");
CHECK(is(say("7 DEFER QUX QUX 65 EMIT\n.S\n"), "Deferred word not set\n ERROR\nok> <1> 7 \n ok\nok> "), "a deferred word with nothing set");
CHECK(is(say(": D3 1 2 3 ; ' D3 IS QUX QUX + + .\n"), "6 ok\nok> ") && is(say("DEFER\n"), "Name missing\n ERROR\nok> ") && is(say("' BAR IS NOSUCH\n"), "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> "),
"its stack effect is the word's; and the errors");
{
/* a deferred word is no deeper than the word it runs */
char line[64];
CHECK(is(say("VARIABLE V VARIABLE C DEFER RR\n"), " ok\nok> ")
&& is(say(": R1 C @ 1- DUP C ! IF RR EXIT THEN 65 EMIT ; ' R1 IS RR\n"), " ok\nok> "), "a word that runs itself through a deferred word");
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)(V4_RET_DEPTH - 4u));
CHECK(is(say(line), "A ok\nok> "), "each level takes one return entry, as a plain call does");
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)V4_RET_DEPTH);
CHECK(is(say(line), "Return stack overflow\n ERROR\nok> "), "and too many is an overflow, as for any word");
}
/* ---- vocabularies (FORTH-79) ---- */
boot_bare();
CHECK(is(say("CONTEXT @ CURRENT @ = . ORDER\n"), "-1 Search order: FORTH \nCurrent: FORTH\n ok\nok> "), "at switch-on there is FORTH");
CHECK(is(say("VOCABULARY ANIMALS ANIMALS DEFINITIONS : CAT 65 EMIT ; CAT FORTH CAT\n"), "AUNKNOWN WORD: 'CAT'\n ERROR\nok> "),
"a word defined in a vocabulary is found there and not in FORTH");
CHECK(is(say("ORDER\n"), "Search order: FORTH \nCurrent: ANIMALS\n ok\nok> "), "FORTH is CONTEXT; ANIMALS is still CURRENT");
CHECK(is(say("ANIMALS CAT 1 2 + . ORDER\n"), "A3 Search order: ANIMALS FORTH\nCurrent: ANIMALS\n ok\nok> "), "with ANIMALS as CONTEXT, FORTH is searched after it");
CHECK(is(say(": DUP 66 EMIT ; DUP FORTH 5 DUP . . ANIMALS DUP\n"), "B5 5 B ok\nok> "), "a name in both: each vocabulary has its own");
CHECK(is(say("FORTH DEFINITIONS VOCABULARY PLANTS PLANTS DEFINITIONS : CAT 67 EMIT ; CAT\n"), "C ok\nok> "), "a second vocabulary with the same name in it");
CHECK(is(say("ANIMALS CAT PLANTS CAT FORTH DEFINITIONS\n"), "AC ok\nok> "), "each finds its own");
CHECK(is(say("ANIMALS WORDS PLANTS WORDS FORTH\n"), "DUP CAT \nCAT \n ok\nok> "), "WORDS lists the CONTEXT vocabulary");
CHECK(is(say("ANIMALS CONTEXT @ CURRENT @ = . : X 1 ; CONTEXT @ CURRENT @ = .\n"), "0 -1 ok\nok> "), ": makes the CURRENT vocabulary CONTEXT");
CHECK(is(say(": T1 ANIMALS ; : T2 FORTH 68 EMIT ; T1 CAT T2 ORDER\n"), "ADSearch order: ANIMALS FORTH\nCurrent: FORTH\n ok\nok> "),
"a vocabulary's name can be compiled; FORTH is immediate");
CHECK(is(say("VOCABULARY\nFORTH\n"), "Name missing\n ERROR\nok> ok\nok> "), "VOCABULARY needs a name");
/* FORGET across vocabularies */
boot_bare();
CHECK(is(say("VOCABULARY V1 V1 DEFINITIONS : A1 1 ; FORTH DEFINITIONS : B1 2 ;\n"), " ok\nok> ")
&& is(say("V1 DEFINITIONS : A2 3 ; FORTH DEFINITIONS\n"), " ok\nok> "), "words in two vocabularies, defined turn about");
CHECK(is(say("FORGET B1 V1 A1 . A2\n"), "1 UNKNOWN WORD: 'A2'\n ERROR\nok> "), "FORGET takes what was defined later out of every vocabulary");
CHECK(is(say("B1\n"), "UNKNOWN WORD: 'B1'\n ERROR\nok> ") && is(say("V1 DEFINITIONS : A3 4 ; A1 A3 + . FORTH DEFINITIONS\n"), "5 ok\nok> "), "and the vocabulary goes on");
{
v4_cell dp;
CHECK(is(say("HERE . \n"), out) && n.mem[VOC_LINK] != 0, "(one vocabulary)");
dp = n.mem[DP];
CHECK(is(say("VOCABULARY V2 V2 DEFINITIONS : Z 1 ; VOCABULARY V3 ORDER\n"), "Search order: V2 FORTH\nCurrent: V2\n ok\nok> "), "a vocabulary that is CONTEXT and CURRENT");
CHECK(is(say("FORGET V2 ORDER\n"), "Search order: FORTH \nCurrent: FORTH\n ok\nok> ") && n.mem[DP] == dp,
"forgotten, FORTH takes its place and the space is back");
CHECK(is(say("V2\n"), "UNKNOWN WORD: 'V2'\n ERROR\nok> ") && is(say("V3\n"), "UNKNOWN WORD: 'V3'\n ERROR\nok> ")
&& is(say("V1 A1 . FORTH : OK1 65 EMIT ; OK1\n"), "1 A ok\nok> "), "its words and the vocabulary defined inside it are gone; the rest works");
CHECK(is(say("FORGET V1 FORGET V1\n"), "UNKNOWN WORD: 'V1'\n ERROR\nok> ") && n.mem[VOC_LINK] == 0, "and with V1 forgotten there is none");
}
/* ---- WORDS ---- */
boot_bare();
CHECK(is(say(": ZEBRA ; : YAK ; : HALFWAY 1\n"), " ok\nok> "), "two words and a definition under way");
{
const char *w = say("[ WORDS ]\n");
const char *p, *line = w;
unsigned longest = 0, names = 0;
CHECK(strncmp(w, "YAK ZEBRA ", 10) == 0, "WORDS starts with the newest; a definition under way is not shown");
CHECK(strstr(w, " DUP ") && strstr(w, " WORDS ") && strstr(w, " : ") && strstr(w, " ABORT\" ") && strstr(w, "UM* "), "and goes back to the capsule's first word");
CHECK(strlen(w) > 9 && strcmp(w + strlen(w) - 9, "\n ok\nok> ") == 0, "it ends with a new line");
for (p = w; *p; p++) {
if (*p == ' ') names++;
if (*p == '\n') { if ((unsigned)(p - line) > longest) longest = (unsigned)(p - line); line = p + 1; }
}
printf(" WORDS: %u names, longest line %u columns\n", names - 1u, longest);
CHECK(longest <= 64u + 32u && names > 200u, "lines are wrapped");
CHECK(is(say(";\n"), " ok\nok> ") && strncmp(say("VLIST\n"), "HALFWAY YAK ZEBRA ", 18) == 0, "VLIST is the same word; a finished definition is shown");
}
/* ---- DUMP: v3's layout, with this node's address ---- */
{
char want[256];
size_t at;
boot_bare();
CHECK(is(say("PAD 24 ERASE PAD 16 65 FILL 126 PAD 17 + C! 200 PAD 18 + C! 127 PAD 19 + C!\n"), " ok\nok> "), "sixteen A's, a zero, a tilde, a byte above 127, a DEL");
at = (size_t)snprintf(want, sizeof want, "%0*llX: ", V4_CELL_BITS / 4, (unsigned long long)PAD);
at += (size_t)snprintf(want + at, sizeof want - at, "41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 |AAAAAAAAAAAAAAAA|\n");
at += (size_t)snprintf(want + at, sizeof want - at, "%0*llX: ", V4_CELL_BITS / 4, (unsigned long long)PAD + 16);
at += (size_t)snprintf(want + at, sizeof want - at, "00 7E C8 7F |.~..|\n");
snprintf(want + at, sizeof want - at, " ok\nok> ");
CHECK(is(say("PAD 20 DUMP\n"), want), "a line and four bytes, in hex though BASE is ten");
CHECK(is(say("BASE @ 48 + EMIT\n"), ": ok\nok> "), "and BASE is put back");
CHECK(is(say("8 BASE ! PAD 24 DUMP DECIMAL\n"), want), "the same from octal");
}
/* ---- a full dictionary ---- */
boot_bare();
n.mem[DP] = (DICT_END_W - 2) * 4;
CHECK(is(say(": FULL 1 2 3 4 5 6 7 8 9 ; 65 EMIT\n"), "Dictionary full\n ERROR\nok> ") && n.mem[STATE] == 0, "a definition that does not fit");
CHECK(is(say("FULL\n"), "UNKNOWN WORD: 'FULL'\n ERROR\nok> "), "is not defined");
n.mem[DP] = (DICT_END_W - 1) * 4;
CHECK(is(say("1 , 65 EMIT\n"), "A ok\nok> ") && is(say("2 , 66 EMIT\n"), "Dictionary full\n ERROR\nok> "), "the last cell can be used; the one after it cannot");
CHECK(is(say("5 ALLOT 67 EMIT\n"), "Dictionary full\n ERROR\nok> ") && is(say("-99999 ALLOT\n"), "Dictionary full\n ERROR\nok> "), "nor can ALLOT go past either end");
CHECK(is(say("68 EMIT .S\n"), "D<0> \n ok\nok> "), "and the prompt goes on");
/* ---- the fault table: six words, each a jump to its handler ---- */
{
static const char *const handler[] = { "(FAULT)", "(D-OVER)", "(D-UNDER)", "(R-OVER)", "(R-UNDER)", "(RAISED)" };
for (i = 0; i < V4_FAULT_KINDS; i++) {
v4_iword w = (v4_iword)((v4_ucell)n.mem[w_fault + (v4_cell)i] & 0xFFFFFFFFu);
CHECK(v4_iword_op(w, 0) == V4_OP_JUMP && v4_iword_branch(w_fault + (v4_cell)i + 1, w, 0) == v4_text_word(&tx, handler[i]),
"word %u of the fault table jumps to %s", i, handler[i]);
}
CHECK(n.fault_vector == w_fault, "and the node has it");
}
CHECK(v4_node_guards_intact(&n), "guards intact");
/* ---- the kernel is told of every entry made and of every entry that goes (ENGINE.md 3b) ---- */
boot();
CHECK(is(say("5 KERNEL-WORD ASK5\n"), " ok\nok> "), "KERNEL-WORD makes a word");
CHECK(is(say("ASK5\n"), " ok\nok> ") && last_request == 5, "whose body writes its number to the port: %ld", (long)last_request);
CHECK(is(say(": TWICE ASK5 ASK5 ; TWICE\n"), " ok\nok> "), "and which a definition can call, again and again");
boot();
CHECK(is(say(": Q1 ;\n"), " ok\nok> ") && known_n == 0, "with nothing in (WORD-DEFINED) no one is told of a new entry");
CHECK(is(say("1 KERNEL-WORD KD 2 KERNEL-WORD KF\n"), " ok\nok> "), "the kernel's two words");
CHECK(is(say("' KD (WORD-DEFINED) ! ' KF (WORD-FORGOTTEN) !\n"), " ok\nok> "), "are put where the node will run them");
known_n = node_words(known, 1024); /* what was there before the kernel was listening */
n.mem[BOOT_CELLS] = n.mem[DP]; /* and all of it is the system, which COLD keeps */
n.mem[BOOT_CELLS + 1] = n.mem[LATEST];
n.mem[FENCE] = (n.mem[DP] + 3) / 4;
{
unsigned before = known_n;
CHECK(kernel_agrees() && before == 3, "the kernel starts knowing the words that are there: %u", before);
CHECK(is(say(": A1 ;\n"), " ok\nok> ") && known_n == before + 1 && kernel_agrees(), "a colon definition is told of");
CHECK(strcmp(node_name(known[known_n - 1]), "A1") == 0, "by its xt, from which its name is read: %s", node_name(known[known_n - 1]));
CHECK(is(say("VARIABLE V1 5 CONSTANT C1 CREATE D1\n"), " ok\nok> ") && known_n == before + 4 && kernel_agrees(),
"and a variable, a constant and a CREATEd word");
CHECK(is(say("VOCABULARY VOC1 VOC1 DEFINITIONS : IN1 ; FORTH DEFINITIONS : A2 ;\n"), " ok\nok> ")
&& known_n == before + 7 && kernel_agrees(), "a vocabulary, a word in it, and a word after it");
CHECK(strstr(say(": BAD NOSUCH ;\n"), "ERROR") != NULL && known_n == before + 8 && kernel_agrees(),
"a definition that is abandoned is still an entry, and is told of");
CHECK(is(say("FORGET C1\n"), " ok\nok> ") && known_n == before + 2 && kernel_agrees(),
"FORGET tells that every entry from that one up has gone: %u left of ours", known_n - before);
CHECK(is(say(": A3 ;\n"), " ok\nok> ") && known_n == before + 3 && kernel_agrees(), "and what is defined next is told of as before");
CHECK(strstr(say("FORGET KD\n"), "Protected word") != NULL && known_n == before + 3 && kernel_agrees(),
"a FORGET that is refused tells nothing");
(void)say("COLD\n");
CHECK(known_n == before && kernel_agrees(), "COLD tells that everything above the system has gone: %u", known_n);
CHECK(is(say(": A4 ; A4\n"), " ok\nok> ") && known_n == before + 1 && kernel_agrees(), "and the node goes on telling");
}
printf(" %d checks, %d failures\n", checks, failures);
return failures ? 1 : 0;
}
Reference in New Issue View Git Blame Copy Permalink