feat(v4.0.0): the byte-string words
FILL ERASE MOVE, COUNT CMOVE CMOVE> BLANK -TRAILING COMPARE SEARCH SCAN SKIP, as loops over the call-free C@ and C!, executed on the golden model at both cell widths against C and five recorded transcripts of the v3 binary. A negative count reads as 0 where v3 read it so, and elsewhere writes nothing and sets NODE-ERROR. v3's counted-string auto-detection is not kept in any of them. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
7c5be22799
commit
cb66db1107
@@ -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! DECIMAL HEX OCTAL UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS HOLD SIGN # #S . .R U. U.R D. D.R ? DUMP Q.PRINT TYPE SEND RECV`. Words that clobber `B`:
|
||||
`Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS <# HOLD SIGN # #S #> . .R U. U.R D. D.R ? DUMP Q.PRINT EMIT CR SPACE SPACES TYPE SEND RECV`.
|
||||
document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! FILL ERASE MOVE COUNT CMOVE CMOVE> BLANK -TRAILING COMPARE SEARCH SCAN SKIP DECIMAL HEX OCTAL UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS HOLD SIGN # #S . .R U. U.R D. D.R ? DUMP Q.PRINT TYPE SEND RECV`. Words that clobber `B`:
|
||||
`COMPARE SEARCH Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS <# HOLD SIGN # #S #> . .R U. U.R D. D.R ? DUMP Q.PRINT EMIT CR SPACE SPACES TYPE SEND RECV`.
|
||||
|
||||
**Return-stack words** (`>R R> R@ 2>R 2R> 2R@ I J UNLOOP` and the loop runtimes) are always IN.
|
||||
|
||||
@@ -333,9 +333,9 @@ Section numbers match the v3 primitive reference.
|
||||
| `2!` | CAP | `a! SWAP !+ !` |
|
||||
| `C@` | CAP | See below (D-1). Call-free. Executed on the golden model (2026-10-03). Leaves its caller 8 data cells and 7 return entries. |
|
||||
| `C!` | CAP | See below (D-1). Call-free. Executed on the golden model (2026-10-03). |
|
||||
| `FILL` | CAP | See below. |
|
||||
| `MOVE` | CAP | `push 2DUP U< IF pop CMOVE> ELSE pop CMOVE THEN` |
|
||||
| `ERASE` | CAP | `0 FILL` |
|
||||
| `FILL` | CAP | `( baddr u c -- )`: the low byte of `c`. See below. Nothing for `u = 0`; for `u < 0` nothing is written and `NODE-ERROR` is set (v3 read a negative count as a huge unsigned one). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 5 data cells and 5 return entries. Clobbers `A` and, on error, `B`. |
|
||||
| `MOVE` | CAP | `( src dst u -- )`, bytes: `push over over - -if UP drop pop jump CMOVE> UP: drop pop jump CMOVE` — `CMOVE>` when `src < dst`, else `CMOVE`, so overlapping bytes are read before they are overwritten, as v3's `memmove`. The test is the sign of `src - dst`, in line. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 5 return entries. |
|
||||
| `ERASE` | CAP | `0 FILL`, as `0 jump FILL`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. |
|
||||
| `CELLS` | IN | Empty (word-addressed). Becomes `2* 2*` if D-1 chooses bytes. |
|
||||
|
||||
```forth
|
||||
@@ -366,7 +366,10 @@ Section numbers match the v3 primitive reference.
|
||||
K0: drop @ -256 and + ! ; \ byte 0
|
||||
|
||||
: FILL ( baddr u c -- )
|
||||
SWAP BEGIN dup WHILE 1- push 2DUP SWAP C! SWAP 1+ SWAP pop REPEAT 2DROP drop ;
|
||||
-ROT \ c baddr u
|
||||
-if OK drop drop drop NODE-ERROR b! -1 !b ; \ u < 0
|
||||
OK: if DONE push over over C! 1 + pop -1 + jump OK
|
||||
DONE: drop drop drop ;
|
||||
```
|
||||
|
||||
### 5.4 Arithmetic
|
||||
@@ -554,14 +557,15 @@ width and print a flood of spaces.
|
||||
|
||||
| Word | Fate | Notes |
|
||||
| --- | --- | --- |
|
||||
| `COUNT` | CAP | `dup 1+ SWAP C@` |
|
||||
| `CMOVE` | CAP | See below. |
|
||||
| `CMOVE>` | CAP | See below. |
|
||||
| `BLANK` | CAP | `32 FILL` |
|
||||
| `-TRAILING` | CAP | Loop from the end while the character is a space. |
|
||||
| `COMPARE` | CAP | Byte loop returning `-1`, `0`, or `1`. v3's counted-string auto-detection is not kept. |
|
||||
| `SEARCH` | CAP | Nested loop over `COMPARE`. Same note. |
|
||||
| `SCAN` `SKIP` | CAP | Byte loops. |
|
||||
| `COUNT` | CAP | `( baddr -- baddr+1 c )`: `dup C@ push 1 + pop`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 7 data cells and 6 return entries. Clobbers `A`. |
|
||||
| `CMOVE` | CAP | `( src dst u -- )`, low byte first. See below. Nothing for `u = 0`; for `u < 0` nothing is written and `NODE-ERROR` is set, where v3 raised its error flag. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 5 data cells and 5 return entries. |
|
||||
| `CMOVE>` | CAP | `( src dst u -- )`, high byte first. See below. Errors as `CMOVE`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 5 return entries. |
|
||||
| `BLANK` | CAP | `32 FILL`, as `32 jump FILL`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. v3's counted-string auto-detection is not kept. |
|
||||
| `-TRAILING` | CAP | `( baddr u -- baddr u' )`. See below. A negative count reads as 0, as v3. v3's counted-string auto-detection is not kept. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 6 return entries. |
|
||||
| `COMPARE` | CAP | `( a1 u1 a2 u2 -- n )`: `-1`, `0` or `1` by the first differing byte, unsigned, else the shorter string is less. See below. Negative counts read as 0, as v3. v3's counted-string auto-detection is not kept. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 5 return entries. Clobbers `A` and `B`. |
|
||||
| `SEARCH` | CAP | `( a1 u1 a2 u2 -- a3 u3 flag )`: the rest of string 1 from the first place string 2 occurs and `-1`, or string 1 and `0`; an empty string 2 is found at the start. See below; the inner comparison is in line, not a call to `COMPARE`. Same notes. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 3 data cells and 5 return entries. Clobbers `A` and `B`. |
|
||||
| `SCAN` `SKIP` | CAP | `( baddr u c -- baddr' u' )`: `SCAN` stops at the first byte equal to the low byte of `c` (or at the end, with `u' = 0`); `SKIP` stops at the first byte not equal to it. See below. A negative count reads as 0, as v3. v3's counted-string auto-detection is not kept. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Each leaves its caller 5 data cells and 5 return entries. Clobber `A`. |
|
||||
| `(S)` | CAP | Variable, 4 cells: `COMPARE`'s two lengths; `SEARCH`'s string 2 and the whole of string 1. |
|
||||
| `BL` | IN | `32` |
|
||||
| `EXPECT` `QUERY` | CC | Built on `KEY` (DEV). |
|
||||
| `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. |
|
||||
@@ -571,11 +575,68 @@ width and print a flood of spaces.
|
||||
| `LITERAL` `[LITERAL]` (placeholders) | RET | The working `LITERAL` is in §5.17. |
|
||||
|
||||
```forth
|
||||
\ SWAP and the subtractions ( - ) are in line.
|
||||
: CMOVE ( src dst u -- )
|
||||
BEGIN dup WHILE 1- push over C@ over C! 1+ SWAP 1+ SWAP pop REPEAT drop 2DROP ;
|
||||
-if OK drop drop drop NODE-ERROR b! -1 !b ; \ u < 0
|
||||
OK: if DONE push \ src dst R: u
|
||||
over C@ over C! 1 + push 1 + pop pop -1 + jump OK
|
||||
DONE: drop drop drop ;
|
||||
|
||||
: CMOVE> ( src dst u -- )
|
||||
BEGIN dup WHILE 1- push over R@ + C@ over R@ + C! pop REPEAT drop 2DROP ;
|
||||
-if OK drop drop drop NODE-ERROR b! -1 !b ; \ u < 0
|
||||
OK: if DONE -1 + push \ src dst R: i = u - 1
|
||||
over pop dup push + C@ \ src dst c
|
||||
over pop dup push + C! \ src dst
|
||||
pop jump OK
|
||||
DONE: drop drop drop ;
|
||||
|
||||
: -TRAILING ( baddr u -- baddr u' )
|
||||
-if L drop 0 ; \ u < 0
|
||||
L: if DONE over over + -1 + C@ -32 + if SP drop ; \ not a space
|
||||
SP: drop -1 + jump L
|
||||
DONE: ;
|
||||
|
||||
: COMPARE ( a1 u1 a2 u2 -- n )
|
||||
-if A drop 0 A: (S) 1 + b! !b \ a1 u1 a2
|
||||
SWAP -if B drop 0 B: dup (S) b! !b \ a1 a2 u1
|
||||
(S) 1 + b! @b \ a1 a2 u1 u2
|
||||
over over - -if GE drop drop jump M \ the smaller
|
||||
GE: drop push drop pop
|
||||
M: \ a1 a2 m
|
||||
L: if EQ push \ a1 a2 R: m
|
||||
over C@ over C@ - if SAME \ c1 - c2
|
||||
-if GT drop drop drop pop drop -1 ;
|
||||
GT: drop drop drop pop drop 1 ;
|
||||
SAME: drop 1 + push 1 + pop pop -1 + jump L
|
||||
EQ: drop drop drop (S) b! @b (S) 1 + b! @b - \ u1 - u2
|
||||
-if NN drop -1 ;
|
||||
NN: if ZZ drop 1 ;
|
||||
ZZ: ;
|
||||
|
||||
: SEARCH ( a1 u1 a2 u2 -- a3 u3 flag )
|
||||
-if A drop 0 A: (S) 1 + b! !b (S) b! !b \ a1 u1 (S): a2 u2
|
||||
-if B drop 0 B: dup (S) 3 + b! !b over (S) 2 + b! !b \ a u (S)+2: a1 u1
|
||||
L: dup (S) 1 + b! @b - -if TRY \ u - u2
|
||||
drop drop drop (S) 2 + b! @b (S) 3 + b! @b 0 ; \ not found
|
||||
TRY: drop over (S) b! @b (S) 1 + b! @b \ a u p q k
|
||||
I: if MATCH push \ a u p q R: k
|
||||
over C@ over C@ xor if SAME
|
||||
drop drop drop pop drop push 1 + pop -1 + jump L \ next place
|
||||
SAME: drop 1 + push 1 + pop pop -1 + jump I
|
||||
MATCH: drop drop drop -1 ;
|
||||
|
||||
: SCAN ( baddr u c -- baddr' u' )
|
||||
255 and push -if L drop 0 \ baddr u R: c
|
||||
L: if DONE over C@ pop dup push xor if FOUND
|
||||
drop push 1 + pop -1 + jump L
|
||||
FOUND: drop
|
||||
DONE: pop drop ;
|
||||
|
||||
: SKIP ( baddr u c -- baddr' u' )
|
||||
255 and push -if L drop 0 \ baddr u R: c
|
||||
L: if DONE over C@ pop dup push xor if SAME drop jump DONE
|
||||
SAME: drop push 1 + pop -1 + jump L
|
||||
DONE: pop drop ;
|
||||
```
|
||||
|
||||
### 5.10 Terminal I/O
|
||||
|
||||
@@ -0,0 +1,706 @@
|
||||
/* test_strings.c -- the byte-string words, executed.
|
||||
*
|
||||
* DECOMPOSITION.md 5.3 and 5.9: FILL ERASE MOVE, COUNT CMOVE CMOVE> BLANK
|
||||
* -TRAILING COMPARE SEARCH SCAN SKIP. All are loops over C@ and C!, which
|
||||
* are assembled again here as they are in test_foundation.c, on a node of
|
||||
* its own.
|
||||
*
|
||||
* Behaviour follows v3 (v3/src/word_source/string_words.c, memory_words.c):
|
||||
* COUNT ( baddr -- baddr+1 c )
|
||||
* CMOVE ( src dst u -- ) low byte first
|
||||
* CMOVE> ( src dst u -- ) high byte first
|
||||
* MOVE ( src dst u -- ) whichever of the two does not overwrite
|
||||
* bytes it has yet to read
|
||||
* FILL ( baddr u c -- ) the low byte of c
|
||||
* BLANK ERASE ( baddr u -- ) FILL with 32, with 0
|
||||
* -TRAILING ( baddr u -- baddr u' ) without its trailing spaces
|
||||
* COMPARE ( a1 u1 a2 u2 -- n ) -1, 0 or 1: the first differing
|
||||
* byte (unsigned), else the shorter is less
|
||||
* SEARCH ( a1 u1 a2 u2 -- a3 u3 f ) the first place string 2 occurs in
|
||||
* string 1: the rest of string 1 from there
|
||||
* and -1, or string 1 and 0; an empty
|
||||
* string 2 is found at the start
|
||||
* SCAN ( baddr u c -- baddr' u' ) from the first byte equal to c
|
||||
* SKIP ( baddr u c -- baddr' u' ) past the leading bytes equal to c
|
||||
* A negative count reads as 0 in -TRAILING, COMPARE, SEARCH, SCAN and SKIP,
|
||||
* as in v3. In CMOVE, CMOVE>, MOVE, FILL, BLANK and ERASE it does nothing
|
||||
* and sets NODE-ERROR, where v3 raised its error flag (or, in FILL, read it
|
||||
* as a huge unsigned count).
|
||||
*
|
||||
* Where v4 parts from v3: v3's -TRAILING, COMPARE, SEARCH, SCAN, SKIP and
|
||||
* BLANK took a string whose first byte equalled its length to be a counted
|
||||
* string and stepped over that byte. 5.9 does not keep that for COMPARE and
|
||||
* SEARCH; it is not kept for the others either. Addresses are not
|
||||
* range-checked (open, node.h).
|
||||
*
|
||||
* Five transcripts of the real v3 binary are recorded below as expected
|
||||
* results, taken on 2026-10-03 as in test_numout.c.
|
||||
*/
|
||||
#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)
|
||||
|
||||
/* The memory map is open (D-4); the test chooses the addresses. */
|
||||
#define NODE_ERROR ((v4_cell)(V4_NODE_WORDS - 2u))
|
||||
#define SV ((v4_cell)(V4_NODE_WORDS - 12u)) /* (S): COMPARE's and SEARCH's lengths and addresses, 4 cells */
|
||||
#define BUFW ((v4_cell)(V4_NODE_WORDS - 96u)) /* 64 cells = 256 bytes of text */
|
||||
#define BUF ((v4_cell)(BUFW * 4))
|
||||
#define BUFLEN 256
|
||||
|
||||
static v4_node n;
|
||||
static v4_exec_state es;
|
||||
static v4_heat h;
|
||||
static v4_asm as;
|
||||
|
||||
static v4_cell w_cfetch, w_cstore, w_count, w_cmove, w_cmoveup, w_move, w_fill,
|
||||
w_blank, w_erase, w_trailing, w_compare, w_search, w_scan, w_skip;
|
||||
|
||||
#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))
|
||||
#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 NROT_INLINE() do { SWAP_INLINE(); O(PUSH); SWAP_INLINE(); O(RPOP); } while (0)
|
||||
#define SUB_INLINE() do { O(PUSH); O(INV); O(RPOP); O(ADD); O(INV); } while (0)
|
||||
#define ERROR_EXIT() do { LIT(NODE_ERROR); O(BANG_B); LIT(-1); O(STORE_B); O(SEMI); } while (0)
|
||||
|
||||
static void build(void)
|
||||
{
|
||||
v4_asm_ref a, b, c;
|
||||
v4_cell l, l2;
|
||||
|
||||
/* C@ and C!, call-free, as in test_foundation.c. */
|
||||
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);
|
||||
}
|
||||
{
|
||||
v4_asm_ref k0, k1, k2;
|
||||
w_cstore = v4_asm_label(&as);
|
||||
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A);
|
||||
LIT(3); O(AND); O(PUSH); LIT(255); O(AND); O(RPOP);
|
||||
k0 = v4_asm_branch_fwd(&as, V4_OP_IF);
|
||||
LIT(-1); O(ADD); k1 = v4_asm_branch_fwd(&as, V4_OP_IF);
|
||||
LIT(-1); O(ADD); k2 = v4_asm_branch_fwd(&as, V4_OP_IF);
|
||||
O(DROP); LIT(23); O(PUSH);
|
||||
(void)v4_asm_label(&as);
|
||||
O(TWO_STAR); O(UNEXT);
|
||||
O(FETCH_A); LIT((v4_cell)(v4_ucell)0xFF000000u); O(INV); O(AND); O(ADD); O(STORE_A); O(SEMI);
|
||||
v4_asm_resolve(&as, k2, v4_asm_label(&as));
|
||||
O(DROP); LIT(15); O(PUSH);
|
||||
(void)v4_asm_label(&as);
|
||||
O(TWO_STAR); O(UNEXT);
|
||||
O(FETCH_A); LIT(-16711681); O(AND); O(ADD); O(STORE_A); O(SEMI);
|
||||
v4_asm_resolve(&as, k1, v4_asm_label(&as));
|
||||
O(DROP); LIT(7); O(PUSH);
|
||||
(void)v4_asm_label(&as);
|
||||
O(TWO_STAR); O(UNEXT);
|
||||
O(FETCH_A); LIT(-65281); O(AND); O(ADD); O(STORE_A); O(SEMI);
|
||||
v4_asm_resolve(&as, k0, v4_asm_label(&as));
|
||||
O(DROP); O(FETCH_A); LIT(-256); O(AND); O(ADD); O(STORE_A); O(SEMI);
|
||||
}
|
||||
|
||||
/* : COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ; */
|
||||
w_count = v4_asm_label(&as);
|
||||
O(DUP); CALL(w_cfetch); O(PUSH); LIT(1); O(ADD); O(RPOP); O(SEMI);
|
||||
|
||||
/* : CMOVE ( src dst u -- )
|
||||
* -if OK drop drop drop NODE-ERROR b! -1 !b ; u < 0
|
||||
* OK: if DONE push src dst R: u
|
||||
* over C@ over C! 1 + push 1 + pop pop -1 + jump OK
|
||||
* DONE: drop drop drop ; */
|
||||
w_cmove = v4_asm_label(&as);
|
||||
a = FWD(MINUS_IF);
|
||||
O(DROP); O(DROP); O(DROP); ERROR_EXIT();
|
||||
HERE_(a);
|
||||
l = v4_asm_label(&as);
|
||||
b = FWD(IF);
|
||||
O(PUSH); O(OVER); CALL(w_cfetch); O(OVER); CALL(w_cstore);
|
||||
LIT(1); O(ADD); O(PUSH); LIT(1); O(ADD); O(RPOP); O(RPOP); LIT(-1); O(ADD);
|
||||
JUMP(l);
|
||||
HERE_(b);
|
||||
O(DROP); O(DROP); O(DROP); O(SEMI);
|
||||
|
||||
/* : CMOVE> ( src dst u -- )
|
||||
* -if OK drop drop drop NODE-ERROR b! -1 !b ; u < 0
|
||||
* OK: if DONE -1 + push src dst R: i = u - 1
|
||||
* over pop dup push + C@ src dst c
|
||||
* over pop dup push + C! src dst
|
||||
* pop jump OK
|
||||
* DONE: drop drop drop ; */
|
||||
w_cmoveup = v4_asm_label(&as);
|
||||
a = FWD(MINUS_IF);
|
||||
O(DROP); O(DROP); O(DROP); ERROR_EXIT();
|
||||
HERE_(a);
|
||||
l = v4_asm_label(&as);
|
||||
b = FWD(IF);
|
||||
LIT(-1); O(ADD); O(PUSH);
|
||||
O(OVER); O(RPOP); O(DUP); O(PUSH); O(ADD); CALL(w_cfetch);
|
||||
O(OVER); O(RPOP); O(DUP); O(PUSH); O(ADD); CALL(w_cstore);
|
||||
O(RPOP);
|
||||
JUMP(l);
|
||||
HERE_(b);
|
||||
O(DROP); O(DROP); O(DROP); O(SEMI);
|
||||
|
||||
/* : MOVE ( src dst u -- )
|
||||
* push over over - -if UP drop pop jump CMOVE> src < dst
|
||||
* UP: drop pop jump CMOVE
|
||||
* The sign of src - dst, the subtraction in line. */
|
||||
w_move = v4_asm_label(&as);
|
||||
O(PUSH); O(OVER); O(OVER); SUB_INLINE(); a = FWD(MINUS_IF);
|
||||
O(DROP); O(RPOP); JUMP(w_cmoveup);
|
||||
HERE_(a);
|
||||
O(DROP); O(RPOP); JUMP(w_cmove);
|
||||
|
||||
/* : FILL ( baddr u c -- )
|
||||
* -ROT c baddr u
|
||||
* -if OK drop drop drop NODE-ERROR b! -1 !b ; u < 0
|
||||
* OK: if DONE push over over C! 1 + pop -1 + jump OK
|
||||
* DONE: drop drop drop ; */
|
||||
w_fill = v4_asm_label(&as);
|
||||
NROT_INLINE();
|
||||
a = FWD(MINUS_IF);
|
||||
O(DROP); O(DROP); O(DROP); ERROR_EXIT();
|
||||
HERE_(a);
|
||||
l = v4_asm_label(&as);
|
||||
b = FWD(IF);
|
||||
O(PUSH); O(OVER); O(OVER); CALL(w_cstore); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
|
||||
JUMP(l);
|
||||
HERE_(b);
|
||||
O(DROP); O(DROP); O(DROP); O(SEMI);
|
||||
|
||||
/* : BLANK ( baddr u -- ) 32 jump FILL : ERASE ( baddr u -- ) 0 jump FILL */
|
||||
w_blank = v4_asm_label(&as);
|
||||
LIT(32); JUMP(w_fill);
|
||||
w_erase = v4_asm_label(&as);
|
||||
LIT(0); JUMP(w_fill);
|
||||
|
||||
/* : -TRAILING ( baddr u -- baddr u' )
|
||||
* -if L drop 0 ; u < 0
|
||||
* L: if DONE over over + -1 + C@ -32 + if SP drop ; not a space
|
||||
* SP: drop -1 + jump L
|
||||
* DONE: ; */
|
||||
w_trailing = v4_asm_label(&as);
|
||||
a = FWD(MINUS_IF);
|
||||
O(DROP); LIT(0); O(SEMI);
|
||||
HERE_(a);
|
||||
l = v4_asm_label(&as);
|
||||
b = FWD(IF);
|
||||
O(OVER); O(OVER); O(ADD); LIT(-1); O(ADD); CALL(w_cfetch); LIT(-32); O(ADD);
|
||||
c = FWD(IF);
|
||||
O(DROP); O(SEMI);
|
||||
HERE_(c);
|
||||
O(DROP); LIT(-1); O(ADD); JUMP(l);
|
||||
HERE_(b);
|
||||
O(SEMI);
|
||||
|
||||
/* : COMPARE ( a1 u1 a2 u2 -- n )
|
||||
* -if A drop 0 A: (S) 1 + b! !b a1 u1 a2
|
||||
* SWAP -if B drop 0 B: dup (S) b! !b a1 a2 u1
|
||||
* (S) 1 + b! @b a1 a2 u1 u2
|
||||
* over over - -if GE drop drop jump M the smaller
|
||||
* GE: drop push drop pop
|
||||
* M: a1 a2 m
|
||||
* L: if EQ push a1 a2 R: m
|
||||
* over C@ over C@ - if SAME c1 - c2
|
||||
* -if GT drop drop drop pop drop -1 ;
|
||||
* GT: drop drop drop pop drop 1 ;
|
||||
* SAME: drop 1 + push 1 + pop pop -1 + jump L
|
||||
* EQ: drop drop drop (S) b! @b (S) 1 + b! @b - u1 - u2
|
||||
* -if NN drop -1 ;
|
||||
* NN: if ZZ drop 1 ;
|
||||
* ZZ: ;
|
||||
* SWAP and the subtractions are in line. The two clamped lengths wait
|
||||
* in the variable (S). */
|
||||
w_compare = v4_asm_label(&as);
|
||||
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
|
||||
VSET(SV + 1);
|
||||
SWAP_INLINE();
|
||||
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
|
||||
O(DUP); VSET(SV);
|
||||
VGET(SV + 1);
|
||||
O(OVER); O(OVER); SUB_INLINE(); a = FWD(MINUS_IF);
|
||||
O(DROP); O(DROP); b = FWD(JUMP);
|
||||
HERE_(a);
|
||||
O(DROP); O(PUSH); O(DROP); O(RPOP);
|
||||
HERE_(b);
|
||||
l = v4_asm_label(&as);
|
||||
a = FWD(IF);
|
||||
O(PUSH); O(OVER); CALL(w_cfetch); O(OVER); CALL(w_cfetch); SUB_INLINE();
|
||||
b = FWD(IF);
|
||||
c = FWD(MINUS_IF);
|
||||
O(DROP); O(DROP); O(DROP); O(RPOP); O(DROP); LIT(-1); O(SEMI);
|
||||
HERE_(c);
|
||||
O(DROP); O(DROP); O(DROP); O(RPOP); O(DROP); LIT(1); O(SEMI);
|
||||
HERE_(b);
|
||||
O(DROP); LIT(1); O(ADD); O(PUSH); LIT(1); O(ADD); O(RPOP); O(RPOP); LIT(-1); O(ADD);
|
||||
JUMP(l);
|
||||
HERE_(a);
|
||||
O(DROP); O(DROP); O(DROP); VGET(SV); VGET(SV + 1); SUB_INLINE();
|
||||
a = FWD(MINUS_IF);
|
||||
O(DROP); LIT(-1); O(SEMI);
|
||||
HERE_(a);
|
||||
b = FWD(IF);
|
||||
O(DROP); LIT(1); O(SEMI);
|
||||
HERE_(b);
|
||||
O(SEMI);
|
||||
|
||||
/* : SEARCH ( a1 u1 a2 u2 -- a3 u3 flag )
|
||||
* -if A drop 0 A: (S) 1 + b! !b (S) b! !b a1 u1 (S): a2 u2
|
||||
* -if B drop 0 B: dup (S) 3 + b! !b over (S) 2 + b! !b a u (S)+2: a1 u1
|
||||
* L: dup (S) 1 + b! @b - -if TRY u - u2
|
||||
* drop drop drop (S) 2 + b! @b (S) 3 + b! @b 0 ; not found
|
||||
* TRY: drop over (S) b! @b (S) 1 + b! @b a u p q k
|
||||
* I: if MATCH push a u p q R: k
|
||||
* over C@ over C@ xor if SAME
|
||||
* drop drop drop pop drop push 1 + pop -1 + jump L next place
|
||||
* SAME: drop 1 + push 1 + pop pop -1 + jump I
|
||||
* MATCH: drop drop drop -1 ; */
|
||||
w_search = v4_asm_label(&as);
|
||||
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
|
||||
VSET(SV + 1); VSET(SV);
|
||||
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
|
||||
O(DUP); VSET(SV + 3); O(OVER); VSET(SV + 2);
|
||||
l = v4_asm_label(&as);
|
||||
O(DUP); VGET(SV + 1); SUB_INLINE(); a = FWD(MINUS_IF);
|
||||
O(DROP); O(DROP); O(DROP); VGET(SV + 2); VGET(SV + 3); LIT(0); O(SEMI);
|
||||
HERE_(a);
|
||||
O(DROP); O(OVER); VGET(SV); VGET(SV + 1);
|
||||
l2 = v4_asm_label(&as);
|
||||
a = FWD(IF);
|
||||
O(PUSH); O(OVER); CALL(w_cfetch); O(OVER); CALL(w_cfetch); O(XOR);
|
||||
b = FWD(IF);
|
||||
O(DROP); O(DROP); O(DROP); O(RPOP); O(DROP);
|
||||
O(PUSH); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
|
||||
JUMP(l);
|
||||
HERE_(b);
|
||||
O(DROP); LIT(1); O(ADD); O(PUSH); LIT(1); O(ADD); O(RPOP); O(RPOP); LIT(-1); O(ADD);
|
||||
JUMP(l2);
|
||||
HERE_(a);
|
||||
O(DROP); O(DROP); O(DROP); LIT(-1); O(SEMI);
|
||||
|
||||
/* : SCAN ( baddr u c -- baddr' u' )
|
||||
* 255 and push -if L drop 0 baddr u R: c
|
||||
* L: if DONE over C@ pop dup push xor if FOUND
|
||||
* drop push 1 + pop -1 + jump L
|
||||
* FOUND: drop
|
||||
* DONE: pop drop ; */
|
||||
w_scan = v4_asm_label(&as);
|
||||
LIT(255); O(AND); O(PUSH);
|
||||
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
|
||||
l = v4_asm_label(&as);
|
||||
a = FWD(IF);
|
||||
O(OVER); CALL(w_cfetch); O(RPOP); O(DUP); O(PUSH); O(XOR); b = FWD(IF);
|
||||
O(DROP); O(PUSH); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
|
||||
JUMP(l);
|
||||
HERE_(b);
|
||||
O(DROP);
|
||||
HERE_(a);
|
||||
O(RPOP); O(DROP); O(SEMI);
|
||||
|
||||
/* : SKIP ( baddr u c -- baddr' u' )
|
||||
* 255 and push -if L drop 0 baddr u R: c
|
||||
* L: if DONE over C@ pop dup push xor if SAME drop jump DONE
|
||||
* SAME: drop push 1 + pop -1 + jump L
|
||||
* DONE: pop drop ; */
|
||||
w_skip = v4_asm_label(&as);
|
||||
LIT(255); O(AND); O(PUSH);
|
||||
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
|
||||
l = v4_asm_label(&as);
|
||||
a = FWD(IF);
|
||||
O(OVER); CALL(w_cfetch); O(RPOP); O(DUP); O(PUSH); O(XOR); b = FWD(IF);
|
||||
O(DROP); c = FWD(JUMP);
|
||||
HERE_(b);
|
||||
O(DROP); O(PUSH); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
|
||||
JUMP(l);
|
||||
HERE_(a); HERE_(c);
|
||||
O(RPOP); O(DROP); O(SEMI);
|
||||
}
|
||||
|
||||
/* ---- running ---------------------------------------------------------- */
|
||||
|
||||
/* The test's own copy of the 256 text bytes; the node's are compared with
|
||||
* it after every call. */
|
||||
static unsigned char img[BUFLEN];
|
||||
|
||||
static unsigned char node_byte(v4_cell baddr)
|
||||
{
|
||||
return (unsigned char)(((v4_ucell)n.mem[baddr >> 2] >> (8u * (unsigned)(baddr & 3))) & 0xFFu);
|
||||
}
|
||||
static void load_img(void)
|
||||
{
|
||||
unsigned i;
|
||||
for (i = 0; i < BUFLEN / 4; i++) {
|
||||
v4_ucell w = (v4_ucell)img[4 * i] | ((v4_ucell)img[4 * i + 1] << 8)
|
||||
| ((v4_ucell)img[4 * i + 2] << 16) | ((v4_ucell)img[4 * i + 3] << 24);
|
||||
n.mem[BUFW + (v4_cell)i] = (v4_cell)w;
|
||||
}
|
||||
}
|
||||
static int img_matches(void)
|
||||
{
|
||||
unsigned i;
|
||||
for (i = 0; i < BUFLEN; i++) if (node_byte(BUF + (v4_cell)i) != img[i]) return 0;
|
||||
for (i = 0; i < BUFLEN / 4; i++) /* nothing above byte 3 of a cell either */
|
||||
if (((v4_ucell)n.mem[BUFW + (v4_cell)i] >> 16 >> 16) != 0) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Runs `word` on argc arguments over the current img; true when it returns.
|
||||
* The results are then popped with res(). */
|
||||
static int call(v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c, v4_cell d)
|
||||
{
|
||||
v4_cell args[4];
|
||||
unsigned i;
|
||||
args[0] = a; args[1] = b; args[2] = c; args[3] = d;
|
||||
load_img();
|
||||
v4_dstack_reset(&n.ds);
|
||||
v4_rstack_reset(&n.rs);
|
||||
v4_exec_reset(&es);
|
||||
v4_heat_reset(&h);
|
||||
v4_node_store(&n, NODE_ERROR, 0);
|
||||
v4_dstack_push(&n.ds, CANARY);
|
||||
for (i = 0; i < argc; i++) v4_dstack_push(&n.ds, args[i]);
|
||||
return v4_test_call(&n, &es, &h, word, 4000000) > 0;
|
||||
}
|
||||
static v4_cell res(void) { return v4_dstack_pop(&n.ds); }
|
||||
static int clean(void) { return v4_dstack_pop(&n.ds) == CANARY; }
|
||||
static int err(void) { return v4_node_load(&n, NODE_ERROR) != 0; }
|
||||
|
||||
/* Stack headroom, as in test_foundation.c: the results and the bytes must
|
||||
* be what a run with empty stacks gave. */
|
||||
static int fits(v4_cell word, unsigned argc, const v4_cell *args, unsigned nres, const v4_cell *want,
|
||||
const unsigned char *img0, const unsigned char *img1, unsigned dfill, unsigned rfill)
|
||||
{
|
||||
unsigned i;
|
||||
memcpy(img, img0, BUFLEN);
|
||||
load_img();
|
||||
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);
|
||||
for (i = 0; i < argc; i++) v4_dstack_push(&n.ds, args[i]);
|
||||
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;
|
||||
for (i = nres; i-- > 0; ) if (v4_dstack_pop(&n.ds) != want[i]) 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;
|
||||
memcpy(img, img1, BUFLEN);
|
||||
return img_matches();
|
||||
}
|
||||
static void headroom(const char *name, v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c, v4_cell d,
|
||||
unsigned nres, int min_d, int min_r)
|
||||
{
|
||||
unsigned char img0[BUFLEN], img1[BUFLEN];
|
||||
v4_cell args[4], want[4];
|
||||
unsigned i;
|
||||
int dh, rh;
|
||||
args[0] = a; args[1] = b; args[2] = c; args[3] = d;
|
||||
memcpy(img0, img, BUFLEN);
|
||||
CHECK(call(word, argc, a, b, c, d), "%s runs", name);
|
||||
for (i = nres; i-- > 0; ) want[i] = res();
|
||||
for (i = 0; i < BUFLEN; i++) img1[i] = node_byte(BUF + (v4_cell)i);
|
||||
for (dh = 0; dh < V4_DATA_DEPTH; dh++) if (!fits(word, argc, args, nres, want, img0, img1, (unsigned)dh + 1u, 0)) break;
|
||||
for (rh = 0; rh < V4_RET_DEPTH; rh++) if (!fits(word, argc, args, nres, want, img0, img1, 0, (unsigned)rh + 1u)) break;
|
||||
printf(" %s 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);
|
||||
memcpy(img, img0, BUFLEN);
|
||||
}
|
||||
|
||||
/* ---- the C reference ---------------------------------------------------- */
|
||||
|
||||
static uint32_t rng = 0x9E3779B9u;
|
||||
static uint32_t rnd(void) { rng ^= rng << 13; rng ^= rng >> 17; rng ^= rng << 5; return rng; }
|
||||
|
||||
static void random_img(unsigned alphabet)
|
||||
{
|
||||
unsigned i;
|
||||
for (i = 0; i < BUFLEN; i++)
|
||||
img[i] = (unsigned char)(alphabet ? 'a' + rnd() % alphabet : rnd() & 0xFFu);
|
||||
}
|
||||
static void text_at(unsigned off, const char *s) { memcpy(img + off, s, strlen(s)); }
|
||||
|
||||
static int ref_compare(unsigned o1, long u1, unsigned o2, long u2)
|
||||
{
|
||||
long m, i;
|
||||
if (u1 < 0) u1 = 0;
|
||||
if (u2 < 0) u2 = 0;
|
||||
m = u1 < u2 ? u1 : u2;
|
||||
for (i = 0; i < m; i++)
|
||||
if (img[o1 + i] != img[o2 + i]) return img[o1 + i] < img[o2 + i] ? -1 : 1;
|
||||
return u1 < u2 ? -1 : (u1 > u2 ? 1 : 0);
|
||||
}
|
||||
/* Returns the offset of the match in string 1, or -1. */
|
||||
static long ref_search(unsigned o1, long u1, unsigned o2, long u2)
|
||||
{
|
||||
long i;
|
||||
if (u1 < 0) u1 = 0;
|
||||
if (u2 < 0) u2 = 0;
|
||||
for (i = 0; i + u2 <= u1; i++)
|
||||
if (u2 == 0 || memcmp(img + o1 + i, img + o2, (size_t)u2) == 0) return i;
|
||||
return -1;
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
unsigned char before[BUFLEN];
|
||||
unsigned i, t;
|
||||
|
||||
printf("v4 string 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), "string words assemble");
|
||||
CHECK(v4_asm_label(&as) < BUFW, "code stays below the text");
|
||||
printf(" code: %ld of %u words\n", (long)v4_asm_label(&as) - 16, (unsigned)V4_NODE_WORDS);
|
||||
|
||||
/* ---- the v3 transcripts ---- */
|
||||
|
||||
/* S" abc" S" abd" COMPARE . abc abc abd abc ab abc abc ab -> -1 0 1 -1 1 */
|
||||
memset(img, 0, BUFLEN);
|
||||
text_at(0, "abc"); text_at(8, "abd"); text_at(16, "abc"); text_at(24, "ab");
|
||||
CHECK(call(w_compare, 4, BUF, 3, BUF + 8, 3) && res() == -1 && clean(), "v3: abc abd COMPARE");
|
||||
CHECK(call(w_compare, 4, BUF, 3, BUF + 16, 3) && res() == 0 && clean(), "v3: abc abc COMPARE");
|
||||
CHECK(call(w_compare, 4, BUF + 8, 3, BUF, 3) && res() == 1 && clean(), "v3: abd abc COMPARE");
|
||||
CHECK(call(w_compare, 4, BUF + 24, 2, BUF, 3) && res() == -1 && clean(), "v3: ab abc COMPARE");
|
||||
CHECK(call(w_compare, 4, BUF, 3, BUF + 24, 2) && res() == 1 && clean(), "v3: abc ab COMPARE");
|
||||
|
||||
/* S" hello world" S" o w" SEARCH . . DROP -> -1 7
|
||||
* S" hello world" S" xyz" SEARCH . . DROP -> 0 11
|
||||
* S" hello" S" " SEARCH . . DROP -> -1 5 */
|
||||
memset(img, 0, BUFLEN);
|
||||
text_at(1, "hello world"); text_at(32, "o w"); text_at(40, "xyz");
|
||||
CHECK(call(w_search, 4, BUF + 1, 11, BUF + 32, 3) && res() == -1 && res() == 7 && res() == BUF + 5 && clean(),
|
||||
"v3: hello world / o w SEARCH");
|
||||
CHECK(call(w_search, 4, BUF + 1, 11, BUF + 40, 3) && res() == 0 && res() == 11 && res() == BUF + 1 && clean(),
|
||||
"v3: hello world / xyz SEARCH");
|
||||
CHECK(call(w_search, 4, BUF + 1, 5, BUF + 40, 0) && res() == -1 && res() == 5 && res() == BUF + 1 && clean(),
|
||||
"v3: hello / empty SEARCH");
|
||||
|
||||
/* S" hi " -TRAILING . DROP S" aaab" 97 SKIP . DROP S" hello" 108 SCAN . DROP
|
||||
* S" hello" 122 SCAN . DROP S" " -TRAILING . DROP -> 2 1 3 0 0 */
|
||||
memset(img, 0, BUFLEN);
|
||||
text_at(2, "hi "); text_at(16, "aaab"); text_at(33, "hello"); text_at(48, " ");
|
||||
CHECK(call(w_trailing, 2, BUF + 2, 5, 0, 0) && res() == 2 && res() == BUF + 2 && clean(), "v3: -TRAILING");
|
||||
CHECK(call(w_skip, 3, BUF + 16, 4, 97, 0) && res() == 1 && res() == BUF + 19 && clean(), "v3: SKIP");
|
||||
CHECK(call(w_scan, 3, BUF + 33, 5, 108, 0) && res() == 3 && res() == BUF + 35 && clean(), "v3: SCAN");
|
||||
CHECK(call(w_scan, 3, BUF + 33, 5, 122, 0) && res() == 0 && res() == BUF + 38 && clean(), "v3: SCAN, absent");
|
||||
CHECK(call(w_trailing, 2, BUF + 48, 4, 0, 0) && res() == 0 && res() == BUF + 48 && clean(), "v3: -TRAILING, all spaces");
|
||||
|
||||
/* CREATE B 16 ALLOT B 16 46 FILL B 4 BLANK B 8 + 3 ERASE B 16 DUMP
|
||||
* 20 20 20 20 2E 2E 2E 2E 00 00 00 2E 2E 2E 2E 2E
|
||||
* "ABCDEF" B 6 CMOVE B B 2 + 6 CMOVE> B B 1 + 6 CMOVE B 16 DUMP
|
||||
* 41 41 41 41 41 41 41 46 00 00 00 2E 2E 2E 2E 2E
|
||||
* B 3 + B 5 MOVE B 16 DUMP
|
||||
* 41 41 41 41 46 41 41 46 00 00 00 2E 2E 2E 2E 2E */
|
||||
{
|
||||
static const unsigned char d1[16] = { 0x20,0x20,0x20,0x20,0x2E,0x2E,0x2E,0x2E,0,0,0,0x2E,0x2E,0x2E,0x2E,0x2E };
|
||||
static const unsigned char d2[16] = { 0x41,0x41,0x41,0x41,0x41,0x41,0x41,0x46,0,0,0,0x2E,0x2E,0x2E,0x2E,0x2E };
|
||||
static const unsigned char d3[16] = { 0x41,0x41,0x41,0x41,0x46,0x41,0x41,0x46,0,0,0,0x2E,0x2E,0x2E,0x2E,0x2E };
|
||||
const v4_cell B = BUF + 21;
|
||||
#define STEP(word, argc, a, b, c) do { \
|
||||
CHECK(call(word, argc, a, b, c, 0) && clean() && !err(), "v3 block-copy step returns"); \
|
||||
for (i = 0; i < BUFLEN; i++) img[i] = node_byte(BUF + (v4_cell)i); } while (0)
|
||||
memset(img, 0x77, BUFLEN);
|
||||
text_at(100, "ABCDEF");
|
||||
STEP(w_fill, 3, B, 16, 46);
|
||||
STEP(w_blank, 2, B, 4, 0);
|
||||
STEP(w_erase, 2, B + 8, 3, 0);
|
||||
CHECK(memcmp(img + 21, d1, 16) == 0, "v3: FILL, BLANK, ERASE");
|
||||
STEP(w_cmove, 3, BUF + 100, B, 6);
|
||||
STEP(w_cmoveup, 3, B, B + 2, 6);
|
||||
STEP(w_cmove, 3, B, B + 1, 6);
|
||||
CHECK(memcmp(img + 21, d2, 16) == 0, "v3: CMOVE, CMOVE>, CMOVE");
|
||||
STEP(w_move, 3, B + 3, B, 5);
|
||||
CHECK(memcmp(img + 21, d3, 16) == 0, "v3: MOVE");
|
||||
for (i = 0; i < BUFLEN; i++)
|
||||
if ((i < 21 || i >= 37) && (i < 100 || i >= 106) && img[i] != 0x77) break;
|
||||
CHECK(i == BUFLEN, "nothing outside B was written");
|
||||
}
|
||||
|
||||
/* 3 B C! 65 66 67 ... B COUNT . B - . -> 3 1 */
|
||||
memset(img, 0, BUFLEN);
|
||||
img[9] = 3; text_at(10, "ABC");
|
||||
CHECK(call(w_count, 1, BUF + 9, 0, 0, 0) && res() == 3 && res() == BUF + 10 && clean(), "v3: COUNT");
|
||||
|
||||
/* ---- against C ---- */
|
||||
|
||||
/* COUNT: every byte value, every position in a cell */
|
||||
random_img(0);
|
||||
for (i = 0; i < BUFLEN; i++)
|
||||
CHECK(call(w_count, 1, BUF + (v4_cell)i, 0, 0, 0) && res() == img[i] && res() == BUF + (v4_cell)i + 1
|
||||
&& clean() && img_matches(), "COUNT [%u]", i);
|
||||
|
||||
/* FILL, BLANK, ERASE */
|
||||
for (t = 0; t < 400; t++) {
|
||||
unsigned off = rnd() % 200, len = rnd() % 40;
|
||||
v4_cell ch = (v4_cell)(rnd() % 3 == 0 ? rnd() : rnd() & 0xFFu);
|
||||
unsigned which = t % 3;
|
||||
random_img(0);
|
||||
memcpy(before, img, BUFLEN);
|
||||
if (which == 0) { CHECK(call(w_fill, 3, BUF + (v4_cell)off, (v4_cell)len, ch, 0) && clean(), "FILL returns"); }
|
||||
else if (which == 1) { CHECK(call(w_blank, 2, BUF + (v4_cell)off, (v4_cell)len, 0, 0) && clean(), "BLANK returns"); ch = 32; }
|
||||
else { CHECK(call(w_erase, 2, BUF + (v4_cell)off, (v4_cell)len, 0, 0) && clean(), "ERASE returns"); ch = 0; }
|
||||
memset(img + off, (int)((v4_ucell)ch & 0xFFu), len);
|
||||
CHECK(img_matches() && !err(), "FILL/BLANK/ERASE [%u] off %u len %u", t, off, len);
|
||||
}
|
||||
|
||||
/* CMOVE, CMOVE>, MOVE: apart and overlapping both ways */
|
||||
for (t = 0; t < 900; t++) {
|
||||
unsigned len = rnd() % 48, src = rnd() % (BUFLEN - 48), dst;
|
||||
unsigned which = t % 3, k;
|
||||
if (t % 2) dst = rnd() % (BUFLEN - 48);
|
||||
else { int d = (int)(rnd() % 17) - 8; dst = (unsigned)((int)src + d < 0 ? 0 : (int)src + d); if (dst > BUFLEN - 48) dst = BUFLEN - 48; }
|
||||
random_img(0);
|
||||
CHECK(call(which == 0 ? w_cmove : which == 1 ? w_cmoveup : w_move, 3,
|
||||
BUF + (v4_cell)src, BUF + (v4_cell)dst, (v4_cell)len, 0) && clean(), "move returns [%u]", t);
|
||||
if (which == 0) for (k = 0; k < len; k++) img[dst + k] = img[src + k];
|
||||
else if (which == 1) for (k = len; k-- > 0; ) img[dst + k] = img[src + k];
|
||||
else memmove(img + dst, img + src, len);
|
||||
CHECK(img_matches() && !err(), "%s [%u] src %u dst %u len %u",
|
||||
which == 0 ? "CMOVE" : which == 1 ? "CMOVE>" : "MOVE", t, src, dst, len);
|
||||
}
|
||||
|
||||
/* a negative count: nothing written, NODE-ERROR set */
|
||||
{
|
||||
static const v4_cell neg[] = { -1, -7, (v4_cell)V4_MSB };
|
||||
random_img(0);
|
||||
for (i = 0; i < 3; i++) {
|
||||
CHECK(call(w_cmove, 3, BUF, BUF + 50, neg[i], 0) && clean() && img_matches() && err(), "CMOVE negative count [%u]", i);
|
||||
CHECK(call(w_cmoveup, 3, BUF, BUF + 50, neg[i], 0) && clean() && img_matches() && err(), "CMOVE> negative count [%u]", i);
|
||||
CHECK(call(w_move, 3, BUF, BUF + 50, neg[i], 0) && clean() && img_matches() && err(), "MOVE negative count, up [%u]", i);
|
||||
CHECK(call(w_move, 3, BUF + 50, BUF, neg[i], 0) && clean() && img_matches() && err(), "MOVE negative count, down [%u]", i);
|
||||
CHECK(call(w_fill, 3, BUF, neg[i], 65, 0) && clean() && img_matches() && err(), "FILL negative count [%u]", i);
|
||||
CHECK(call(w_blank, 2, BUF, neg[i], 0, 0) && clean() && img_matches() && err(), "BLANK negative count [%u]", i);
|
||||
CHECK(call(w_erase, 2, BUF, neg[i], 0, 0) && clean() && img_matches() && err(), "ERASE negative count [%u]", i);
|
||||
}
|
||||
}
|
||||
|
||||
/* -TRAILING */
|
||||
for (t = 0; t < 600; t++) {
|
||||
unsigned off = rnd() % 200, len = rnd() % 40, sp = rnd() % 41, k, want;
|
||||
random_img(t % 4 == 0 ? 0 : 3);
|
||||
for (k = 0; k < sp && k < len; k++) img[off + len - 1 - k] = 32;
|
||||
if (t % 5 == 0 && len) img[off] = (unsigned char)len; /* v3 would have taken this for a counted string */
|
||||
for (want = len; want > 0 && img[off + want - 1] == 32; want--) { }
|
||||
CHECK(call(w_trailing, 2, BUF + (v4_cell)off, (v4_cell)len, 0, 0) && res() == (v4_cell)want
|
||||
&& res() == BUF + (v4_cell)off && clean() && img_matches() && !err(), "-TRAILING [%u] len %u", t, len);
|
||||
}
|
||||
CHECK(call(w_trailing, 2, BUF + 5, -3, 0, 0) && res() == 0 && res() == BUF + 5 && clean() && !err(),
|
||||
"-TRAILING of a negative count is 0");
|
||||
|
||||
/* SCAN and SKIP */
|
||||
for (t = 0; t < 1200; t++) {
|
||||
unsigned off = rnd() % 200, len = rnd() % 40, k;
|
||||
v4_cell ch;
|
||||
random_img(t % 6 == 0 ? 0 : 2 + t % 3);
|
||||
ch = (v4_cell)(len && t % 3 ? img[off + rnd() % len] : (unsigned char)rnd());
|
||||
if (t % 7 == 0) ch += 256 * (v4_cell)(1 + rnd() % 100); /* only the low byte counts */
|
||||
if (t % 2 == 0) {
|
||||
for (k = 0; k < len && img[off + k] != ((v4_ucell)ch & 0xFFu); k++) { }
|
||||
CHECK(call(w_scan, 3, BUF + (v4_cell)off, (v4_cell)len, ch, 0) && res() == (v4_cell)(len - k)
|
||||
&& res() == BUF + (v4_cell)(off + k) && clean() && img_matches() && !err(), "SCAN [%u] len %u", t, len);
|
||||
} else {
|
||||
for (k = 0; k < len && img[off + k] == ((v4_ucell)ch & 0xFFu); k++) { }
|
||||
CHECK(call(w_skip, 3, BUF + (v4_cell)off, (v4_cell)len, ch, 0) && res() == (v4_cell)(len - k)
|
||||
&& res() == BUF + (v4_cell)(off + k) && clean() && img_matches() && !err(), "SKIP [%u] len %u", t, len);
|
||||
}
|
||||
}
|
||||
CHECK(call(w_scan, 3, BUF + 5, -3, 65, 0) && res() == 0 && res() == BUF + 5 && clean() && !err(), "SCAN of a negative count");
|
||||
CHECK(call(w_skip, 3, BUF + 5, -3, 65, 0) && res() == 0 && res() == BUF + 5 && clean() && !err(), "SKIP of a negative count");
|
||||
|
||||
/* COMPARE */
|
||||
for (t = 0; t < 3000; t++) {
|
||||
unsigned o1 = rnd() % 100, o2 = 128 + rnd() % 100;
|
||||
long u1 = (long)(rnd() % 24), u2 = (long)(rnd() % 24);
|
||||
int want;
|
||||
random_img(t % 10 == 0 ? 0 : 2);
|
||||
if (t % 3 == 0) { unsigned same = rnd() % 24; memcpy(img + o2, img + o1, same); }
|
||||
if (t % 11 == 0) img[o1 + rnd() % 4] = (unsigned char)(0x80u + rnd() % 128); /* bytes compare unsigned */
|
||||
if (t % 13 == 0 && u1) img[o1] = (unsigned char)u1; /* not a counted string */
|
||||
if (t % 50 == 0) u1 = -(long)(1 + rnd() % 5);
|
||||
if (t % 70 == 0) u2 = -(long)(1 + rnd() % 5);
|
||||
want = ref_compare(o1, u1, o2, u2);
|
||||
CHECK(call(w_compare, 4, BUF + (v4_cell)o1, (v4_cell)u1, BUF + (v4_cell)o2, (v4_cell)u2)
|
||||
&& res() == (v4_cell)want && clean() && img_matches() && !err(),
|
||||
"COMPARE [%u] u1 %ld u2 %ld want %d", t, u1, u2, want);
|
||||
}
|
||||
CHECK(call(w_compare, 4, BUF + 9, 12, BUF + 9, 12) && res() == 0 && clean(), "COMPARE of a string with itself");
|
||||
|
||||
/* SEARCH */
|
||||
for (t = 0; t < 3000; t++) {
|
||||
unsigned o1 = rnd() % 80, o2 = 160 + rnd() % 60;
|
||||
long u1 = (long)(rnd() % 40), u2 = (long)(rnd() % 6), at, c1, c2;
|
||||
v4_cell f, u3, a3;
|
||||
random_img(t % 10 == 0 ? 0 : 2);
|
||||
if (t % 3 == 0 && u1 >= u2) memcpy(img + o2, img + o1 + rnd() % (unsigned)(u1 - u2 + 1), (size_t)u2);
|
||||
if (t % 4 == 0) u2 = (long)(rnd() % 45);
|
||||
if (t % 50 == 0) u1 = -(long)(1 + rnd() % 5);
|
||||
if (t % 70 == 0) u2 = -(long)(1 + rnd() % 5);
|
||||
at = ref_search(o1, u1, o2, u2);
|
||||
c1 = u1 < 0 ? 0 : u1; c2 = u2;
|
||||
(void)c2;
|
||||
CHECK(call(w_search, 4, BUF + (v4_cell)o1, (v4_cell)u1, BUF + (v4_cell)o2, (v4_cell)u2), "SEARCH returns [%u]", t);
|
||||
f = res(); u3 = res(); a3 = res();
|
||||
if (at >= 0)
|
||||
CHECK(f == -1 && u3 == (v4_cell)(c1 - at) && a3 == BUF + (v4_cell)o1 + (v4_cell)at && clean(),
|
||||
"SEARCH found [%u] u1 %ld u2 %ld at %ld", t, u1, u2, at);
|
||||
else
|
||||
CHECK(f == 0 && u3 == (v4_cell)c1 && a3 == BUF + (v4_cell)o1 && clean(),
|
||||
"SEARCH not found [%u] u1 %ld u2 %ld", t, u1, u2);
|
||||
CHECK(img_matches() && !err(), "SEARCH writes nothing [%u]", t);
|
||||
}
|
||||
|
||||
/* What they leave their caller (D-2). */
|
||||
random_img(2);
|
||||
text_at(40, "needle"); text_at(200, "needle"); text_at(64, "tail ");
|
||||
headroom("COUNT", w_count, 1, BUF + 3, 0, 0, 0, 2, 6, 6);
|
||||
headroom("CMOVE", w_cmove, 3, BUF + 3, BUF + 90, 9, 0, 0, 3, 5);
|
||||
headroom("CMOVE>", w_cmoveup, 3, BUF + 3, BUF + 90, 9, 0, 0, 3, 5);
|
||||
headroom("MOVE", w_move, 3, BUF + 3, BUF + 6, 9, 0, 0, 3, 5);
|
||||
headroom("FILL", w_fill, 3, BUF + 3, 9, 65, 0, 0, 3, 5);
|
||||
headroom("BLANK", w_blank, 2, BUF + 3, 9, 0, 0, 0, 3, 5);
|
||||
headroom("-TRAILING", w_trailing, 2, BUF + 64, 8, 0, 0, 2, 4, 6);
|
||||
headroom("COMPARE", w_compare, 4, BUF + 40, 6, BUF + 200, 6, 1, 3, 5);
|
||||
headroom("SEARCH", w_search, 4, BUF + 20, 40, BUF + 200, 6, 3, 2, 5);
|
||||
headroom("SCAN", w_scan, 3, BUF + 64, 8, 32, 0, 2, 4, 5);
|
||||
headroom("SKIP", w_skip, 3, BUF + 68, 4, 32, 0, 2, 4, 5);
|
||||
|
||||
CHECK(v4_node_guards_intact(&n), "guards intact");
|
||||
|
||||
printf(" %d checks, %d failures\n", checks, failures);
|
||||
return failures ? 1 : 0;
|
||||
}
|
||||
Reference in New Issue
Block a user