admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4.0.0): pictured output <# # #S HOLD SIGN #>; D-13

Browse Source 
DECOMPOSITION.md 5.8 only named these as "standard pictured-output
definitions over UM/MOD and a hold buffer". They are now written out
(5.8) and run on the golden model.

D-13 (ruled 2026-10-03): the hold buffer takes 63 characters, as v3's;
HOLD of a value outside 0-255, or into a full buffer, stores nothing and
sets NODE-ERROR, which is what v3 did with its error flag.

Behaviour follows v3 otherwise: digits 0-9 then A-Z, BASE outside 2..36
reads as 10, SIGN ( n -- ). Stack effects are the standard ones, as 5.8
already ruled (v3 took its double low cell on top). The buffer is 64
bytes, filled backwards from its end through HLD; `#` divides by the
base in two UM/MOD steps. HOLD, SIGN and # end in a jump to the next
word instead of a call, which saves two return-stack entries: with
calls, the signed picture `.` needs overflowed the 9-deep return stack.

New test file v4/tests/test_pictured.c, on a node of its own:
test_foundation.c's hand-assembled words already fill 901 of a node's
1024 words. It re-assembles SWAP, OR, UM/MOD, LSHIFT, RSHIFT and C! as
they are in test_foundation.c.

Checked against a C reference (short division on 16-bit limbs) at 32-
and 64-bit cells, optimised and ASan+UBSan (`make test`, `make
sanitize`), 4716 checks per width: <# #S #>, <# # # 46 HOLD #S #> and
the signed picture, in bases 10, 16, 2, 8, 36, 3 and the invalid 0, 1,
37, -5, on every pair of 15 edge cells; HOLD of 12 values; and a base-2
number that overflows the buffer (63 characters kept, NODE-ERROR set,
nothing outside the buffer written). Six mutations all fail.

Headroom: <# #S #> leaves 3 data cells and 2 return entries; the signed
picture leaves 1 return entry. The depth is C!'s as written (C! ->
LSHIFT -> SWAP), which is unchanged.

