izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-23 20:08:05 +11:00
Code Issues Releases Wiki Activity

wip

Browse Source
This commit is contained in:
Virgil Dupras 2020-05-25 07:29:47 -04:00
parent 98d23bc59b
commit c668433c5d
7 changed files with 48 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
blk/367 Normal file
View 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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

Binary file not shown.

3
emul/stage.c
View File

@ -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)