mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 16:08:06 +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
|
||||
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 ;
|
||||
: 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 !
|
||||
;
|
||||
|
26
blk/413
26
blk/413
@ -1,13 +1,15 @@
|
||||
: '? WORD (find) ;
|
||||
: '
|
||||
'? (?br) [ 4 , ] EXIT
|
||||
LIT< (wnf) (find) DROP EXECUTE
|
||||
: 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 )
|
||||
;
|
||||
: 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 ;
|
||||
: CONSTANT CREATE , DOES> @ ;
|
||||
|
||||
|
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