rajamesandClaude Opus 5.5
080811dbd2
(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>
68 lines
2.6 KiB
Plaintext
68 lines
2.6 KiB
Plaintext
\ 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 ;
|