mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 06:30:55 +11:00
Compare commits
2 Commits
98d23bc59b
...
a776df27d2
Author | SHA1 | Date | |
---|---|---|---|
|
a776df27d2 | ||
|
c668433c5d |
16
blk/328
16
blk/328
@ -1,14 +1,16 @@
|
|||||||
CODE S=
|
CODE S=
|
||||||
DE POPqq,
|
DE POPqq, HL POPqq, chkPS,
|
||||||
HL POPqq,
|
HL DECss, DE DECss,
|
||||||
chkPS,
|
LDA(DE),
|
||||||
|
(HL) CPr,
|
||||||
|
IFZ, ( same size? )
|
||||||
|
B A LDrr, ( loop A times )
|
||||||
BEGIN,
|
BEGIN,
|
||||||
|
HL INCss, DE INCss,
|
||||||
LDA(DE),
|
LDA(DE),
|
||||||
(HL) CPr,
|
(HL) CPr,
|
||||||
JRNZ, BREAK, ( not equal? break early. NZ is set. )
|
JRNZ, BREAK, ( not equal? break early. NZ is set. )
|
||||||
A ORr, ( if our char is null, stop )
|
DJNZ, AGAIN,
|
||||||
HL INCss,
|
THEN,
|
||||||
DE INCss,
|
|
||||||
JRNZ, AGAIN,
|
|
||||||
PUSHZ,
|
PUSHZ,
|
||||||
;CODE
|
;CODE
|
||||||
|
10
blk/367
Normal file
10
blk/367
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
: IMMEDIATE
|
||||||
|
CURRENT @ 1-
|
||||||
|
DUP C@ 128 OR SWAP C! ;
|
||||||
|
: IMMED? 1- C@ 0x80 AND ;
|
||||||
|
: +! TUCK @ + SWAP ! ;
|
||||||
|
: -^ SWAP - ;
|
||||||
|
: / /MOD NIP ;
|
||||||
|
: MOD /MOD DROP ;
|
||||||
|
: ALLOT HERE +! ;
|
||||||
|
: LEAVE R> R> DROP I 1- >R >R ;
|
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
|
: '? WORD FIND ;
|
||||||
CURRENT @ 1-
|
: '
|
||||||
DUP C@ 128 OR SWAP C! ;
|
'? (?br) [ 4 , ] EXIT
|
||||||
: IMMED? 1- C@ 0x80 AND ;
|
LIT< (wnf) FIND DROP EXECUTE
|
||||||
: -^ SWAP - ;
|
;
|
||||||
: / /MOD NIP ;
|
: ROLL
|
||||||
: MOD /MOD DROP ;
|
?DUP NOT IF EXIT THEN
|
||||||
: ALLOT HERE +! ;
|
1+ DUP PICK ( n val )
|
||||||
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
SWAP 2 * (roll) ( val )
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
NIP ;
|
||||||
: LEAVE R> R> DROP I 1- >R >R ;
|
: 2OVER 3 PICK 3 PICK ;
|
||||||
|
: 2SWAP 3 ROLL 3 ROLL ;
|
||||||
|
26
blk/370
26
blk/370
@ -1,12 +1,14 @@
|
|||||||
: '? WORD FIND ;
|
: MOVE ( a1 a2 u -- )
|
||||||
: '
|
( u ) 0 DO ( a1 a2 )
|
||||||
'? (?br) [ 4 , ] EXIT
|
SWAP C@+ ( a2 a1+1 x )
|
||||||
LIT< (wnf) FIND DROP EXECUTE
|
ROT C!+ ( a1+1 a2+1 )
|
||||||
;
|
LOOP 2DROP ;
|
||||||
: ROLL
|
: MOVE- ( a1 a2 u -- )
|
||||||
?DUP NOT IF EXIT THEN
|
TUCK + 1- ( a1 u a2+u-1 )
|
||||||
1+ DUP PICK ( n val )
|
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||||
SWAP 2 * (roll) ( val )
|
ROT ( u ) 0 DO ( a2 a1 )
|
||||||
NIP ;
|
C@- ( a2 a1-1 x )
|
||||||
: 2OVER 3 PICK 3 PICK ;
|
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
||||||
: 2SWAP 3 ROLL 3 ROLL ;
|
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 -- )
|
: [entry] ( w -- )
|
||||||
( u ) 0 DO ( a1 a2 )
|
1- C@+ ( w+1 len ) TUCK MOVE, ( len )
|
||||||
SWAP C@+ ( a2 a1+1 x )
|
( write prev value )
|
||||||
ROT C!+ ( a1+1 a2+1 )
|
H@ CURRENT @ - ,
|
||||||
LOOP 2DROP ;
|
C, ( write size )
|
||||||
: MOVE- ( a1 a2 u -- )
|
H@ CURRENT !
|
||||||
TUCK + 1- ( a1 u a2+u-1 )
|
;
|
||||||
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
: (entry) WORD [entry] ;
|
||||||
ROT ( u ) 0 DO ( a2 a1 )
|
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
||||||
C@- ( a2 a1-1 x )
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
|
||||||
LOOP 2DROP ;
|
|
||||||
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
|
|
||||||
: PREV 3 - DUP @ - ;
|
|
||||||
|
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)
|
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)
|
static void iowr_here(uint8_t val)
|
||||||
|
Loading…
Reference in New Issue
Block a user