feat(v4): the ROM reads numbers as text.c does
(NUMBER) ( -- n flag ), entry 2: decimal with a leading -, or hex after $; 1 a number, 0 not one, -1 one that does not fit a cell. Every case is also given to text.c, the oracle, at both widths. 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
0f82d8c22a
commit
080811dbd2
@@ -9,3 +9,4 @@
|
||||
: (ENTRIES)
|
||||
jump (KEY) \ 0 ( -- c )
|
||||
jump (TOKEN) \ 1 ( -- len )
|
||||
jump (NUMBER) \ 2 ( -- n flag )
|
||||
|
||||
@@ -0,0 +1,67 @@
|
||||
\ num.f18 -- the ROM reads numbers.
|
||||
\
|
||||
\ (NUMBER) ( -- n flag ) looks at the token (TOKEN) read, as v4/src/text.c's
|
||||
\ number_of does: decimal with an optional leading `-`, or hexadecimal after
|
||||
\ `$` (a-f in either case). flag 1: the whole token is a number, n its
|
||||
\ value; 0: it is not one; -1: it is one, and does not fit a cell, read as
|
||||
\ signed or as unsigned. A token that has a character that is not a digit
|
||||
\ is not a number, even when its digits so far did not fit.
|
||||
\
|
||||
\ State, in the ROM's area (MACHINE.md 2.1): (NBASE) 10 or 16, (NNEG) 1 after
|
||||
\ a `-`, (NI) the next character, (NU) the value so far, unsigned, (NBIG) 1
|
||||
\ once it has not fitted. Width constants from the map: MSB, the cell's top
|
||||
\ bit; DEC-LIMIT, the largest unsigned cell over 10; DEC-NLAST, minus one
|
||||
\ more than its remainder; HEX-HIGH, the top four bits. Uses A. The
|
||||
\ token's characters are read with in.f18's (CHAR@).
|
||||
|
||||
\ ( c -- d | -1 ) the digit c is in the base, or -1
|
||||
: (DIGIT)
|
||||
dup -48 + -if D1 drop drop -1 ; \ below '0'
|
||||
D1: dup -10 + -if D2 drop push drop pop ; \ '0' .. '9'
|
||||
D2: drop drop
|
||||
(NBASE) a! @ 16 xor if HEXL drop drop -1 ;
|
||||
HEXL: drop
|
||||
dup -97 + -if LOW drop
|
||||
dup -65 + -if UP drop drop -1 ; \ below 'A'
|
||||
UP: dup -6 + -if BAD drop push drop pop 10 + ;
|
||||
LOW: dup -6 + -if BAD drop push drop pop 10 + ;
|
||||
BAD: drop drop drop -1 ;
|
||||
|
||||
\ ( d -- ) (NU) := (NU) * base + d, or (NBIG) := 1 if that does not fit
|
||||
: (ACC)
|
||||
(NU) a! @
|
||||
(NBASE) a! @ 16 xor if X16 drop
|
||||
dup -if DPOS drop jump DBIG \ the top bit is set
|
||||
DPOS: drop
|
||||
dup inv 1 + DEC-LIMIT + -if DLE drop jump DBIG
|
||||
DLE: if DEQ drop jump MUL10
|
||||
DEQ: drop over DEC-NLAST + -if DBIG3 drop jump MUL10
|
||||
DBIG3: drop
|
||||
DBIG: 1 (NBIG) a! ! drop drop ;
|
||||
MUL10: 2* dup 2* 2* + + (NU) a! ! ;
|
||||
X16: drop
|
||||
dup HEX-HIGH and if HOK drop jump DBIG
|
||||
HOK: drop 2* 2* 2* 2* + (NU) a! ! ;
|
||||
|
||||
\ ( -- n flag )
|
||||
: (NUMBER)
|
||||
0 (NBIG) a! ! 0 (NNEG) a! ! 0 (NU) a! ! 0 (NI) a! ! 10 (NBASE) a! !
|
||||
0 (CHAR@)
|
||||
dup 36 xor if HEX drop
|
||||
dup 45 xor if NEG drop drop jump DIGITS
|
||||
HEX: drop drop 16 (NBASE) a! ! 1 (NI) a! ! jump DIGITS
|
||||
NEG: drop drop 1 (NNEG) a! ! 1 (NI) a! !
|
||||
DIGITS: (NI) a! @ (TOKN) a! @ xor if NONE drop
|
||||
L: (NI) a! @ (CHAR@) (DIGIT)
|
||||
-if OK drop 0 0 ;
|
||||
OK: (ACC)
|
||||
(NI) a! @ 1 + dup ! (TOKN) a! @ xor if DONE drop jump L
|
||||
DONE: drop
|
||||
(NBIG) a! @ if FITS drop 0 -1 ;
|
||||
FITS: drop (NNEG) a! @ if POS drop
|
||||
(NU) a! @ -if NEGOK
|
||||
MSB xor if EXACT drop 0 -1 ;
|
||||
EXACT: drop MSB 1 ;
|
||||
NEGOK: inv 1 + 1 ;
|
||||
POS: drop (NU) a! @ 1 ;
|
||||
NONE: drop 0 0 ;
|
||||
@@ -0,0 +1,76 @@
|
||||
/* test_host_rom_num.c -- the ROM reads numbers as v4/src/text.c does.
|
||||
*
|
||||
* Plan Task 3. (NUMBER) ( -- n flag ) looks at the token (TOKEN) read: flag
|
||||
* 1 if the whole token is a number, 0 if it is not one, -1 if it is one that
|
||||
* does not fit a cell. A number is decimal with an optional leading `-`, or
|
||||
* hexadecimal after `$` (a-f in either case), and must fit a cell read as
|
||||
* signed or as unsigned. Every case is also given to text.c, the oracle,
|
||||
* so the test cannot drift from it.
|
||||
*/
|
||||
#include "rom_harness.h"
|
||||
#include "v4/text.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)
|
||||
|
||||
static v4_node n, oracle_node;
|
||||
static v4_text tx;
|
||||
|
||||
/* text.c's verdict on `tok`: 1 and its value, 0, or -1 */
|
||||
static int oracle(const char *tok, v4_cell *value)
|
||||
{
|
||||
char src[160];
|
||||
v4_node_reset(&oracle_node);
|
||||
v4_text_begin(&tx, &oracle_node, 16);
|
||||
snprintf(src, sizeof src, "constant X %s : T X ;", tok);
|
||||
if (v4_text_assemble(&tx, src) && v4_text_finish(&tx)) { *value = oracle_node.mem[17]; return 1; }
|
||||
if (strstr(v4_text_error(&tx), "does not fit")) return -1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* the ROM's verdict on `tok` */
|
||||
static int rom(const char *tok, v4_cell *value)
|
||||
{
|
||||
char in[80];
|
||||
v4_cell flag;
|
||||
rom_boot(&n);
|
||||
snprintf(in, sizeof in, "%s \x04", tok);
|
||||
v4_node_console_feed(&n, in, (unsigned)strlen(in));
|
||||
if (!rom_call(&n, "(TOKEN)", 100000)) return 99;
|
||||
(void)v4_dstack_pop(&n.ds);
|
||||
if (!rom_call(&n, "(NUMBER)", 100000)) return 98;
|
||||
flag = v4_dstack_pop(&n.ds);
|
||||
*value = v4_dstack_pop(&n.ds);
|
||||
return (int)flag;
|
||||
}
|
||||
|
||||
static void same(const char *tok)
|
||||
{
|
||||
v4_cell ov = 0, rv = 0;
|
||||
int o = oracle(tok, &ov), r = rom(tok, &rv);
|
||||
CHECK(o == r && (o != 1 || ov == rv), "%s: text.c %d %ld, ROM %d %ld", tok, o, (long)ov, r, (long)rv);
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
#if V4_CELL_BITS == 64
|
||||
static const char *const width[] = {
|
||||
"$FFFFFFFFFFFFFFFF", "$10000000000000000", "18446744073709551615", "18446744073709551616",
|
||||
"-9223372036854775808", "-9223372036854775809", "$7FFFFFFFFFFFFFFF", "99999999999999999999999"
|
||||
};
|
||||
#else
|
||||
static const char *const width[] = {
|
||||
"$FFFFFFFF", "$100000000", "4294967295", "4294967296",
|
||||
"-2147483648", "-2147483649", "$7FFFFFFF", "99999999999"
|
||||
};
|
||||
#endif
|
||||
static const char *const any[] = {
|
||||
"0", "1", "7", "10", "-1", "-0", "123456", "$0", "$ff", "$FF", "$aBcD", "$10",
|
||||
"-$1", "1a", "-", "$", "$g", "a", "--1", "+1", "1-", "00012", "$000"
|
||||
};
|
||||
unsigned i;
|
||||
for (i = 0; i < sizeof any / sizeof any[0]; i++) same(any[i]);
|
||||
for (i = 0; i < sizeof width / sizeof width[0]; i++) same(width[i]);
|
||||
printf("test_host_rom_num: %d checks, %d failures\n", checks, failures);
|
||||
return failures != 0;
|
||||
}
|
||||
Reference in New Issue
Block a user