izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-17 08:58:06 +11:00
Code Issues 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. support the "-" prefix, but under the hood, it's all unsigned.
This leads to some oddities. For example, "-1 0 <" is false. 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 >". 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 ;
: <= > NOT ; : <= > NOT ;
: <0 32767 > ; : 0>= 0< NOT ;
: >=0 <0 NOT ;
( n1 -- n1 true ) ( n1 -- n1 true )
: <>{ 1 ; : <>{ 1 ;

2
forth/fmt.fs
View File

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

1
forth/icore.fs
View File

@ -51,6 +51,7 @@
: = CMP NOT ; : = CMP NOT ;
: < CMP -1 = ; : < CMP -1 = ;
: > CMP 1 = ; : > CMP 1 = ;
: 0< 32767 > ;
( r c -- r f ) ( r c -- r f )
( Parse digit c and accumulate into result r. ( Parse digit c and accumulate into result r.

28
forth/parse.fs
View File

@ -11,7 +11,7 @@
; ;
( returns negative value on error ) ( returns negative value on error )
: hexdig ( c -- n ) : _ ( c -- n )
( '0' is ASCII 48 ) ( '0' is ASCII 48 )
48 - 48 -
DUP 0< IF EXIT THEN ( bad ) DUP 0< IF EXIT THEN ( bad )
@ -31,21 +31,20 @@
2+ 2+
( validate slen ) ( validate slen )
DUP SLEN ( a l ) 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 ) 4 > IF DROP 0 EXIT THEN ( a 0 )
0 ( a r ) 0 ( a r )
BEGIN BEGIN
OVER C@ SWAP C@+ ( r a+1 c )
DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 ) DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 )
hexdig ( a r n ) _ ( r a n )
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
SWAP 16 * + ( a r*16+n ) ROT 16 * + ( a r*16+n )
SWAP 1+ SWAP ( a+1 r )
AGAIN AGAIN
; ;
( returns negative value on error ) ( returns negative value on error )
: bindig ( c -- n ) : _ ( c -- n )
( '0' is ASCII 48 ) ( '0' is ASCII 48 )
48 - 48 -
DUP 0< IF EXIT THEN ( bad ) DUP 0< IF EXIT THEN ( bad )
@ -65,12 +64,11 @@
16 > IF DROP 0 EXIT THEN ( a 0 ) 16 > IF DROP 0 EXIT THEN ( a 0 )
0 ( a r ) 0 ( a r )
BEGIN BEGIN
OVER C@ SWAP C@+ ( r a+1 c )
DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 ) DUP NOT IF 2DROP 1 EXIT THEN ( r 1 )
bindig ( a r n ) _ ( r a n )
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
SWAP 2 * + ( a r*2+n ) ROT 2 * + ( a r*2+n )
SWAP 1+ SWAP ( a+1 r )
AGAIN AGAIN
; ;