izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-18 01:38:05 +11:00
Code Issues 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 07:58:55 -04:00
parent 80d730318a
commit 51997533ff
8 changed files with 14 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
blk/421
View File

@ -1,14 +1,16 @@
: EMIT : EMIT
( 0x53==(emit) override ) ( 0x53==(emit) override )
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ; 0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
: (print) : (print)
BEGIN BEGIN
C@+ ( a+1 c ) C@+ ( a+1 c )
( exit if null or 0xd ) ( exit if null or 0xd )
DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
EMIT ( a ) EMIT ( a )
AGAIN AGAIN ;
; : BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
: CRLF CR LF ; : SPC 32 EMIT ;
: NL 0x0a RAM+ @ ( NLPTR ) DUP IF EXECUTE ELSE DROP CRLF THEN ;
: (ok) SPC LIT" ok" (print) NL ;
: (uflw) LIT" stack underflow" (print) ABORT ;
: (wnf) (print) SPC LIT" word not found" (print) ABORT ;

14
blk/422
View File

@ -1,15 +1,7 @@
: ," : ,"
BEGIN BEGIN
C< C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
( 34 is ASCII for " )
DUP 34 = IF DROP EXIT THEN C,
AGAIN ; AGAIN ;
: LIT" 34 , ( litWord ) ," 0 C, ; IMMEDIATE
: ." : ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
34 , ( 34 == litWord ) ," 0 C,
COMPILE (print)
; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE : ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
: CRLF CR LF ; : SPC 32 EMIT ;
: NL 0x0a RAM+ @ ( NLPTR ) DUP IF EXECUTE ELSE DROP CRLF THEN ;

3
blk/446
View File

@ -1,3 +0,0 @@
: (ok) SPC ." ok" NL ;
: (uflw) ABORT" stack underflow" ;
: (wnf) (print) SPC ABORT" word not found" ;

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 446 XPACKR 440 445 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 446 XPACKR ( core ) 440 445 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 446 XPACKR ( core ) 440 445 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 446 XPACKR ( core ) 440 445 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$ ; _ "