Compare commits
5 Commits
98d23bc59b
...
53c9580944
Author | SHA1 | Date | |
---|---|---|---|
|
53c9580944 | ||
|
9b01e16f6d | ||
|
cc59d37658 | ||
|
a776df27d2 | ||
|
c668433c5d |
24
blk/328
24
blk/328
@ -1,14 +1,16 @@
|
||||
CODE S=
|
||||
DE POPqq,
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
BEGIN,
|
||||
LDA(DE),
|
||||
(HL) CPr,
|
||||
JRNZ, BREAK, ( not equal? break early. NZ is set. )
|
||||
A ORr, ( if our char is null, stop )
|
||||
HL INCss,
|
||||
DE INCss,
|
||||
JRNZ, AGAIN,
|
||||
DE POPqq, HL POPqq, chkPS,
|
||||
HL DECss, DE DECss,
|
||||
LDA(DE),
|
||||
(HL) CPr,
|
||||
IFZ, ( same size? )
|
||||
B A LDrr, ( loop A times )
|
||||
BEGIN,
|
||||
HL INCss, DE INCss,
|
||||
LDA(DE),
|
||||
(HL) CPr,
|
||||
JRNZ, BREAK, ( not equal? break early. NZ is set. )
|
||||
DJNZ, AGAIN,
|
||||
THEN,
|
||||
PUSHZ,
|
||||
;CODE
|
||||
|
1
blk/354
1
blk/354
@ -11,3 +11,4 @@
|
||||
: C!+ ( c a -- a+1 ) TUCK C! 1+ ;
|
||||
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
|
||||
: 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 )
|
||||
DUP C@ ( a c )
|
||||
DUP '-' = IF
|
||||
DROP 1+ ( a+1 ) (parsed) 0 ROT ( f 0 n )
|
||||
: _ ( a len -- n f )
|
||||
OVER C@ ( a len c )
|
||||
'-' = IF
|
||||
1- SWAP 1+ SWAP ( a+1 len-1 ) _ 0 ROT ( f 0 n )
|
||||
- SWAP EXIT ( 0-n f )
|
||||
THEN
|
||||
0 SWAP _pdacc ( a r f )
|
||||
?DUP IF 2DROP 0 EXIT THEN
|
||||
BEGIN ( a r )
|
||||
SWAP 1+ ( r a+1 )
|
||||
DUP C@ ( r a c )
|
||||
ROT SWAP ( a r c )
|
||||
_pdacc ( a r f )
|
||||
?DUP UNTIL
|
||||
1 = ( a r f )
|
||||
ROT DROP ( r f ) ;
|
||||
THEN ( a len )
|
||||
0 SWAP ( len ) 0 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||
IF DROP 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||
NIP 1 ;
|
||||
: (parsed) ( a -- n f ) DUP 1- C@ ( a l ) _ ;
|
||||
|
17
blk/360
17
blk/360
@ -2,14 +2,9 @@
|
||||
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
|
||||
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0x" prefix )
|
||||
2+
|
||||
0 ( a r )
|
||||
BEGIN
|
||||
SWAP C@+ ( r a+1 c )
|
||||
?DUP NOT IF DROP 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
|
||||
;
|
||||
|
||||
DUP 1- C@ ( a len )
|
||||
0 SWAP ( len ) 2 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
|
||||
NIP 1 ;
|
||||
|
18
blk/362
18
blk/362
@ -2,15 +2,9 @@
|
||||
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
|
||||
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0b" prefix )
|
||||
2+
|
||||
0 ( a r )
|
||||
BEGIN
|
||||
SWAP C@+ ( r a+1 c )
|
||||
?DUP NOT IF DROP 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
|
||||
;
|
||||
|
||||
|
||||
DUP 1- C@ ( a len )
|
||||
0 SWAP ( len ) 2 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||
NIP 1 ;
|
||||
|
9
blk/367
Normal file
9
blk/367
Normal file
@ -0,0 +1,9 @@
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C! ;
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
: +! TUCK @ + SWAP ! ;
|
||||
: -^ SWAP - ;
|
||||
: / /MOD NIP ;
|
||||
: MOD /MOD DROP ;
|
||||
: ALLOT HERE +! ;
|
12
blk/368
12
blk/368
@ -1,12 +0,0 @@
|
||||
: +! TUCK @ + SWAP ! ;
|
||||
: [entry] ( w -- )
|
||||
H@ SWAP
|
||||
BEGIN C@+ ( w+1 c ) ?DUP IF C, 0 ELSE 1 THEN UNTIL DROP
|
||||
H@ SWAP - ( sz )
|
||||
( write prev value )
|
||||
H@ CURRENT @ - ,
|
||||
C, ( write size )
|
||||
H@ CURRENT !
|
||||
;
|
||||
|
||||
: (entry) WORD [entry] ;
|
23
blk/369
23
blk/369
@ -1,11 +1,12 @@
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C! ;
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
: -^ SWAP - ;
|
||||
: / /MOD NIP ;
|
||||
: MOD /MOD DROP ;
|
||||
: ALLOT HERE +! ;
|
||||
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
: LEAVE R> R> DROP I 1- >R >R ;
|
||||
: '? WORD FIND ;
|
||||
: '
|
||||
'? (?br) [ 4 , ] EXIT
|
||||
LIT< (wnf) FIND DROP EXECUTE
|
||||
;
|
||||
: ROLL
|
||||
?DUP NOT IF EXIT THEN
|
||||
1+ DUP PICK ( n val )
|
||||
SWAP 2 * (roll) ( val )
|
||||
NIP ;
|
||||
: 2OVER 3 PICK 3 PICK ;
|
||||
: 2SWAP 3 ROLL 3 ROLL ;
|
||||
|
26
blk/370
26
blk/370
@ -1,12 +1,14 @@
|
||||
: '? WORD FIND ;
|
||||
: '
|
||||
'? (?br) [ 4 , ] EXIT
|
||||
LIT< (wnf) FIND DROP EXECUTE
|
||||
;
|
||||
: ROLL
|
||||
?DUP NOT IF EXIT THEN
|
||||
1+ DUP PICK ( n val )
|
||||
SWAP 2 * (roll) ( val )
|
||||
NIP ;
|
||||
: 2OVER 3 PICK 3 PICK ;
|
||||
: 2SWAP 3 ROLL 3 ROLL ;
|
||||
: MOVE ( a1 a2 u -- )
|
||||
( u ) 0 DO ( a1 a2 )
|
||||
SWAP C@+ ( a2 a1+1 x )
|
||||
ROT C!+ ( a1+1 a2+1 )
|
||||
LOOP 2DROP ;
|
||||
: MOVE- ( a1 a2 u -- )
|
||||
TUCK + 1- ( a1 u a2+u-1 )
|
||||
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||
ROT ( u ) 0 DO ( a2 a1 )
|
||||
C@- ( a2 a1-1 x )
|
||||
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
||||
LOOP 2DROP ;
|
||||
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
|
||||
: PREV 3 - DUP @ - ;
|
||||
|
24
blk/371
24
blk/371
@ -1,14 +1,10 @@
|
||||
: MOVE ( a1 a2 u -- )
|
||||
( u ) 0 DO ( a1 a2 )
|
||||
SWAP C@+ ( a2 a1+1 x )
|
||||
ROT C!+ ( a1+1 a2+1 )
|
||||
LOOP 2DROP ;
|
||||
: MOVE- ( a1 a2 u -- )
|
||||
TUCK + 1- ( a1 u a2+u-1 )
|
||||
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||
ROT ( u ) 0 DO ( a2 a1 )
|
||||
C@- ( a2 a1-1 x )
|
||||
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
||||
LOOP 2DROP ;
|
||||
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
|
||||
: PREV 3 - DUP @ - ;
|
||||
: [entry] ( w -- )
|
||||
1- C@+ ( w+1 len ) TUCK MOVE, ( len )
|
||||
( write prev value )
|
||||
H@ CURRENT @ - ,
|
||||
C, ( write size )
|
||||
H@ CURRENT !
|
||||
;
|
||||
: (entry) WORD [entry] ;
|
||||
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
@ -42,7 +42,8 @@ static uint8_t iord_stdio()
|
||||
|
||||
static void iowr_stdio(uint8_t val)
|
||||
{
|
||||
// we don't output stdout in stage0
|
||||
// uncomment when you need to debug staging
|
||||
// putc(val, stderr);
|
||||
}
|
||||
|
||||
static void iowr_here(uint8_t val)
|
||||
|
Loading…
Reference in New Issue
Block a user