One case per byte position, like C!: the cell is shifted down with a 2/ loop and masked. It replaces the version built on LSHIFT, RSHIFT and SWAP calls. C@ now leaves its caller 7 return entries (was 4), and the words above it gain with it: TYPE 6 (was 3), DUMP 4, Q.PRINT, U. and U.R 3 (were 2). The signed number words stay at 2: their sign waits on the return stack. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
309 lines
12 KiB
C
309 lines
12 KiB
C
/* test_terminal.c -- EMIT, CR, SPACE and TYPE, executed.
|
|
*
|
|
* DECOMPOSITION.md 5.10. EMIT is a device service; on the single-node model
|
|
* it is a store to the CONSOLE-TX capture register (node.h), so what these
|
|
* words print can be read back and compared with v3.
|
|
*
|
|
* v3 (v3/src/word_source/io_words.c): EMIT prints the low byte of the cell;
|
|
* CR prints character 10; SPACE prints a blank; TYPE ( addr u -- ) prints u
|
|
* bytes, nothing for u = 0, and for u < 0 prints nothing and raises its error
|
|
* flag. v4 sets NODE-ERROR in that last case, as D-13 does for HOLD.
|
|
*
|
|
* Two transcripts of the real v3 binary are recorded below as expected
|
|
* output. They were taken on 2026-10-03 from
|
|
* printf '<script>\n' | build/amd64/standard/starforth -s
|
|
* as the text between "System initialization complete." and "Goodbye!".
|
|
*
|
|
* On a node of its own, like test_pictured.c. SWAP, LSHIFT, RSHIFT and C@
|
|
* (call-free, so it no longer uses the other three)
|
|
* are assembled again here as they are in test_foundation.c.
|
|
*/
|
|
#include "v4/asm.h"
|
|
#include "v4/testcode.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)
|
|
|
|
/* The memory map is open (D-4); the test chooses the addresses. */
|
|
#define NODE_ERROR ((v4_cell)(V4_NODE_WORDS - 2u))
|
|
#define CONSOLE_TX ((v4_cell)(V4_NODE_WORDS - 4u))
|
|
#define STRINGS ((v4_cell)(V4_NODE_WORDS - 64u)) /* 32 cells of byte-packed text */
|
|
#define STR_BADDR ((v4_cell)(STRINGS * 4))
|
|
|
|
static v4_node n;
|
|
static v4_exec_state es;
|
|
static v4_heat h;
|
|
static v4_asm as;
|
|
|
|
static v4_cell w_swap, w_lshift, w_rshift, w_cfetch,
|
|
w_emit, w_cr, w_space, w_type, t_v3a, t_v3b;
|
|
|
|
#define O(name) v4_asm_op(&as, V4_OP_##name)
|
|
#define LIT(v) v4_asm_lit(&as, (v4_cell)(v))
|
|
#define CALL(w) v4_asm_branch(&as, V4_OP_CALL, (w))
|
|
#define JUMP(w) v4_asm_branch(&as, V4_OP_JUMP, (w))
|
|
#define FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op)
|
|
#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as))
|
|
|
|
/* Byte-packed text in node memory: four bytes to a cell, little-endian. */
|
|
static void put_bytes(v4_cell baddr, const unsigned char *s, unsigned len)
|
|
{
|
|
unsigned i;
|
|
for (i = 0; i < len; i++) {
|
|
v4_cell ba = baddr + (v4_cell)i;
|
|
unsigned sh = 8u * (unsigned)(ba & 3);
|
|
v4_ucell w = (v4_ucell)n.mem[ba >> 2];
|
|
w = (w & ~((v4_ucell)0xFFu << sh)) | ((v4_ucell)s[i] << sh);
|
|
n.mem[ba >> 2] = (v4_cell)w;
|
|
}
|
|
}
|
|
|
|
static void build(void)
|
|
{
|
|
v4_asm_ref a, b;
|
|
v4_cell l;
|
|
|
|
/* ---- the words these rest on, as in test_foundation.c ---- */
|
|
|
|
/* : SWAP over push push drop pop pop ; */
|
|
w_swap = v4_asm_label(&as);
|
|
O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); O(SEMI);
|
|
|
|
/* : LSHIFT BEGIN dup WHILE 1- SWAP 2* SWAP REPEAT drop ;
|
|
* : RSHIFT BEGIN dup WHILE 1- SWAP 2/ MSB inv and SWAP REPEAT drop ; */
|
|
w_lshift = v4_asm_label(&as);
|
|
l = v4_asm_label(&as);
|
|
O(DUP); a = FWD(IF);
|
|
O(DROP); LIT(-1); O(ADD); CALL(w_swap); O(TWO_STAR); CALL(w_swap);
|
|
JUMP(l);
|
|
HERE_(a);
|
|
O(DROP); O(DROP); O(SEMI);
|
|
|
|
w_rshift = v4_asm_label(&as);
|
|
l = v4_asm_label(&as);
|
|
O(DUP); a = FWD(IF);
|
|
O(DROP); LIT(-1); O(ADD); CALL(w_swap);
|
|
O(TWO_SLASH); LIT((v4_cell)V4_MSB); O(INV); O(AND); CALL(w_swap);
|
|
JUMP(l);
|
|
HERE_(a);
|
|
O(DROP); O(DROP); O(SEMI);
|
|
|
|
/* : C@ ( baddr -- c ) call-free, 5.3
|
|
* dup 2/ 2/ a! 3 and k A: word address
|
|
* if K0 -1 + if K1 -1 + if K2
|
|
* drop @ 23 FOR 2/ UNEXT 255 and ; byte 3
|
|
* K2: drop @ 15 FOR 2/ UNEXT 255 and ; byte 2
|
|
* K1: drop @ 7 FOR 2/ UNEXT 255 and ; byte 1
|
|
* K0: drop @ 255 and ; byte 0 */
|
|
w_cfetch = v4_asm_label(&as);
|
|
{
|
|
v4_asm_ref f0, f1, f2;
|
|
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); LIT(3); O(AND);
|
|
f0 = v4_asm_branch_fwd(&as, V4_OP_IF);
|
|
LIT(-1); O(ADD); f1 = v4_asm_branch_fwd(&as, V4_OP_IF);
|
|
LIT(-1); O(ADD); f2 = v4_asm_branch_fwd(&as, V4_OP_IF);
|
|
O(DROP); O(FETCH_A); LIT(23); O(PUSH);
|
|
(void)v4_asm_label(&as);
|
|
O(TWO_SLASH); O(UNEXT);
|
|
LIT(255); O(AND); O(SEMI);
|
|
v4_asm_resolve(&as, f2, v4_asm_label(&as));
|
|
O(DROP); O(FETCH_A); LIT(15); O(PUSH);
|
|
(void)v4_asm_label(&as);
|
|
O(TWO_SLASH); O(UNEXT);
|
|
LIT(255); O(AND); O(SEMI);
|
|
v4_asm_resolve(&as, f1, v4_asm_label(&as));
|
|
O(DROP); O(FETCH_A); LIT(7); O(PUSH);
|
|
(void)v4_asm_label(&as);
|
|
O(TWO_SLASH); O(UNEXT);
|
|
LIT(255); O(AND); O(SEMI);
|
|
v4_asm_resolve(&as, f0, v4_asm_label(&as));
|
|
O(DROP); O(FETCH_A); LIT(255); O(AND); O(SEMI);
|
|
}
|
|
|
|
/* ---- terminal output, 5.10 ---- */
|
|
|
|
/* : EMIT ( c -- ) CONSOLE-TX b! !b ; */
|
|
w_emit = v4_asm_label(&as);
|
|
LIT(CONSOLE_TX); O(BANG_B); O(STORE_B); O(SEMI);
|
|
|
|
/* : CR ( -- ) 10 jump EMIT : SPACE ( -- ) 32 jump EMIT */
|
|
w_cr = v4_asm_label(&as);
|
|
LIT(10); JUMP(w_emit);
|
|
w_space = v4_asm_label(&as);
|
|
LIT(32); JUMP(w_emit);
|
|
|
|
/* : TYPE ( baddr u -- )
|
|
* -if OK drop drop NODE-ERROR b! -1 !b ; u < 0
|
|
* OK: if DONE u = 0
|
|
* over C@ EMIT push 1 + pop -1 + jump OK
|
|
* DONE: drop drop ; */
|
|
w_type = v4_asm_label(&as);
|
|
a = FWD(MINUS_IF);
|
|
O(DROP); O(DROP); LIT(NODE_ERROR); O(BANG_B); LIT(-1); O(STORE_B); O(SEMI);
|
|
HERE_(a);
|
|
l = v4_asm_label(&as);
|
|
b = FWD(IF);
|
|
O(OVER); CALL(w_cfetch); CALL(w_emit);
|
|
O(PUSH); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
|
|
JUMP(l);
|
|
HERE_(b);
|
|
O(DROP); O(DROP); O(SEMI);
|
|
|
|
/* ---- the two v3 transcripts ---- */
|
|
|
|
/* 65 EMIT 66 EMIT SPACE 67 EMIT CR 68 EMIT 321 EMIT */
|
|
t_v3a = v4_asm_label(&as);
|
|
LIT(65); CALL(w_emit); LIT(66); CALL(w_emit); CALL(w_space);
|
|
LIT(67); CALL(w_emit); CALL(w_cr); LIT(68); CALL(w_emit);
|
|
LIT(321); CALL(w_emit); O(SEMI);
|
|
|
|
/* S" Hello, v3" TYPE 91 EMIT <"xyz"> 0 TYPE 93 EMIT */
|
|
t_v3b = v4_asm_label(&as);
|
|
LIT(STR_BADDR); LIT(9); CALL(w_type); LIT(91); CALL(w_emit);
|
|
LIT(STR_BADDR + 16); LIT(0); CALL(w_type); LIT(93); CALL(w_emit); O(SEMI);
|
|
}
|
|
|
|
static int call(v4_cell word, unsigned argc, v4_cell a, v4_cell b)
|
|
{
|
|
v4_dstack_reset(&n.ds);
|
|
v4_rstack_reset(&n.rs);
|
|
v4_exec_reset(&es);
|
|
v4_heat_reset(&h);
|
|
v4_node_console_attach(&n, CONSOLE_TX);
|
|
v4_node_store(&n, NODE_ERROR, 0);
|
|
v4_dstack_push(&n.ds, CANARY);
|
|
if (argc > 0) v4_dstack_push(&n.ds, a);
|
|
if (argc > 1) v4_dstack_push(&n.ds, b);
|
|
return v4_test_call(&n, &es, &h, word, 4000000) > 0 && n.ds.t == CANARY;
|
|
}
|
|
|
|
/* What was printed, exactly. */
|
|
static int printed(const void *want, unsigned len)
|
|
{
|
|
return n.console_len == len && n.console_dropped == 0
|
|
&& (len == 0 || memcmp(n.console, want, len) == 0);
|
|
}
|
|
|
|
/* Stack headroom, as in test_foundation.c. */
|
|
static int fits(v4_cell word, unsigned argc, v4_cell a, v4_cell b,
|
|
const void *want, unsigned len, unsigned dfill, unsigned rfill)
|
|
{
|
|
unsigned i;
|
|
v4_dstack_reset(&n.ds);
|
|
v4_rstack_reset(&n.rs);
|
|
v4_exec_reset(&es);
|
|
v4_node_console_attach(&n, CONSOLE_TX);
|
|
for (i = 0; i < dfill; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
|
|
v4_dstack_push(&n.ds, CANARY);
|
|
if (argc > 0) v4_dstack_push(&n.ds, a);
|
|
if (argc > 1) v4_dstack_push(&n.ds, b);
|
|
for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i));
|
|
if (v4_test_call(&n, &es, &h, word, 4000000) <= 0) return 0;
|
|
if (!printed(want, len)) return 0;
|
|
if (v4_dstack_pop(&n.ds) != CANARY) return 0;
|
|
for (i = dfill; i-- > 0; ) if (v4_dstack_pop(&n.ds) != (v4_cell)(0x5A000000 + i)) return 0;
|
|
for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + i)) return 0;
|
|
return 1;
|
|
}
|
|
static void headroom(const char *name, v4_cell word, unsigned argc, v4_cell a, v4_cell b,
|
|
const void *want, unsigned len, int *dh, int *rh)
|
|
{
|
|
int d, r;
|
|
for (d = 0; d < V4_DATA_DEPTH; d++) if (!fits(word, argc, a, b, want, len, (unsigned)d + 1u, 0)) break;
|
|
for (r = 0; r < V4_RET_DEPTH; r++) if (!fits(word, argc, a, b, want, len, 0, (unsigned)r + 1u)) break;
|
|
*dh = d; *rh = r;
|
|
printf(" %s headroom: data %d below canary, return %d below its return address\n", name, d, r);
|
|
}
|
|
|
|
int main(void)
|
|
{
|
|
static const unsigned char text[] =
|
|
"Hello, v3\0\0\0\0\0\0\0xyz The quick brown fox jumps over the lazy dog. 0123456789";
|
|
unsigned char hi[40];
|
|
unsigned i;
|
|
|
|
printf("v4 terminal-output tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
|
|
|
|
v4_node_reset(&n);
|
|
v4_asm_begin(&as, &n, 16);
|
|
build();
|
|
CHECK(v4_asm_ok(&as), "terminal words assemble");
|
|
CHECK(v4_asm_label(&as) < STRINGS, "code stays below the text");
|
|
put_bytes(STR_BADDR, text, sizeof text - 1);
|
|
|
|
/* The two v3 transcripts. */
|
|
CHECK(call(t_v3a, 0, 0, 0) && printed("AB C\nDA", 7),
|
|
"v3: 65 EMIT 66 EMIT SPACE 67 EMIT CR 68 EMIT 321 EMIT prints \"AB C\\nDA\"");
|
|
CHECK(call(t_v3b, 0, 0, 0) && printed("Hello, v3[]", 11),
|
|
"v3: \"Hello, v3\" TYPE 91 EMIT <text> 0 TYPE 93 EMIT prints \"Hello, v3[]\"");
|
|
|
|
/* EMIT: every byte, and only the low byte of anything wider. */
|
|
for (i = 0; i < 256; i++) {
|
|
unsigned char c = (unsigned char)i;
|
|
CHECK(call(w_emit, 1, (v4_cell)i, 0) && printed(&c, 1), "EMIT %u", i);
|
|
}
|
|
{
|
|
static const v4_cell wide[] = { 256, 321, 0x1234, -1, -191, 65536 + 65 };
|
|
for (i = 0; i < sizeof wide / sizeof wide[0]; i++) {
|
|
unsigned char c = (unsigned char)((v4_ucell)wide[i] & 0xFFu);
|
|
CHECK(call(w_emit, 1, wide[i], 0) && printed(&c, 1), "EMIT low byte [%u]", i);
|
|
}
|
|
}
|
|
|
|
/* CR and SPACE. */
|
|
CHECK(call(w_cr, 0, 0, 0) && printed("\n", 1), "CR prints character 10");
|
|
CHECK(call(w_space, 0, 0, 0) && printed(" ", 1), "SPACE prints a blank");
|
|
|
|
/* TYPE: every start within a cell, lengths 0 .. 40. */
|
|
for (unsigned off = 0; off < 8; off++)
|
|
for (unsigned len = 0; len <= 40; len++) {
|
|
CHECK(call(w_type, 2, STR_BADDR + 16 + (v4_cell)off, (v4_cell)len)
|
|
&& printed(text + 16 + off, len), "TYPE [%u,%u]", off, len);
|
|
CHECK(v4_node_load(&n, NODE_ERROR) == 0, "TYPE no error [%u,%u]", off, len);
|
|
}
|
|
|
|
/* TYPE of bytes with the top bit set, and of zero bytes. */
|
|
for (i = 0; i < sizeof hi; i++) hi[i] = (unsigned char)(i < 20 ? 0x80u + i * 6u : (i & 1u ? 0xFFu : 0u));
|
|
put_bytes(STR_BADDR + 80, hi, sizeof hi);
|
|
CHECK(call(w_type, 2, STR_BADDR + 80, (v4_cell)sizeof hi) && printed(hi, sizeof hi),
|
|
"TYPE of high and zero bytes");
|
|
|
|
/* TYPE with a negative count: nothing printed, NODE-ERROR set. */
|
|
{
|
|
static const v4_cell neg[] = { -1, -2, -12345, (v4_cell)V4_MSB };
|
|
for (i = 0; i < sizeof neg / sizeof neg[0]; i++) {
|
|
CHECK(call(w_type, 2, STR_BADDR, neg[i]) && printed("", 0), "TYPE negative count prints nothing [%u]", i);
|
|
CHECK(v4_node_load(&n, NODE_ERROR) == -1, "TYPE negative count sets NODE-ERROR [%u]", i);
|
|
}
|
|
}
|
|
|
|
/* TYPE writes no memory. */
|
|
{
|
|
v4_cell before[32];
|
|
for (i = 0; i < 32; i++) before[i] = n.mem[STRINGS + (v4_cell)i];
|
|
CHECK(call(w_type, 2, STR_BADDR + 3, 37), "TYPE runs");
|
|
for (i = 0; i < 32; i++) if (before[i] != n.mem[STRINGS + (v4_cell)i]) break;
|
|
CHECK(i == 32, "TYPE leaves the text untouched");
|
|
CHECK(n.mem[CONSOLE_TX] == 0, "and the register's memory word");
|
|
}
|
|
|
|
/* What they leave their caller (D-2). */
|
|
{
|
|
int dh, rh;
|
|
headroom("EMIT", w_emit, 1, 65, 0, "A", 1, &dh, &rh);
|
|
CHECK(dh >= 7 && rh >= 7, "EMIT leaves room");
|
|
headroom("CR", w_cr, 0, 0, 0, "\n", 1, &dh, &rh);
|
|
headroom("TYPE", w_type, 2, STR_BADDR + 17, 9, text + 17, 9, &dh, &rh);
|
|
CHECK(dh >= 5 && rh >= 6, "TYPE leaves room");
|
|
}
|
|
|
|
CHECK(v4_node_guards_intact(&n), "guards intact");
|
|
|
|
printf(" %d checks, %d failures\n", checks, failures);
|
|
return failures ? 1 : 0;
|
|
}
|