Test results on the amd64 host only. This is a development check, not
acceptance (JUSTIFICATION.md section 16).

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-03 11:37:08 -04:00
co-authored by Claude Opus 5.5
parent 2e4d1330ea
commit 6a019b8968
2 changed files with 524 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
docs/v4.0.0/DECOMPOSITION.md
+28 -4
View File
@@ -147,8 +147,8 @@ IF body1 ELSE body2 THEN → if L1 drop body1 jump L2
times, as on the F18. `FOR ... UNEXT` is the same but the body must fit in one instruction word.
**Register conventions.** `A` and `B` are caller-saved. A word that uses them says so. Words in this
document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS SEND RECV`. Words that clobber `B`:
`Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS SEND RECV`.
document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS HOLD SIGN # #S SEND RECV`. Words that clobber `B`:
`Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS <# HOLD SIGN # #S #> SEND RECV`.
**Return-stack words** (`>R R> R@ 2>R 2R> 2R@ I J UNLOOP` and the loop runtimes) are always IN.
@@ -174,6 +174,7 @@ definition below depends on one, it says so.
| **D-10** | Q48.16 width on a 64-bit-cell node (ruled 2026-10-02). | **Two cells at every cell width.** A Q value is a signed double on 32- and 64-bit nodes alike, so every Q word is the same double word at both widths. At 32-bit cells this is bit-for-bit v3's 64-bit Q. At 64-bit cells the low cell is v3's value, and where v3 wraps on Q48.16 overflow (a sum past Q max, `ABS` or `NEG` of Q min) the high cell carries the true result instead. |
| **D-11** | `Q./` semantics: division by zero, rounding, overflow (ruled 2026-10-02). | **Saturate and flag; round toward zero; saturate on overflow.** The quotient of `a * 2^16 / b` is rounded toward zero, like `SM/REM`. When it does not fit a Q value it is clamped to Q max or Q min by its sign. Division by zero returns Q max or Q min by the sign of the dividend (`0 / 0` gives 0) and sets the node's `NODE-ERROR` register (§7), which `VM-ERROR?` reads. v3 returned 0 on division by zero and saturated whenever the dividend was 2^48 or more, even when the quotient would have fit. |
| **D-12** | Q approximations outside their domain (ruled 2026-10-02). | **Return 0 and set `NODE-ERROR`.** `Q.SQRT` of a negative value and `Q.LOG` of zero or a negative value return 0 and set `NODE-ERROR` (§7), as `Q./` does on division by zero (D-11). v3 returned 0 for `ln(0)` without a flag and read negative arguments as large unsigned values. |
| **D-13** | Pictured-output hold buffer: size and errors (ruled 2026-10-03). | **63 characters, as v3; on error set `NODE-ERROR` and drop the character.** The buffer holds 63 characters at either cell width. `HOLD` of a value outside 0–255, or into a full buffer, stores nothing and sets `NODE-ERROR` (§7), which is v3's behaviour (it set its error flag and dropped the character). A full double in base 2 therefore does not fit, as in v3. |
**Consequences of D-2 that every definition must respect.** The data stack holds 10 items and the
return stack 9, and every `call`, `FOR`, `DO` loop frame and `push` uses return-stack slots. Nesting
@@ -446,7 +447,8 @@ All output reaches the console through `EMIT` (DEV).
| Word | Fate | Notes |
| --- | --- | --- |
| `<#` `#` `#S` `HOLD` `SIGN` `#>` | CAP | Standard pictured-output definitions over `UM/MOD` and a hold buffer. v3's tolerant `#>` (pops `ud` only if present) is not kept; v4 follows the standard stack effect. |
| `<#` `#` `#S` `HOLD` `SIGN` `#>` | CAP | Pictured output over `UM/MOD` and a 64-byte hold buffer, filled backwards from its end `HEND` through the pointer `HLD`. Standard stack effects (v3 took its double low cell on top, and its tolerant `#>` popped `ud` only if present; neither is kept). Otherwise v3's behaviour: digits `0`–`9` then `A`–`Z`; `BASE` outside 2–36 reads as 10; 63 characters; `HOLD` of a value outside 0–255 or into a full buffer stores nothing and sets `NODE-ERROR` (D-13). Definitions below. Executed on the golden model (2026-10-03) against a C reference in bases 2, 3, 8, 10, 16, 36 and four invalid ones. `<# #S #>` leaves its caller 3 data cells and 2 return entries; the signed picture `dup push ABS 0 <# #S pop SIGN #>` leaves 1 return entry, the depth being `C!`'s as written (`C!` → `LSHIFT` → `SWAP`). `#`, `#S`, `HOLD` and `SIGN` clobber `A` and `B`. |
| `HLD` | CAP | Variable: byte address of the first held character. |
| `.` `.R` `U.` `U.R` `D.` `D.R` | CAP | Built on pictured output and `TYPE`. |
| `.S` | RET | No visible stack pointer (D-2). |
| `?` | CAP | `@ .` |
@@ -454,6 +456,28 @@ All output reaches the console through `EMIT` (DEV).
| `BASE` | CAP | Variable. |
| `DECIMAL` `HEX` `OCTAL` | CAP | `10 BASE !` and so on. |
```forth
\ pictured output. HEND is the byte address just past the hold buffer.
: (BASE) ( -- b ) BASE b! @b dup -2 + -if L1 drop drop 10 ;
L1: drop dup -37 + -if L2 drop ; L2: drop drop 10 ;
: <# ( -- ) HEND HLD b! !b ;
: HOLD ( c -- ) dup -256 and if OKC drop jump ERR
OKC: drop HLD b! @b -(HEND-62) + -if ROOM drop
ERR: drop NODE-ERROR b! -1 !b ;
ROOM: drop HLD b! @b -1 + dup !b jump C!
: SIGN ( n -- ) -if L1 drop 45 jump HOLD L1: drop ;
: # ( ud1 -- ud2 )
0 (BASE) UM/MOD push (BASE) UM/MOD pop ROT \ qlo qhi rem
dup -10 + -if L1 drop 48 + jump L2 L1: drop 55 + L2: jump HOLD
: #S ( ud -- 0 0 ) L: # over over OR if L1 drop jump L L1: drop ;
: #> ( ud -- baddr u ) drop drop HLD b! @b HEND over push inv pop + inv ;
```
`#` divides the double by the base in two `UM/MOD` steps, the high cell first and its remainder
leading the low cell; the last remainder is the digit. `HOLD`, `SIGN` and `#` end with a jump to the
next word rather than a call, so `C!` returns straight to their caller and two return-stack entries
are saved. `ROT` is in line.
### 5.9 Strings, parsing, and input
| Word | Fate | Notes |
@@ -781,4 +805,4 @@ Addresses are assigned in the node memory map (D-4). Names only here.
| `GOV-*` | R/W | Governor parameters and Jacquard selector state (`L8-*`, decay rate). |
| `REC-ENABLE` | R/W | DoE recorder on/off (`HB-ON` / `HB-OFF`). |
| `PORT-STATUS` | R | Per-port ready flags, for non-blocking polls. |
| `NODE-ERROR` | R/W | Arithmetic error flag: set to −1 by `Q./` on division by zero (D-11) and by `Q.SQRT` / `Q.LOG` outside their domain (D-12), cleared by writing 0. `VM-ERROR?` reads it. |
| `NODE-ERROR` | R/W | Arithmetic error flag: set to −1 by `Q./` on division by zero (D-11), by `Q.SQRT` / `Q.LOG` outside their domain (D-12) and by `HOLD` on a bad character or a full buffer (D-13), cleared by writing 0. `VM-ERROR?` reads it. |
v4/tests/test_pictured.c
+496
View File
@@ -0,0 +1,496 @@
/* test_pictured.c -- pictured numeric output, executed.
*
* DECOMPOSITION.md 5.8 says only that `<# # #S HOLD SIGN #>` are "standard
* pictured-output definitions over UM/MOD and a hold buffer". This file
* writes them out, assembles them on a node of their own and runs them on
* the golden model against a C reference.
*
* It is a separate file from test_foundation.c because that file's
* hand-assembled words already fill about 900 of a node's 1024 words. The
* words these definitions rest on (SWAP, OR, UM/MOD, LSHIFT, RSHIFT, C!) are
* therefore assembled again here, opcode for opcode as in test_foundation.c,
* where each is tested on its own.
*
* Behaviour follows v3 (v3/src/word_source/format_words.c) with the standard
* stack effects 5.8 rules: digits 0-9 then A-Z; BASE outside 2..36 reads as
* 10; SIGN ( n -- ); the buffer holds 63 characters; HOLD of a value outside
* 0..255, or into a full buffer, stores nothing and sets NODE-ERROR (D-13).
*
* The buffer is filled backwards from its end through the pointer HLD, so
* `#>` returns the byte address of the first character and the count.
*/
#include "v4/asm.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)
#define MAXU ((v4_ucell)~(v4_ucell)0)
/* The memory map is open (D-4); the test puts the variables at the top of
* the node. */
#define NODE_ERROR ((v4_cell)(V4_NODE_WORDS - 2u))
#define HBUF ((v4_cell)(V4_NODE_WORDS - 32u)) /* 16 cells = 64 bytes */
#define HEND ((v4_cell)(HBUF * 4 + 64)) /* byte address past the buffer */
#define HLD ((v4_cell)(V4_NODE_WORDS - 35u)) /* byte address of the first character */
#define BASE ((v4_cell)(V4_NODE_WORDS - 34u)) /* the cell at -33, under the buffer, is left free */
#define HCAP 63
static v4_node n;
static v4_exec_state es;
static v4_heat h;
static v4_asm as;
static v4_cell w_swap, w_or, w_ummod, w_lshift, w_rshift, w_cstore,
w_base, w_begin, w_hold, w_sign, w_hash, w_hashs, w_end,
t_ud, t_signed, t_money, t_hold1;
#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 FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op)
#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as))
#define VGET(a) do { LIT(a); O(BANG_B); O(FETCH_B); } while (0)
#define VSET(a) do { LIT(a); O(BANG_B); O(STORE_B); } while (0)
#define SWAP_INLINE() do { O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); } while (0)
#define ROT_INLINE() do { O(PUSH); SWAP_INLINE(); O(RPOP); SWAP_INLINE(); } while (0)
#define SUB_INLINE() do { O(PUSH); O(INV); O(RPOP); O(ADD); O(INV); } while (0)
/* The words pictured output rests on, as in test_foundation.c. */
static void build_dependencies(void)
{
/* : 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);
/* : OR over inv and xor ; */
w_or = v4_asm_label(&as);
O(OVER); O(INV); O(AND); O(XOR); O(SEMI);
/* : UM/MOD ( ulo uhi ud -- urem uquot ) section 4, call-free */
{
v4_cell loop, l_sub, l_setbit, l_nosub;
v4_asm_ref r0, r1, r2, r3, r4, r5, r6, to_sub1, to_sub2, to_nosub1,
to_nosub2, to_setbit;
w_ummod = v4_asm_label(&as);
O(BANG_A); LIT(V4_CELL_BITS - 1); O(PUSH);
loop = v4_asm_label(&as);
r0 = FWD(MINUS_IF);
O(TWO_STAR); O(OVER);
r1 = FWD(MINUS_IF);
O(DROP); LIT(1); O(ADD);
r2 = FWD(JUMP);
HERE_(r1);
O(DROP);
HERE_(r2);
O(PUSH); O(TWO_STAR); O(RPOP);
to_sub1 = FWD(JUMP);
HERE_(r0);
O(TWO_STAR); O(OVER);
r3 = FWD(MINUS_IF);
O(DROP); LIT(1); O(ADD);
r4 = FWD(JUMP);
HERE_(r3);
O(DROP);
HERE_(r4);
O(PUSH); O(TWO_STAR); O(RPOP);
O(DUP); O(PUSH_A); O(XOR);
r5 = FWD(MINUS_IF);
O(DROP);
to_nosub1 = FWD(MINUS_IF);
to_sub2 = FWD(JUMP);
HERE_(r5);
O(DROP); O(DUP); O(INV); O(PUSH_A); O(ADD); O(INV);
r6 = FWD(MINUS_IF);
O(DROP);
to_nosub2 = FWD(JUMP);
HERE_(r6);
O(PUSH); O(DROP); O(RPOP);
to_setbit = FWD(JUMP);
l_sub = v4_asm_label(&as);
O(INV); O(PUSH_A); O(ADD); O(INV);
l_setbit = v4_asm_label(&as);
O(PUSH); LIT(1); O(ADD); O(RPOP);
l_nosub = v4_asm_label(&as);
v4_asm_branch(&as, V4_OP_NEXT, loop);
O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); O(SEMI);
v4_asm_resolve(&as, to_sub1, l_sub);
v4_asm_resolve(&as, to_sub2, l_sub);
v4_asm_resolve(&as, to_setbit, l_setbit);
v4_asm_resolve(&as, to_nosub1, l_nosub);
v4_asm_resolve(&as, to_nosub2, l_nosub);
}
/* : LSHIFT BEGIN dup WHILE 1- SWAP 2* SWAP REPEAT drop ;
* : RSHIFT BEGIN dup WHILE 1- SWAP 2/ MSB inv and SWAP REPEAT drop ; */
{
v4_cell l0;
v4_asm_ref l1;
w_lshift = v4_asm_label(&as);
l0 = v4_asm_label(&as);
O(DUP); l1 = FWD(IF);
O(DROP); LIT(-1); O(ADD); CALL(w_swap); O(TWO_STAR); CALL(w_swap);
v4_asm_branch(&as, V4_OP_JUMP, l0);
HERE_(l1);
O(DROP); O(DROP); O(SEMI);
w_rshift = v4_asm_label(&as);
l0 = v4_asm_label(&as);
O(DUP); l1 = 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);
v4_asm_branch(&as, V4_OP_JUMP, l0);
HERE_(l1);
O(DROP); O(DROP); O(SEMI);
}
/* : C! ( c baddr -- )
* dup 2 RSHIFT a! 3 and 3 LSHIFT SWAP 255 and over LSHIFT
* SWAP 255 SWAP LSHIFT inv @ and OR ! ; */
w_cstore = v4_asm_label(&as);
O(DUP); LIT(2); CALL(w_rshift); O(BANG_A);
LIT(3); O(AND); LIT(3); CALL(w_lshift);
CALL(w_swap); LIT(255); O(AND); O(OVER); CALL(w_lshift);
CALL(w_swap); LIT(255); CALL(w_swap); CALL(w_lshift); O(INV);
O(FETCH_A); O(AND); CALL(w_or); O(STORE_A); O(SEMI);
}
/* Pictured output, 5.8. */
static void build_pictured(void)
{
v4_asm_ref a, b, c;
v4_cell l;
/* : (BASE) ( -- b ) BASE, or 10 when it is outside 2..36
* BASE b! @b dup -2 + -if L1 drop drop 10 ;
* L1: drop dup -37 + -if L2 drop ;
* L2: drop drop 10 ; */
w_base = v4_asm_label(&as);
VGET(BASE); O(DUP); LIT(-2); O(ADD); a = FWD(MINUS_IF);
O(DROP); O(DROP); LIT(10); O(SEMI);
HERE_(a);
O(DROP); O(DUP); LIT(-37); O(ADD); b = FWD(MINUS_IF);
O(DROP); O(SEMI);
HERE_(b);
O(DROP); O(DROP); LIT(10); O(SEMI);
/* : <# ( -- ) HEND HLD b! !b ; */
w_begin = v4_asm_label(&as);
LIT(HEND); VSET(HLD); O(SEMI);
/* : HOLD ( c -- ) D-13
* dup -256 and if OKC drop jump ERR c outside 0..255
* OKC: drop HLD b! @b -(HEND-62) + -if ROOM drop 63 held already
* ERR: drop NODE-ERROR b! -1 !b ;
* ROOM: drop HLD b! @b -1 + dup !b jump C!
* The last step is a jump, not a call: C! returns to HOLD's caller. */
w_hold = v4_asm_label(&as);
O(DUP); LIT(-256); O(AND); a = FWD(IF);
O(DROP); b = FWD(JUMP);
HERE_(a);
O(DROP); VGET(HLD); LIT(-(HEND - 62)); O(ADD); c = FWD(MINUS_IF);
O(DROP);
HERE_(b);
O(DROP); LIT(NODE_ERROR); O(BANG_B); LIT(-1); O(STORE_B); O(SEMI);
HERE_(c);
O(DROP); VGET(HLD); LIT(-1); O(ADD); O(DUP); O(STORE_B);
v4_asm_branch(&as, V4_OP_JUMP, w_cstore);
/* : SIGN ( n -- ) -if L1 drop 45 jump HOLD L1: drop ; */
w_sign = v4_asm_label(&as);
a = FWD(MINUS_IF);
O(DROP); LIT(45); v4_asm_branch(&as, V4_OP_JUMP, w_hold);
HERE_(a);
O(DROP); O(SEMI);
/* : # ( ud1 -- ud2 )
* ud1 / base in two UM/MOD steps, the high cell first and its remainder
* leading the low cell; the last remainder is the digit.
* 0 (BASE) UM/MOD push (BASE) UM/MOD pop ROT qlo qhi rem
* dup -10 + -if L1 drop 48 + jump L2 L1: drop 55 + L2: jump HOLD */
w_hash = v4_asm_label(&as);
LIT(0); CALL(w_base); CALL(w_ummod); O(PUSH);
CALL(w_base); CALL(w_ummod); O(RPOP); ROT_INLINE();
O(DUP); LIT(-10); O(ADD); a = FWD(MINUS_IF);
O(DROP); LIT(48); O(ADD); b = FWD(JUMP);
HERE_(a);
O(DROP); LIT(55); O(ADD);
HERE_(b);
v4_asm_branch(&as, V4_OP_JUMP, w_hold);
/* : #S ( ud -- 0 0 ) L: # over over OR if L1 drop jump L L1: drop ; */
w_hashs = v4_asm_label(&as);
l = v4_asm_label(&as);
CALL(w_hash); O(OVER); O(OVER); CALL(w_or); a = FWD(IF);
O(DROP); v4_asm_branch(&as, V4_OP_JUMP, l);
HERE_(a);
O(DROP); O(SEMI);
/* : #> ( ud -- baddr u ) drop drop HLD b! @b HEND over push inv pop + inv ; */
w_end = v4_asm_label(&as);
O(DROP); O(DROP); VGET(HLD); LIT(HEND); O(OVER); SUB_INLINE(); O(SEMI);
/* How they are used. */
/* ( ud -- baddr u ) <# #S #> */
t_ud = v4_asm_label(&as);
CALL(w_begin); CALL(w_hashs); CALL(w_end); O(SEMI);
/* ( n -- baddr u ) dup push ABS 0 <# #S pop SIGN #> as `.` does */
t_signed = v4_asm_label(&as);
O(DUP); O(PUSH);
a = FWD(MINUS_IF); O(INV); LIT(1); O(ADD); HERE_(a);
LIT(0); CALL(w_begin); CALL(w_hashs); O(RPOP); CALL(w_sign); CALL(w_end); O(SEMI);
/* ( ud -- baddr u ) <# # # 46 HOLD #S #> two places, a point, the rest */
t_money = v4_asm_label(&as);
CALL(w_begin); CALL(w_hash); CALL(w_hash); LIT(46); CALL(w_hold);
CALL(w_hashs); CALL(w_end); O(SEMI);
/* ( c -- baddr u ) <# HOLD 0 0 #> */
t_hold1 = v4_asm_label(&as);
CALL(w_begin); CALL(w_hold); LIT(0); LIT(0); CALL(w_end); O(SEMI);
}
/* ---- running ---------------------------------------------------------- */
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_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;
}
/* The string `#>` left: its bytes read out of the node, and the canary
* under ( baddr u ). */
static int result_string(char *out, unsigned cap)
{
v4_cell u = v4_dstack_pop(&n.ds), baddr = v4_dstack_pop(&n.ds);
unsigned i;
if (v4_dstack_pop(&n.ds) != CANARY) return -1;
if (u < 0 || (unsigned)u >= cap) return -1;
for (i = 0; i < (unsigned)u; i++) {
v4_cell ba = baddr + (v4_cell)i;
v4_ucell w = (v4_ucell)v4_node_load(&n, ba >> 2);
out[i] = (char)((w >> (8u * (unsigned)(ba & 3))) & 0xFFu);
}
out[u] = 0;
return (int)u;
}
/* Stack headroom, as in test_foundation.c: run `word` with `dfill` marked
* cells under the canary and `rfill` under its return address; the string,
* the canary and every marked cell must come back intact. */
static int fits(v4_cell word, unsigned argc, v4_cell a, v4_cell b, const char *want,
unsigned dfill, unsigned rfill)
{
char got[4 * V4_CELL_BITS];
unsigned i;
v4_dstack_reset(&n.ds);
v4_rstack_reset(&n.rs);
v4_exec_reset(&es);
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 (result_string(got, sizeof got) < 0 || strcmp(got, want) != 0) 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 char *want, int *dh, int *rh)
{
int d, r;
for (d = 0; d < V4_DATA_DEPTH; d++) if (!fits(word, argc, a, b, want, (unsigned)d + 1u, 0)) break;
for (r = 0; r < V4_RET_DEPTH; r++) if (!fits(word, argc, a, b, want, 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);
}
/* ---- the C reference ---------------------------------------------------- */
#define LIMBS (2 * V4_CELL_BITS / 16)
/* The digits of the unsigned double hi:lo in `base` (2..36), most
* significant first, "0" for zero, by short division on 16-bit limbs. */
static unsigned ref_digits(v4_ucell lo, v4_ucell hi, unsigned base, char *out)
{
uint32_t l[LIMBS];
char tmp[2 * V4_CELL_BITS + 1];
unsigned i, len = 0;
for (i = 0; i < LIMBS / 2; i++) {
l[i] = (uint32_t)((lo >> (16 * i)) & 0xFFFFu);
l[i + LIMBS / 2] = (uint32_t)((hi >> (16 * i)) & 0xFFFFu);
}
for (;;) {
uint32_t rem = 0;
int nonzero = 0;
for (i = LIMBS; i-- > 0; ) {
uint32_t v = (rem << 16) | l[i];
l[i] = v / base;
rem = v % base;
if (l[i]) nonzero = 1;
}
tmp[len++] = (char)(rem < 10 ? '0' + rem : 'A' + (rem - 10));
if (!nonzero) break;
}
for (i = 0; i < len; i++) out[i] = tmp[len - 1 - i];
out[len] = 0;
return len;
}
/* What the buffer holds after the characters of `full` have been held from
* its last to its first: the last HCAP of them, and whether any were
* dropped (D-13). */
static int ref_truncate(const char *full, char *out)
{
size_t len = strlen(full);
if (len > HCAP) { strcpy(out, full + (len - HCAP)); return 1; }
strcpy(out, full);
return 0;
}
static unsigned eff_base(v4_cell b) { return (b < 2 || b > 36) ? 10u : (unsigned)b; }
static const v4_cell vec[] = {
0, 1, 2, 9, 10, 35, 36, 255, 12345, -1, -2, -12345,
(v4_cell)(V4_MSB - 1u), (v4_cell)V4_MSB, (v4_cell)(MAXU / 3u)
};
#define NVEC (sizeof vec / sizeof vec[0])
static const v4_cell bases[] = { 10, 16, 2, 8, 36, 3, 0, 1, 37, -5 };
#define NBASE (sizeof bases / sizeof bases[0])
int main(void)
{
char got[4 * V4_CELL_BITS], full[4 * V4_CELL_BITS], want[4 * V4_CELL_BITS];
printf("v4 pictured-output tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
v4_node_reset(&n);
v4_asm_begin(&as, &n, 16);
build_dependencies();
build_pictured();
CHECK(v4_asm_ok(&as), "pictured-output words assemble");
CHECK(v4_asm_label(&as) < HLD, "code stays below the variables");
for (unsigned bi = 0; bi < NBASE; bi++) {
unsigned base = eff_base(bases[bi]);
/* <# #S #> on unsigned doubles */
for (unsigned i = 0; i < NVEC; i++)
for (unsigned j = 0; j < NVEC; j++) {
int over;
(void)ref_digits((v4_ucell)vec[i], (v4_ucell)vec[j], base, full);
over = ref_truncate(full, want);
v4_node_store(&n, BASE, bases[bi]);
v4_node_store(&n, NODE_ERROR, 0);
CHECK(call(t_ud, 2, vec[i], vec[j]) && result_string(got, sizeof got) >= 0
&& strcmp(got, want) == 0
&& v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0),
"<# #S #> base %ld [%u,%u]: got \"%s\" want \"%s\"",
(long)bases[bi], i, j, got, want);
/* <# # # 46 HOLD #S #> */
{
size_t len = strlen(full);
char pad[4 * V4_CELL_BITS], pic[4 * V4_CELL_BITS];
if (len < 3) { memset(pad, '0', 3 - len); strcpy(pad + (3 - len), full); }
else strcpy(pad, full);
len = strlen(pad);
memcpy(pic, pad, len - 2);
pic[len - 2] = '.';
memcpy(pic + len - 1, pad + len - 2, 2);
pic[len + 1] = 0;
over = ref_truncate(pic, want);
v4_node_store(&n, NODE_ERROR, 0);
CHECK(call(t_money, 2, vec[i], vec[j]) && result_string(got, sizeof got) >= 0
&& strcmp(got, want) == 0
&& v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0),
"<# # # . #S #> base %ld [%u,%u]: got \"%s\" want \"%s\"",
(long)bases[bi], i, j, got, want);
}
}
/* dup push ABS 0 <# #S pop SIGN #> on signed singles */
for (unsigned i = 0; i < NVEC; i++) {
v4_cell v = vec[i];
v4_ucell mag = v < 0 ? (v4_ucell)0 - (v4_ucell)v : (v4_ucell)v;
int over;
full[0] = '-';
(void)ref_digits(mag, 0, base, full + (v < 0 ? 1 : 0));
over = ref_truncate(full, want);
v4_node_store(&n, BASE, bases[bi]);
v4_node_store(&n, NODE_ERROR, 0);
CHECK(call(t_signed, 1, v, 0) && result_string(got, sizeof got) >= 0
&& strcmp(got, want) == 0
&& v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0),
"signed base %ld [%u]: got \"%s\" want \"%s\"", (long)bases[bi], i, got, want);
}
}
/* HOLD: any byte is kept; anything else is dropped and flagged. */
{
static const v4_cell hv[] = { 0, 1, 32, 45, 65, 127, 128, 255, 256, 257, -1, 65536 };
for (unsigned i = 0; i < sizeof hv / sizeof hv[0]; i++) {
int ok = hv[i] >= 0 && hv[i] <= 255, len;
v4_node_store(&n, NODE_ERROR, 0);
CHECK(call(t_hold1, 1, hv[i], 0), "HOLD returns [%u]", i);
{
v4_cell u = v4_dstack_pop(&n.ds), baddr = v4_dstack_pop(&n.ds);
v4_ucell w = (v4_ucell)v4_node_load(&n, (HEND - 1) >> 2);
len = (int)u;
CHECK(v4_dstack_pop(&n.ds) == CANARY, "HOLD canary [%u]", i);
CHECK(len == (ok ? 1 : 0) && baddr == HEND - len, "HOLD count [%u]: %d", i, len);
if (ok)
CHECK(((w >> (8u * (unsigned)((HEND - 1) & 3))) & 0xFFu) == (v4_ucell)hv[i],
"HOLD stores [%u]", i);
}
CHECK(v4_node_load(&n, NODE_ERROR) == (ok ? 0 : -1), "HOLD NODE-ERROR [%u]", i);
}
}
/* The cell just below the buffer and the variables above it are never
* written by a number that overflows (base 2, all ones). */
{
v4_node_store(&n, HBUF - 1, (v4_cell)0x5EED5EED);
v4_node_store(&n, BASE, 2);
v4_node_store(&n, NODE_ERROR, 0);
CHECK(call(t_ud, 2, -1, -1) && result_string(got, sizeof got) == HCAP,
"overflowing number leaves %d characters", HCAP);
CHECK(v4_node_load(&n, NODE_ERROR) == -1, "overflowing number sets NODE-ERROR");
CHECK(v4_node_load(&n, HBUF - 1) == (v4_cell)0x5EED5EED, "cell below the buffer untouched");
CHECK(v4_node_load(&n, BASE) == 2, "BASE untouched");
/* the first byte of the buffer is the one v3 also leaves spare */
CHECK(v4_node_load(&n, HLD) == HEND - HCAP, "HLD stops one byte above the buffer's start");
}
/* What the pictures leave their caller (D-2). */
{
int dh, rh;
v4_node_store(&n, BASE, 10);
headroom("<# #S #>", t_ud, 2, 12345, 0, "12345", &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "<# #S #> leaves room");
headroom("signed picture", t_signed, 1, -12345, 0, "-12345", &dh, &rh);
CHECK(dh >= 2 && rh >= 1, "the signed picture leaves room");
}
CHECK(v4_node_guards_intact(&n), "guards intact");
printf(" %d checks, %d failures\n", checks, failures);
return failures ? 1 : 0;
}