izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move a bunch of words from XPACKed core to xcomp core

Browse Source
This commit is contained in:
Virgil Dupras 2020-05-14 08:18:53 -04:00
parent 51997533ff
commit 40a756cf1c
10 changed files with 12 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
blk/412
View File

@ -4,13 +4,13 @@
: H@ HERE @ ; : H@ HERE @ ;
: IMMEDIATE : IMMEDIATE
CURRENT @ 1- CURRENT @ 1-
DUP C@ 128 OR SWAP C! DUP C@ 128 OR SWAP C! ;
; : IMMED? 1- C@ 0x80 AND ;
: +! SWAP OVER @ + SWAP ! ; : +! SWAP OVER @ + SWAP ! ;
: -^ SWAP - ; : -^ SWAP - ;
: / /MOD SWAP DROP ; : / /MOD SWAP DROP ;
: MOD /MOD DROP ; : MOD /MOD DROP ;
: ALLOT HERE +! ; : ALLOT HERE +! ;
: CREATE (entry) 11 ( 11 == cellWord ) C, ; : CREATE (entry) 11 ( 11 == cellWord ) C, ;
: VARIABLE CREATE 2 ALLOT ;
: LEAVE R> R> DROP I 1- >R >R ; : LEAVE R> R> DROP I 1- >R >R ;

4
blk/434
View File

@ -2,3 +2,7 @@
( b1 b2 -- ) ( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; : LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; : 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
View File

@ -1,9 +1,5 @@
( LITN has to be defined after the last immediate usage of
it to avoid bootstrapping issues )
: LITN 32 , , ( 32 == NUMBER ) ; : LITN 32 , , ( 32 == NUMBER ) ;
: IMMED? 1- C@ 0x80 AND ;
( ';' can't have its name right away because, when created, it ( ';' can't have its name right away because, when created, it
is not an IMMEDIATE yet and will not be treated properly by is not an IMMEDIATE yet and will not be treated properly by
xcomp. ) xcomp. )

1
blk/444
View File

@ -11,4 +11,5 @@
( We're done. Because we've popped RS, we'll exit parent ( We're done. Because we've popped RS, we'll exit parent
definition ) definition )
; ;
: CONSTANT CREATE , DOES> @ ;

8
blk/445
View File

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

Binary file not shown.

2
emul/xcomp.fs
View File

@ -14,7 +14,7 @@
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
440 445 XPACKR 440 444 XPACKR
," ' (key) 12 RAM+ ! " ," ' (key) 12 RAM+ ! "
ORG @ 256 /MOD 2 PC! 2 PC! ORG @ 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!

2
recipes/rc2014/xcomp.fs
View File

@ -18,7 +18,7 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
440 445 XPACKR ( core ) 440 444 XPACKR ( core )
123 132 XPACKR ( linker ) 123 132 XPACKR ( linker )
," : _ ACIA$ RDLN$ (ok) ; _ " ," : _ ACIA$ RDLN$ (ok) ; _ "
ORG @ 256 /MOD 2 PC! 2 PC! ORG @ 256 /MOD 2 PC! 2 PC!

2
recipes/ti84/xcomp.fs
View File

@ -68,7 +68,7 @@ CREATE ~FNT CPFNT3x5
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
440 445 XPACKR ( core ) 440 444 XPACKR ( core )
," : _ LCD$ KBD$ (ok) RDLN$ ; _ " ," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC! ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!

2
recipes/trs80/xcomp.fs
View File

@ -14,7 +14,7 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
440 445 XPACKR ( core ) 440 444 XPACKR ( core )
499 500 XPACKR ( trs80.fs ) 499 500 XPACKR ( trs80.fs )
( 0x0a == NLPTR. TRS-80 wants CR-only newlines ) ( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ " ," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "