mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-24 14:28:06 +11:00
Move a bunch of words from XPACKed core to xcomp core
This commit is contained in:
parent
51997533ff
commit
40a756cf1c
6
blk/412
6
blk/412
@ -4,13 +4,13 @@
|
||||
: H@ HERE @ ;
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C!
|
||||
;
|
||||
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 ;
|
||||
|
4
blk/434
4
blk/434
@ -2,3 +2,7 @@
|
||||
( b1 b2 -- )
|
||||
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
|
||||
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
|
||||
( Now we have "as late as possible" stuff )
|
||||
: DO COMPILE 2>R H@ ; IMMEDIATE
|
||||
: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
|
||||
( LEAVE is implemented in low xcomp )
|
||||
|
4
blk/435
4
blk/435
@ -1,9 +1,5 @@
|
||||
( LITN has to be defined after the last immediate usage of
|
||||
it to avoid bootstrapping issues )
|
||||
: LITN 32 , , ( 32 == NUMBER ) ;
|
||||
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
|
||||
( ';' can't have its name right away because, when created, it
|
||||
is not an IMMEDIATE yet and will not be treated properly by
|
||||
xcomp. )
|
||||
|
1
blk/444
1
blk/444
@ -11,4 +11,5 @@
|
||||
( We're done. Because we've popped RS, we'll exit parent
|
||||
definition )
|
||||
;
|
||||
: CONSTANT CREATE , DOES> @ ;
|
||||
|
||||
|
8
blk/445
8
blk/445
@ -1,8 +0,0 @@
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
: CONSTANT CREATE , DOES> @ ;
|
||||
|
||||
( In addition to pushing H@ this compiles 2>R so that loop
|
||||
variables are sent to PS at runtime )
|
||||
: DO COMPILE 2>R H@ ; IMMEDIATE
|
||||
: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
|
||||
( LEAVE is implemented in xcomp )
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
@ -14,7 +14,7 @@
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
," CURRENT @ HERE ! "
|
||||
440 445 XPACKR
|
||||
440 444 XPACKR
|
||||
," ' (key) 12 RAM+ ! "
|
||||
ORG @ 256 /MOD 2 PC! 2 PC!
|
||||
H@ 256 /MOD 2 PC! 2 PC!
|
||||
|
@ -18,7 +18,7 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
440 445 XPACKR ( core )
|
||||
440 444 XPACKR ( core )
|
||||
123 132 XPACKR ( linker )
|
||||
," : _ ACIA$ RDLN$ (ok) ; _ "
|
||||
ORG @ 256 /MOD 2 PC! 2 PC!
|
||||
|
@ -68,7 +68,7 @@ CREATE ~FNT CPFNT3x5
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
440 445 XPACKR ( core )
|
||||
440 444 XPACKR ( core )
|
||||
," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
|
||||
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
|
||||
H@ 256 /MOD 2 PC! 2 PC!
|
||||
|
@ -14,7 +14,7 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
," CURRENT @ HERE ! "
|
||||
440 445 XPACKR ( core )
|
||||
440 444 XPACKR ( core )
|
||||
499 500 XPACKR ( trs80.fs )
|
||||
( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
|
||||
," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "
|
||||
|
Loading…
Reference in New Issue
Block a user