mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 06:40:56 +11:00
Compare commits
3 Commits
a776df27d2
...
53c9580944
Author | SHA1 | Date | |
---|---|---|---|
|
53c9580944 | ||
|
9b01e16f6d | ||
|
cc59d37658 |
1
blk/354
1
blk/354
@ -11,3 +11,4 @@
|
|||||||
: C!+ ( c a -- a+1 ) TUCK C! 1+ ;
|
: C!+ ( c a -- a+1 ) TUCK C! 1+ ;
|
||||||
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
|
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
|
||||||
: C!- ( c a -- a-1 ) TUCK C! 1- ;
|
: C!- ( c a -- a-1 ) TUCK C! 1- ;
|
||||||
|
: LEAVE R> R> DROP I 1- >R >R ; : UNLOOP R> 2R> 2DROP >R ;
|
||||||
|
25
blk/357
25
blk/357
@ -1,16 +1,11 @@
|
|||||||
: (parsed) ( a -- n f )
|
: _ ( a len -- n f )
|
||||||
DUP C@ ( a c )
|
OVER C@ ( a len c )
|
||||||
DUP '-' = IF
|
'-' = IF
|
||||||
DROP 1+ ( a+1 ) (parsed) 0 ROT ( f 0 n )
|
1- SWAP 1+ SWAP ( a+1 len-1 ) _ 0 ROT ( f 0 n )
|
||||||
- SWAP EXIT ( 0-n f )
|
- SWAP EXIT ( 0-n f )
|
||||||
THEN
|
THEN ( a len )
|
||||||
0 SWAP _pdacc ( a r f )
|
0 SWAP ( len ) 0 DO ( a r )
|
||||||
?DUP IF 2DROP 0 EXIT THEN
|
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||||
BEGIN ( a r )
|
IF DROP 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||||
SWAP 1+ ( r a+1 )
|
NIP 1 ;
|
||||||
DUP C@ ( r a c )
|
: (parsed) ( a -- n f ) DUP 1- C@ ( a l ) _ ;
|
||||||
ROT SWAP ( a r c )
|
|
||||||
_pdacc ( a r f )
|
|
||||||
?DUP UNTIL
|
|
||||||
1 = ( a r f )
|
|
||||||
ROT DROP ( r f ) ;
|
|
||||||
|
17
blk/360
17
blk/360
@ -2,14 +2,9 @@
|
|||||||
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
|
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
|
||||||
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
|
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
|
||||||
( We have "0x" prefix )
|
( We have "0x" prefix )
|
||||||
2+
|
DUP 1- C@ ( a len )
|
||||||
0 ( a r )
|
0 SWAP ( len ) 2 DO ( a r )
|
||||||
BEGIN
|
OVER I + C@ ( a r c ) _ ( a r n )
|
||||||
SWAP C@+ ( r a+1 c )
|
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||||
?DUP NOT IF DROP 1 EXIT THEN ( r, 1 )
|
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
|
||||||
_ ( r a n )
|
NIP 1 ;
|
||||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
|
||||||
ROT 16 * + ( a r*16+n )
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
||||||
|
18
blk/362
18
blk/362
@ -2,15 +2,9 @@
|
|||||||
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
|
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
|
||||||
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 )
|
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 )
|
||||||
( We have "0b" prefix )
|
( We have "0b" prefix )
|
||||||
2+
|
DUP 1- C@ ( a len )
|
||||||
0 ( a r )
|
0 SWAP ( len ) 2 DO ( a r )
|
||||||
BEGIN
|
OVER I + C@ ( a r c ) _ ( a r n )
|
||||||
SWAP C@+ ( r a+1 c )
|
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||||
?DUP NOT IF DROP 1 EXIT THEN ( r 1 )
|
SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||||
_ ( r a n )
|
NIP 1 ;
|
||||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
|
||||||
ROT 2 * + ( a r*2+n )
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
||||||
|
|
||||||
|
1
blk/367
1
blk/367
@ -7,4 +7,3 @@
|
|||||||
: / /MOD NIP ;
|
: / /MOD NIP ;
|
||||||
: MOD /MOD DROP ;
|
: MOD /MOD DROP ;
|
||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
: LEAVE R> R> DROP I 1- >R >R ;
|
|
||||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user