izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

parse: use "0<" instead of "0 <"

Browse Source 
As I wrote in my "Clarify signed-ness" commit, "0 <" is broken.

Also, made this unit a bit more compact. The RC2014 stage1 can
really use some breathing room...
This commit is contained in:
Virgil Dupras 2020-04-18 09:13:23 -04:00
parent 66f65daa08
commit b062a9092a
6 changed files with 22 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
blk/018
View File

@ -5,7 +5,7 @@ unsigned. For convenience, decimal parsing and formatting
support the "-" prefix, but under the hood, it's all unsigned.
This leads to some oddities. For example, "-1 0 <" is false.
To compare whether something is negative, use the "<0" word
To compare whether something is negative, use the "0<" word
which is the equivalent to "0x7fff >".

BIN
emul/forth/z80c.bin
View File

Binary file not shown.

3
forth/cmp.fs
View File

@ -2,8 +2,7 @@
: >= < NOT ;
: <= > NOT ;
: <0 32767 > ;
: >=0 <0 NOT ;
: 0>= 0< NOT ;
( n1 -- n1 true )
: <>{ 1 ;

2
forth/fmt.fs
View File

@ -12,7 +12,7 @@
: . ( n -- )
( handle negative )
DUP <0 IF '-' EMIT -1 * THEN
DUP 0< IF '-' EMIT -1 * THEN
_
BEGIN
DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done )

3
forth/icore.fs
View File

@ -51,6 +51,7 @@
: = CMP NOT ;
: < CMP -1 = ;
: > CMP 1 = ;
: 0< 32767 > ;
( r c -- r f )
( Parse digit c and accumulate into result r.
@ -61,7 +62,7 @@
( parse char )
'0' -
( if bad, return "r -1" )
DUP 0 < IF DROP -1 EXIT THEN ( bad )
DUP 0< IF DROP -1 EXIT THEN ( bad )
DUP 9 > IF DROP -1 EXIT THEN ( bad )
( good, add to running result )
SWAP 10 * + ( r*10+n )

36
forth/parse.fs
View File

@ -11,14 +11,14 @@
;
( returns negative value on error )
: hexdig ( c -- n )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0 < IF EXIT THEN ( bad )
DUP 0< IF EXIT THEN ( bad )
DUP 10 < IF EXIT THEN ( good )
( 'a' is ASCII 97. 59 = 97 - 48 )
49 -
DUP 0 < IF EXIT THEN ( bad )
DUP 0< IF EXIT THEN ( bad )
DUP 6 < IF 10 + EXIT THEN ( good )
( bad )
255 -
@ -31,24 +31,23 @@
2+
( validate slen )
DUP SLEN ( a l )
DUP 0 = IF DROP 0 EXIT THEN ( a 0 )
DUP NOT IF DROP 0 EXIT THEN ( a 0 )
4 > IF DROP 0 EXIT THEN ( a 0 )
0 ( a r )
0 ( a r )
BEGIN
OVER C@
DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 )
hexdig ( a r n )
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 )
SWAP 16 * + ( a r*16+n )
SWAP 1+ SWAP ( a+1 r )
SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 )
_ ( r a n )
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
ROT 16 * + ( a r*16+n )
AGAIN
;
( returns negative value on error )
: bindig ( c -- n )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0 < IF EXIT THEN ( bad )
DUP 0< IF EXIT THEN ( bad )
DUP 2 < IF EXIT THEN ( good )
( bad )
255 -
@ -65,12 +64,11 @@
16 > IF DROP 0 EXIT THEN ( a 0 )
0 ( a r )
BEGIN
OVER C@
DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 )
bindig ( a r n )
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 )
SWAP 2 * + ( a r*2+n )
SWAP 1+ SWAP ( a+1 r )
SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 1 EXIT THEN ( r 1 )
_ ( r a n )
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
ROT 2 * + ( a r*2+n )
AGAIN
;