mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 20:08:05 +11:00
Move a bunch of words from XPACKed core to xcomp core
This commit is contained in:
parent
74896051bb
commit
179c66be8a
16
blk/409
Normal file
16
blk/409
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
( Words here until the end of the low part, unlike words
|
||||||
|
preceeding them, aren't immediately needed for boot. But its
|
||||||
|
better to have as many words as possible in the xcomp part. )
|
||||||
|
: H@ HERE @ ;
|
||||||
|
: IMMEDIATE
|
||||||
|
CURRENT @ 1-
|
||||||
|
DUP C@ 128 OR SWAP C! ;
|
||||||
|
: IMMED? 1- C@ 0x80 AND ;
|
||||||
|
: +! SWAP OVER @ + SWAP ! ;
|
||||||
|
: -^ SWAP - ;
|
||||||
|
: / /MOD SWAP DROP ;
|
||||||
|
: MOD /MOD DROP ;
|
||||||
|
: ALLOT HERE +! ;
|
||||||
|
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
||||||
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
|
: LEAVE R> R> DROP I 1- >R >R ;
|
13
blk/410
Normal file
13
blk/410
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
: '? 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 )
|
||||||
|
SWAP DROP
|
||||||
|
;
|
||||||
|
: 2OVER 3 PICK 3 PICK ;
|
||||||
|
: 2SWAP 3 ROLL 3 ROLL ;
|
29
blk/412
29
blk/412
@ -1,16 +1,13 @@
|
|||||||
( Words here until the end of the low part, unlike words
|
: WORD(
|
||||||
preceeding them, aren't immediately needed for boot. But its
|
DUP 1- C@ ( name len field )
|
||||||
better to have as many words as possible in the xcomp part. )
|
127 AND ( 0x7f. remove IMMEDIATE flag )
|
||||||
: H@ HERE @ ;
|
3 + ( fixed header len )
|
||||||
: IMMEDIATE
|
-
|
||||||
CURRENT @ 1-
|
;
|
||||||
DUP C@ 128 OR SWAP C! ;
|
: FORGET
|
||||||
: IMMED? 1- C@ 0x80 AND ;
|
' DUP ( w w )
|
||||||
: +! SWAP OVER @ + SWAP ! ;
|
( HERE must be at the end of prev's word, that is, at the
|
||||||
: -^ SWAP - ;
|
beginning of w. )
|
||||||
: / /MOD SWAP DROP ;
|
WORD( HERE ! ( w )
|
||||||
: MOD /MOD DROP ;
|
PREV CURRENT !
|
||||||
: ALLOT HERE +! ;
|
;
|
||||||
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
|
||||||
: LEAVE R> R> DROP I 1- >R >R ;
|
|
||||||
|
26
blk/413
26
blk/413
@ -1,13 +1,15 @@
|
|||||||
: '? WORD (find) ;
|
: DOES>
|
||||||
: '
|
( Overwrite cellWord in CURRENT )
|
||||||
'? (?br) [ 4 , ] EXIT
|
( 43 == doesWord )
|
||||||
LIT< (wnf) (find) DROP EXECUTE
|
43 CURRENT @ C!
|
||||||
|
( When we have a DOES>, we forcefully place HERE to 4
|
||||||
|
bytes after CURRENT. This allows a DOES word to use ","
|
||||||
|
and "C," without messing everything up. )
|
||||||
|
CURRENT @ 3 + HERE !
|
||||||
|
( HERE points to where we should write R> )
|
||||||
|
R> ,
|
||||||
|
( We're done. Because we've popped RS, we'll exit parent
|
||||||
|
definition )
|
||||||
;
|
;
|
||||||
: ROLL
|
: CONSTANT CREATE , DOES> @ ;
|
||||||
DUP NOT IF EXIT THEN
|
|
||||||
1+ DUP PICK ( n val )
|
|
||||||
SWAP 2 * (roll) ( val )
|
|
||||||
SWAP DROP
|
|
||||||
;
|
|
||||||
: 2OVER 3 PICK 3 PICK ;
|
|
||||||
: 2SWAP 3 ROLL 3 ROLL ;
|
|
||||||
|
13
blk/415
13
blk/415
@ -1,13 +0,0 @@
|
|||||||
: WORD(
|
|
||||||
DUP 1- C@ ( name len field )
|
|
||||||
127 AND ( 0x7f. remove IMMEDIATE flag )
|
|
||||||
3 + ( fixed header len )
|
|
||||||
-
|
|
||||||
;
|
|
||||||
: FORGET
|
|
||||||
' DUP ( w w )
|
|
||||||
( HERE must be at the end of prev's word, that is, at the
|
|
||||||
beginning of w. )
|
|
||||||
WORD( HERE ! ( w )
|
|
||||||
PREV CURRENT !
|
|
||||||
;
|
|
15
blk/444
15
blk/444
@ -1,15 +0,0 @@
|
|||||||
: DOES>
|
|
||||||
( Overwrite cellWord in CURRENT )
|
|
||||||
( 43 == doesWord )
|
|
||||||
43 CURRENT @ C!
|
|
||||||
( When we have a DOES>, we forcefully place HERE to 4
|
|
||||||
bytes after CURRENT. This allows a DOES word to use ","
|
|
||||||
and "C," without messing everything up. )
|
|
||||||
CURRENT @ 3 + HERE !
|
|
||||||
( HERE points to where we should write R> )
|
|
||||||
R> ,
|
|
||||||
( We're done. Because we've popped RS, we'll exit parent
|
|
||||||
definition )
|
|
||||||
;
|
|
||||||
: CONSTANT CREATE , DOES> @ ;
|
|
||||||
|
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user