admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a041b401ea34fbf528a2ce9925ccbc4f89a8dc49
LithosAnanake/v4/tests/test_loops.c
T
rajamesandClaude Opus 5.5 e178a76c36 fix(v4.0.0): LEAVE follows FORTH-79 
LEAVE sets the limit equal to the index: the rest of the body runs with
the index unchanged and the loop ends at the next LOOP or +LOOP.  v3's
left the loop at once, which is FORTH-83's.

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

475 lines
22 KiB
C
Raw Blame History

/* test_loops.c -- the DO loop runtimes, executed.
*
* DECOMPOSITION.md 5.18: (DO) (?DO) (LOOP) (+LOOP) (LEAVE) I J UNLOOP and
* (0BRANCH). None of these is a word in v4: each is a short sequence the
* compiler lays down in line, with the loop's limit and index on the return
* stack (limit below index). This file lays them down by hand, as the
* compiler will, inside small test words, runs those on the golden model and
* compares what each loop body saw with C and with v3.
*
* v3 (v3/src/word_source/control_words.c):
* DO the body always runs once
* ?DO skips the loop when index = limit
* LOOP adds 1 and goes round again while index < limit, signed
* +LOOP ( n -- ) adds n and goes round again while index < limit for
* n >= 0, while index >= limit for n < 0
* LEAVE FORTH-79 (ruled 2026-10-04): sets the limit equal to the
* index, so the loop ends at the next LOOP or +LOOP; the index is
* unchanged and the rest of the body still runs. v3's LEAVE left
* the loop at once, which is FORTH-83's.
* I J the index of this loop, of the loop outside it
* UNLOOP discards the loop's limit and index, for EXIT
* So `0 5 DO .. LOOP` runs once in v3 and here; 5.18's first (LOOP), which
* tested for index = limit, would have gone round the whole number circle.
*
* v3's LEAVE also left the loop's limit and index on its return stack, which
* is invisible in a single loop but breaks an outer one: in v3
* : T 3 0 DO 10 0 DO I . I 1 = IF LEAVE THEN LOOP I . LOOP ;
* prints "0 1 10" and stops, the outer LOOP having counted the inner loop's
* leftovers. Here the inner LOOP discards them as it ends, and the outer
* loop carries on.
*
* The expected sequences marked "v3:" were recorded from the v3 binary on
* 2026-10-03, as in test_numout.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)
#define MAXS ((v4_cell)(V4_MSB - 1u))
#define MINS ((v4_cell)V4_MSB)
/* The memory map is open (D-4); the test chooses the addresses. */
#define TRACE ((v4_cell)(V4_NODE_WORDS - 80u)) /* what the loop bodies saw, 64 cells */
#define CNT ((v4_cell)(V4_NODE_WORDS - 8u)) /* how many cells of TRACE are used */
#define STEP ((v4_cell)(V4_NODE_WORDS - 7u)) /* +LOOP's increment */
#define KV ((v4_cell)(V4_NODE_WORDS - 6u)) /* the index to LEAVE or EXIT at */
#define LAST ((v4_cell)(V4_NODE_WORDS - 5u)) /* set after the loop */
#define TCAP 64
static v4_node n;
static v4_exec_state es;
static v4_heat h;
static v4_asm as;
static v4_cell t_do, t_qdo, t_ploop, t_pqdo, t_nest, t_leave, t_pleave, t_nestleave, t_unloop, t_if, t_j3;
#define O(name) v4_asm_op(&as, V4_OP_##name)
#define LIT(v) v4_asm_lit(&as, (v4_cell)(v))
#define JUMP(x) v4_asm_branch(&as, V4_OP_JUMP, (x))
#define FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op)
#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as))
#define SUB_INLINE() do { O(PUSH); O(INV); O(RPOP); O(ADD); O(INV); } while (0)
/* ---- the expansions under test, as the compiler lays them down --------- */
/* (DO) ( limit index -- ) over push push drop R: limit index
* SWAP push push without the SWAP. */
#define DO_() do { O(OVER); O(PUSH); O(PUSH); O(DROP); } while (0)
/* (?DO) ( limit index -- )
* over over xor if SKIP drop (DO) ...body and LOOP... SKIP: drop drop drop
* The caller resolves the returned reference after the loop, at code that
* drops the three cells. */
#define QDO_(skip) do { O(OVER); O(OVER); O(XOR); (skip) = FWD(IF); O(DROP); DO_(); } while (0)
#define QDO_END_(skip, past) do { (past) = FWD(JUMP); HERE_(skip); O(DROP); O(DROP); O(DROP); HERE_(past); } while (0)
/* The sign of T after this is set exactly when index' < limit, signed:
* index' itself when the two differ in sign, else index' - limit.
* ( i' lim -- i' lim s )
* over over xor -if SAME drop over jump T SAME: drop over over - T: */
#define LESS_SIGN_() do { v4_asm_ref same_, t_; \
O(OVER); O(OVER); O(XOR); same_ = FWD(MINUS_IF); \
O(DROP); O(OVER); t_ = FWD(JUMP); \
HERE_(same_); O(DROP); O(OVER); O(OVER); SUB_INLINE(); \
HERE_(t_); } while (0)
/* (LOOP)
* pop 1 + pop i' lim
* <less-sign> i' lim s
* -if EXIT drop push push jump BODY
* EXIT: drop drop drop */
#define LOOP_(body) do { v4_asm_ref exit_; \
O(RPOP); LIT(1); O(ADD); O(RPOP); LESS_SIGN_(); \
exit_ = FWD(MINUS_IF); O(DROP); O(PUSH); O(PUSH); JUMP(body); \
HERE_(exit_); O(DROP); O(DROP); O(DROP); } while (0)
/* (+LOOP) ( n -- )
* dup a! pop + pop i' lim A: n
* <less-sign> i' lim s
* a xor top bit set: go round again
* -if EXIT drop push push jump BODY
* EXIT: drop drop drop
* Going round again is index' < limit for n >= 0 and the opposite for
* n < 0, that is, exactly when s and n differ in sign. Clobbers A. */
#define PLOOP_(body) do { v4_asm_ref exit_; \
O(DUP); O(BANG_A); O(RPOP); O(ADD); O(RPOP); LESS_SIGN_(); O(PUSH_A); O(XOR); \
exit_ = FWD(MINUS_IF); O(DROP); O(PUSH); O(PUSH); JUMP(body); \
HERE_(exit_); O(DROP); O(DROP); O(DROP); } while (0)
/* (LEAVE) pop pop drop dup push push R: index index
* The limit becomes the index; nothing is jumped over. */
#define LEAVE_() do { O(RPOP); O(RPOP); O(DROP); O(DUP); O(PUSH); O(PUSH); } while (0)
/* I pop dup push
* J pop pop pop dup push a! push push a
* the outer index waits in A while the inner pair goes back, so J
* needs no return entry beyond the two loops' own. Clobbers A.
* UNLOOP pop drop pop drop */
#define I_() do { O(RPOP); O(DUP); O(PUSH); } while (0)
#define J_() do { O(RPOP); O(RPOP); O(RPOP); O(DUP); O(PUSH); O(BANG_A); O(PUSH); O(PUSH); O(PUSH_A); } while (0)
#define UNLOOP_() do { O(RPOP); O(DROP); O(RPOP); O(DROP); } while (0)
/* ---- what the test bodies do ------------------------------------------- */
#define VGET(a) do { LIT(a); O(BANG_A); O(FETCH_A); } while (0)
#define VSET(a) do { LIT(a); O(BANG_A); O(STORE_A); } while (0)
/* ( x -- ) append x to TRACE: CNT @ 63 and TRACE + a! ! CNT @ 1 + CNT !
* The index is masked so that a loop that runs away stays inside TRACE and
* fails on its count, not by writing over the node. */
#define REC_() do { VGET(CNT); LIT(TCAP - 1); O(AND); LIT(TRACE); O(ADD); O(BANG_A); O(STORE_A); \
VGET(CNT); LIT(1); O(ADD); VSET(CNT); } while (0)
static void build(void)
{
v4_asm_ref a, b, skip, past; /* past: the jump over a skipped ?DO loop */
v4_cell body, body2;
/* ( limit start -- ) DO I rec LOOP */
t_do = v4_asm_label(&as);
DO_(); body = v4_asm_label(&as); I_(); REC_(); LOOP_(body); O(SEMI);
/* ( limit start -- ) ?DO I rec LOOP */
t_qdo = v4_asm_label(&as);
QDO_(skip); body = v4_asm_label(&as); I_(); REC_(); LOOP_(body); QDO_END_(skip, past); O(SEMI);
/* ( limit start -- ) DO I rec STEP @ +LOOP */
t_ploop = v4_asm_label(&as);
DO_(); body = v4_asm_label(&as); I_(); REC_(); VGET(STEP); PLOOP_(body); O(SEMI);
/* ( limit start -- ) ?DO I rec STEP @ +LOOP */
t_pqdo = v4_asm_label(&as);
QDO_(skip); body = v4_asm_label(&as); I_(); REC_(); VGET(STEP); PLOOP_(body); QDO_END_(skip, past); O(SEMI);
/* ( olimit ilimit -- ) KV ! 0 DO KV @ 10 DO I rec J rec LOOP LOOP */
t_nest = v4_asm_label(&as);
VSET(KV); LIT(0); DO_();
body = v4_asm_label(&as);
VGET(KV); LIT(10); DO_();
body2 = v4_asm_label(&as);
I_(); REC_(); J_(); REC_();
LOOP_(body2);
LOOP_(body);
O(SEMI);
/* ( limit start -- ) DO I rec I KV @ = IF LEAVE THEN I rec LOOP 77 LAST ! */
t_leave = v4_asm_label(&as);
DO_(); body = v4_asm_label(&as);
I_(); REC_();
I_(); VGET(KV); O(XOR); a = FWD(IF); O(DROP); b = FWD(JUMP);
HERE_(a); O(DROP); LEAVE_();
HERE_(b);
I_(); REC_();
LOOP_(body);
LIT(77); VSET(LAST); O(SEMI);
/* ( limit start -- ) DO I rec I KV @ = IF LEAVE THEN I rec STEP @ +LOOP 77 LAST ! */
t_pleave = v4_asm_label(&as);
DO_(); body = v4_asm_label(&as);
I_(); REC_();
I_(); VGET(KV); O(XOR); a = FWD(IF); O(DROP); b = FWD(JUMP);
HERE_(a); O(DROP); LEAVE_();
HERE_(b);
I_(); REC_();
VGET(STEP); PLOOP_(body);
LIT(77); VSET(LAST); O(SEMI);
/* ( -- ) 3 0 DO 10 0 DO I rec I 1 = IF LEAVE THEN LOOP I rec LOOP 77 LAST ! */
t_nestleave = v4_asm_label(&as);
LIT(3); LIT(0); DO_();
body = v4_asm_label(&as);
LIT(10); LIT(0); DO_();
body2 = v4_asm_label(&as);
I_(); REC_();
I_(); LIT(1); O(XOR); a = FWD(IF); O(DROP); b = FWD(JUMP);
HERE_(a); O(DROP); LEAVE_();
HERE_(b);
LOOP_(body2);
I_(); REC_();
LOOP_(body);
LIT(77); VSET(LAST); O(SEMI);
/* ( limit start -- ) DO I KV @ = IF UNLOOP EXIT THEN I rec LOOP 99 LAST ! */
t_unloop = v4_asm_label(&as);
DO_(); body = v4_asm_label(&as);
I_(); VGET(KV); O(XOR); a = FWD(IF); O(DROP); b = FWD(JUMP);
HERE_(a); O(DROP); UNLOOP_(); O(SEMI);
HERE_(b);
I_(); REC_();
LOOP_(body);
LIT(99); VSET(LAST); O(SEMI);
/* ( f -- n ) IF 1 ELSE 2 THEN (0BRANCH), section 2:
* if L1 drop 1 jump L2 L1: drop 2 L2: */
t_if = v4_asm_label(&as);
a = FWD(IF); O(DROP); LIT(1); b = FWD(JUMP);
HERE_(a); O(DROP); LIT(2);
HERE_(b); O(SEMI);
/* ( x y -- x y j ) 5 3 DO 2 1 DO J LEAVE LOOP LEAVE LOOP
* J with two cells of the caller's under it: it must leave them alone. */
t_j3 = v4_asm_label(&as);
LIT(5); LIT(3); DO_();
LIT(2); LIT(1); DO_();
J_();
UNLOOP_(); UNLOOP_();
O(SEMI);
}
/* ---- running ---------------------------------------------------------- */
static void prepare(v4_cell step, v4_cell k)
{
unsigned i;
v4_dstack_reset(&n.ds);
v4_rstack_reset(&n.rs);
v4_exec_reset(&es);
v4_heat_reset(&h);
for (i = 0; i < TCAP; i++) n.mem[TRACE + (v4_cell)i] = 0x7E7E7E;
n.mem[CNT] = 0; n.mem[STEP] = step; n.mem[KV] = k; n.mem[LAST] = 0;
}
/* Runs `word`; true when it returns with the data stack as it found it
* under its arguments and the return stack exactly as it found it: two
* marked entries wait under the return address, and a loop that left its
* limit or index behind, or took one too many, would return through them. */
#define RMARK0 ((v4_cell)0x6B0000A0)
#define RMARK1 ((v4_cell)0x6B0000A1)
static int call(v4_cell word, v4_cell step, v4_cell k, unsigned argc, v4_cell a, v4_cell b)
{
prepare(step, k);
v4_dstack_push(&n.ds, CANARY);
if (argc > 0) v4_dstack_push(&n.ds, a);
if (argc > 1) v4_dstack_push(&n.ds, b);
v4_rstack_push(&n.rs, RMARK0);
v4_rstack_push(&n.rs, RMARK1);
return v4_test_call(&n, &es, &h, word, 100000) > 0 && n.ds.t == CANARY
&& v4_rstack_pop(&n.rs) == RMARK1 && v4_rstack_pop(&n.rs) == RMARK0;
}
/* The trace is exactly these. */
static int saw(const v4_cell *want, unsigned len)
{
unsigned i;
if (n.mem[CNT] != (v4_cell)len) return 0;
for (i = 0; i < len; i++) if (n.mem[TRACE + (v4_cell)i] != want[i]) return 0;
return n.mem[TRACE + (v4_cell)len] == 0x7E7E7E;
}
#define SAW(...) saw((const v4_cell[]){ __VA_ARGS__ }, (unsigned)(sizeof((const v4_cell[]){ __VA_ARGS__ }) / sizeof(v4_cell)))
/* Stack headroom, as in test_foundation.c: the same trace with marked cells
* under the canary and under the return address. */
static int fits(v4_cell word, v4_cell step, v4_cell k, unsigned argc, v4_cell a, v4_cell b,
const v4_cell *want, unsigned len, unsigned dfill, unsigned rfill)
{
unsigned i;
prepare(step, k);
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, 100000) <= 0) return 0;
if (!saw(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, v4_cell step, v4_cell k, unsigned argc, v4_cell a, v4_cell b,
int min_d, int min_r)
{
v4_cell want[TCAP];
unsigned len, i;
int dh, rh;
CHECK(call(word, step, k, argc, a, b), "%s runs", name);
len = (unsigned)n.mem[CNT];
for (i = 0; i < len; i++) want[i] = n.mem[TRACE + (v4_cell)i];
for (dh = 0; dh < V4_DATA_DEPTH; dh++) if (!fits(word, step, k, argc, a, b, want, len, (unsigned)dh + 1u, 0)) break;
for (rh = 0; rh < V4_RET_DEPTH; rh++) if (!fits(word, step, k, argc, a, b, want, len, 0, (unsigned)rh + 1u)) break;
printf(" %-22s headroom: data %d below canary, return %d below its return address\n", name, dh, rh);
CHECK(dh >= min_d && rh >= min_r, "%s leaves room", name);
}
/* ---- the C reference: v3's rules ---------------------------------------- */
/* The indexes a loop body sees; at most TCAP - 1 are produced, and the
* return is -1 if the loop would run longer than that. */
static int ref_loop(v4_cell limit, v4_cell start, int qdo, int plus, v4_cell step, v4_cell *out)
{
v4_cell i = start;
int len = 0;
if (qdo && start == limit) return 0;
for (;;) {
if (len >= TCAP - 1) return -1;
out[len++] = i;
i = (v4_cell)((v4_ucell)i + (v4_ucell)(plus ? step : 1));
if (!plus) { if (!(i < limit)) break; }
else if (step >= 0) { if (!(i < limit)) break; }
else { if (!(i >= limit)) break; }
}
return len;
}
static const v4_cell ends[] = { 0, 1, 2, 5, -1, -2, -5, 10, MAXS, (v4_cell)(MAXS - 1), (v4_cell)(MAXS - 4),
MINS, (v4_cell)(MINS + 1), (v4_cell)(MINS + 4) };
#define NENDS (sizeof ends / sizeof ends[0])
static const v4_cell steps[] = { 1, 2, 3, 7, -1, -2, -3, -7, 0, MAXS, MINS };
#define NSTEPS (sizeof steps / sizeof steps[0])
int main(void)
{
v4_cell want[TCAP];
unsigned i, j, k, runs = 0, skipped = 0;
int len;
printf("v4 loop tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
v4_node_reset(&n);
/* Words 0 .. 15 each jump to themselves. A loop that leaves its index
* or limit on the return stack makes the word return to that number;
* the tests of LEAVE and UNLOOP use indexes and limits below 16, so such
* a return lands here and never comes back, where empty memory (all
* `;`) would have passed it on to the real return address unnoticed. */
for (i = 0; i < 16; i++) {
v4_asm_begin(&as, &n, (v4_cell)i);
JUMP((v4_cell)i);
CHECK(v4_asm_ok(&as), "trap %u assembles", i);
}
v4_asm_begin(&as, &n, 16);
build();
CHECK(v4_asm_ok(&as), "loop test words assemble");
CHECK(v4_asm_label(&as) < TRACE, "code stays below the variables");
printf(" code: %ld of %u words\n", (long)v4_asm_label(&as) - 16, (unsigned)V4_NODE_WORDS);
/* ---- the v3 transcripts ---- */
/* : T 5 0 DO I . LOOP ; 0 1 2 3 4 : U 0 5 DO I . LOOP ; 5
* : V 5 5 DO I . LOOP ; 5 : W 5 5 ?DO I . LOOP ; (nothing)
* : X 5 2 ?DO I . LOOP ; 2 3 4 */
CHECK(call(t_do, 0, 0, 2, 5, 0) && SAW(0, 1, 2, 3, 4), "v3: 5 0 DO LOOP");
CHECK(call(t_do, 0, 0, 2, 0, 5) && SAW(5), "v3: 0 5 DO LOOP runs once");
CHECK(call(t_do, 0, 0, 2, 5, 5) && SAW(5), "v3: 5 5 DO LOOP runs once");
CHECK(call(t_qdo, 0, 0, 2, 5, 5) && n.mem[CNT] == 0, "v3: 5 5 ?DO LOOP does not run");
CHECK(call(t_qdo, 0, 0, 2, 5, 2) && SAW(2, 3, 4), "v3: 5 2 ?DO LOOP");
/* 10 0 DO I . 2 +LOOP 0 2 4 6 8 0 10 DO I . -3 +LOOP 10 7 4 1
* 0 0 DO I . 5 +LOOP 0 3 7 DO I . 1 +LOOP 7
* 7 3 DO I . -1 +LOOP 3 */
CHECK(call(t_ploop, 2, 0, 2, 10, 0) && SAW(0, 2, 4, 6, 8), "v3: 10 0 DO 2 +LOOP");
CHECK(call(t_ploop, -3, 0, 2, 0, 10) && SAW(10, 7, 4, 1), "v3: 0 10 DO -3 +LOOP");
CHECK(call(t_ploop, 5, 0, 2, 0, 0) && SAW(0), "v3: 0 0 DO 5 +LOOP");
CHECK(call(t_ploop, 1, 0, 2, 3, 7) && SAW(7), "v3: 3 7 DO 1 +LOOP");
CHECK(call(t_ploop, -1, 0, 2, 7, 3) && SAW(3), "v3: 7 3 DO -1 +LOOP");
/* : T 3 0 DO 12 10 DO I . J . LOOP LOOP ; 10 0 11 0 10 1 11 1 10 2 11 2 */
CHECK(call(t_nest, 0, 0, 2, 3, 12) && SAW(10, 0, 11, 0, 10, 1, 11, 1, 10, 2, 11, 2), "v3: nested loops, I and J");
/* FORTH-79 LEAVE: the body runs on to the loop's end with I unchanged.
* (v3, leaving at once, printed one number fewer in each of these.)
* : T 10 0 DO I . I 3 = IF LEAVE THEN I . LOOP ; 0 0 1 1 2 2 3 3
* : T 20 0 DO I . I 6 = IF LEAVE THEN I . 3 +LOOP 77 . ; 0 0 3 3 6 6 77
* : T 0 20 DO I . I 11 = IF LEAVE THEN I . -3 +LOOP 77 . ; 20 20 17 17 14 14 11 11 77 */
CHECK(call(t_leave, 0, 3, 2, 10, 0) && SAW(0, 0, 1, 1, 2, 2, 3, 3) && n.mem[LAST] == 77, "LEAVE in LOOP");
CHECK(call(t_pleave, 3, 6, 2, 12, 0) && SAW(0, 0, 3, 3, 6, 6) && n.mem[LAST] == 77, "LEAVE in +LOOP, limit below 16");
CHECK(call(t_pleave, 3, 6, 2, 20, 0) && SAW(0, 0, 3, 3, 6, 6) && n.mem[LAST] == 77, "LEAVE in +LOOP, up");
CHECK(call(t_pleave, -3, 11, 2, 0, 20) && SAW(20, 20, 17, 17, 14, 14, 11, 11) && n.mem[LAST] == 77,
"LEAVE in +LOOP, down");
CHECK(call(t_pleave, 0, 4, 2, 9, 4) && SAW(4, 4) && n.mem[LAST] == 77, "LEAVE ends a 0 +LOOP");
/* : T 10 0 DO I 3 = IF UNLOOP EXIT THEN I . LOOP 99 . ; 0 1 2 */
CHECK(call(t_unloop, 0, 3, 2, 10, 0) && SAW(0, 1, 2) && n.mem[LAST] == 0, "v3: UNLOOP EXIT");
CHECK(call(t_unloop, 0, 55, 2, 4, 0) && SAW(0, 1, 2, 3) && n.mem[LAST] == 99, "a loop that never meets UNLOOP runs out");
/* : T IF 1 ELSE 2 THEN . ; 5 T 0 T -1 T 1 2 1 */
{
static const v4_cell f[] = { 5, 0, -1, 1, MINS, MAXS };
for (i = 0; i < 6; i++) {
prepare(0, 0);
v4_dstack_push(&n.ds, CANARY);
v4_dstack_push(&n.ds, f[i]);
CHECK(v4_test_call(&n, &es, &h, t_if, 1000) > 0 && v4_dstack_pop(&n.ds) == (f[i] ? 1 : 2)
&& v4_dstack_pop(&n.ds) == CANARY, "%sIF ELSE THEN [%u]", i < 3 ? "v3: " : "", i);
}
}
/* ---- where v4 parts from v3: LEAVE inside an outer loop ---- */
CHECK(call(t_nestleave, 0, 0, 0, 0, 0) && SAW(0, 1, 0, 0, 1, 1, 0, 1, 2) && n.mem[LAST] == 77,
"LEAVE leaves the inner loop only (v3: 0 1 10 and the outer loop stops)");
/* J leaves the cells under it alone */
prepare(0, 0);
v4_dstack_push(&n.ds, CANARY);
v4_dstack_push(&n.ds, 111);
v4_dstack_push(&n.ds, 222);
CHECK(v4_test_call(&n, &es, &h, t_j3, 1000) > 0 && v4_dstack_pop(&n.ds) == 3 && v4_dstack_pop(&n.ds) == 222
&& v4_dstack_pop(&n.ds) == 111 && v4_dstack_pop(&n.ds) == CANARY, "J is the outer index");
/* ---- against C: every pair of loop ends, and every step ---- */
for (i = 0; i < NENDS; i++)
for (j = 0; j < NENDS; j++) {
v4_cell limit = ends[i], start = ends[j];
for (k = 0; k < 2; k++) {
len = ref_loop(limit, start, (int)k, 0, 0, want);
if (len < 0) { skipped++; continue; }
runs++;
CHECK(call(k ? t_qdo : t_do, 0, 0, 2, limit, start) && saw(want, (unsigned)len),
"%s LOOP [%u,%u]: %d times", k ? "?DO" : "DO", i, j, len);
}
for (k = 0; k < NSTEPS; k++) {
unsigned q;
for (q = 0; q < 2; q++) {
len = ref_loop(limit, start, (int)q, 1, steps[k], want);
if (len < 0) { skipped++; continue; }
runs++;
CHECK(call(q ? t_pqdo : t_ploop, steps[k], 0, 2, limit, start) && saw(want, (unsigned)len),
"%s +LOOP [%u,%u] step [%u]: %d times", q ? "?DO" : "DO", i, j, k, len);
}
}
}
printf(" loops run against C: %u (%u more would run past %d times and were left out)\n", runs, skipped, TCAP - 1);
CHECK(runs > 2000, "enough loops were run");
/* LEAVE and UNLOOP EXIT at every index of a short loop */
for (i = 0; i < 12; i++) {
unsigned m;
for (m = 0, j = 0; j <= i; j++) { want[m++] = (v4_cell)j; want[m++] = (v4_cell)j; }
CHECK(call(t_leave, 0, (v4_cell)i, 2, 12, 0) && saw(want, m) && n.mem[LAST] == 77, "LEAVE at %u", i);
for (m = 0, j = 0; j < i; j++) want[m++] = (v4_cell)j;
CHECK(call(t_unloop, 0, (v4_cell)i, 2, 12, 0) && saw(want, m) && n.mem[LAST] == 0, "UNLOOP EXIT at %u", i);
}
/* nested: every pair of small limits */
for (i = 1; i <= 4; i++)
for (j = 11; j <= 14; j++) {
unsigned m = 0, a, b;
for (a = 0; a < i; a++) for (b = 10; b < j; b++) { want[m++] = (v4_cell)b; want[m++] = (v4_cell)a; }
CHECK(call(t_nest, 0, 0, 2, (v4_cell)i, (v4_cell)j) && saw(want, m), "nested [%u,%u]", i, j);
}
/* What a loop leaves the code around it (D-2): a word with one loop, and
* with two nested. */
headroom("DO .. LOOP", t_do, 0, 0, 2, 5, 0, 5, 6);
headroom("DO .. +LOOP", t_ploop, 2, 0, 2, 10, 0, 5, 6);
headroom("?DO .. LOOP", t_qdo, 0, 0, 2, 5, 2, 5, 6);
headroom("DO .. LEAVE .. LOOP", t_leave, 0, 3, 2, 10, 0, 5, 6);
headroom("nested DO, I and J", t_nest, 0, 0, 2, 3, 12, 5, 4);
CHECK(v4_node_guards_intact(&n), "guards intact");
printf(" %d checks, %d failures\n", checks, failures);
return failures ? 1 : 0;
}
Reference in New Issue View Git Blame Copy Permalink