mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-05 08:40:54 +11:00
xcomp: add XCOMPILE and X[COMPILE]
This allows us to move words like ABORT" to xcomp-core, which is I think the last roadblock before being able to unify all drivers into a single xcomp layer.
This commit is contained in:
parent
44b065ff99
commit
dfe474ca0e
8
blk/263
8
blk/263
@ -5,7 +5,11 @@ VARIABLE XCURRENT
|
|||||||
|
|
||||||
: (xentry) XCON (entry) XCOFF ;
|
: (xentry) XCON (entry) XCOFF ;
|
||||||
: XCREATE (xentry) 11 C, ;
|
: XCREATE (xentry) 11 C, ;
|
||||||
|
|
||||||
: XCODE XCON CODE XCOFF ;
|
: XCODE XCON CODE XCOFF ;
|
||||||
|
|
||||||
: XIMM XCON IMMEDIATE XCOFF ;
|
: XIMM XCON IMMEDIATE XCOFF ;
|
||||||
|
: _xapply ( a -- a-off )
|
||||||
|
DUP ORG @ > IF ORG @ - BIN( @ + THEN ;
|
||||||
|
: XCOMPILE
|
||||||
|
XCON ' _xapply LITA
|
||||||
|
LIT< , (find) DROP _xapply , XCOFF ;
|
||||||
|
: X[COMPILE] XCON ' _xapply , XCOFF ;
|
||||||
|
2
blk/265
2
blk/265
@ -4,7 +4,7 @@
|
|||||||
XCURRENT @ SWAP ( xcur w ) _find ( a f )
|
XCURRENT @ SWAP ( xcur w ) _find ( a f )
|
||||||
IF ( a )
|
IF ( a )
|
||||||
DUP IMMED? IF ABORT THEN
|
DUP IMMED? IF ABORT THEN
|
||||||
DUP ORG @ > IF ORG @ - BIN( @ + THEN ,
|
_xapply ,
|
||||||
ELSE ( w )
|
ELSE ( w )
|
||||||
0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
|
0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
|
||||||
IF DUP IMMED? NOT IF ABORT THEN EXECUTE
|
IF DUP IMMED? NOT IF ABORT THEN EXECUTE
|
||||||
|
2
blk/288
2
blk/288
@ -1,4 +1,4 @@
|
|||||||
PC ORG @ 0x22 + ! ( litWord, 0xf7, very tight on the 0x100 limit )
|
PC ORG @ 0x22 + ! ( litWord, 0xf7, tight on the 0x100 limit )
|
||||||
( Like numberWord, but instead of being followed by a 2 bytes
|
( Like numberWord, but instead of being followed by a 2 bytes
|
||||||
number, it's followed by a null-terminated string. When
|
number, it's followed by a null-terminated string. When
|
||||||
called, puts the string's address on PS )
|
called, puts the string's address on PS )
|
||||||
|
22
blk/416
22
blk/416
@ -1,14 +1,14 @@
|
|||||||
( LITN has to be defined after the last immediate usage of
|
: EMIT
|
||||||
it to avoid bootstrapping issues )
|
( 0x53==(emit) override )
|
||||||
: LITN 32 , , ( 32 == NUMBER ) ;
|
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
|
||||||
|
|
||||||
: IMMED? 1- C@ 0x80 AND ;
|
: (print)
|
||||||
|
BEGIN
|
||||||
|
C@+ ( a+1 c )
|
||||||
|
( exit if null or 0xd )
|
||||||
|
DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
|
||||||
|
EMIT ( a )
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
( ';' can't have its name right away because, when created, it
|
|
||||||
is not an IMMEDIATE yet and will not be treated properly by
|
|
||||||
xcomp. )
|
|
||||||
: _
|
|
||||||
['] EXIT ,
|
|
||||||
R> DROP ( exit : )
|
|
||||||
; IMMEDIATE
|
|
||||||
|
|
||||||
|
25
blk/417
25
blk/417
@ -1,16 +1,13 @@
|
|||||||
XCURRENT @ ( to PSP )
|
: ,"
|
||||||
: :
|
|
||||||
(entry)
|
|
||||||
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
|
||||||
issues. Same thing for ",".
|
|
||||||
32 == NUMBER 14 == compiledWord )
|
|
||||||
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
|
|
||||||
BEGIN
|
BEGIN
|
||||||
WORD
|
C<
|
||||||
(find)
|
( 34 is ASCII for " )
|
||||||
( is word )
|
DUP 34 = IF DROP EXIT THEN C,
|
||||||
IF DUP IMMED? IF EXECUTE ELSE , THEN
|
|
||||||
( maybe number )
|
|
||||||
ELSE (parse) LITN THEN
|
|
||||||
AGAIN ;
|
AGAIN ;
|
||||||
( from PSP ) ';' SWAP 4 - C!
|
|
||||||
|
: ."
|
||||||
|
34 , ( 34 == litWord ) ," 0 C,
|
||||||
|
COMPILE (print)
|
||||||
|
; IMMEDIATE
|
||||||
|
|
||||||
|
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
||||||
|
14
blk/418
Normal file
14
blk/418
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
( 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. )
|
||||||
|
: _
|
||||||
|
['] EXIT ,
|
||||||
|
R> DROP ( exit : )
|
||||||
|
; IMMEDIATE
|
||||||
|
|
16
blk/419
Normal file
16
blk/419
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
XCURRENT @ ( to PSP )
|
||||||
|
: :
|
||||||
|
(entry)
|
||||||
|
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
||||||
|
issues. Same thing for ",".
|
||||||
|
32 == NUMBER 14 == compiledWord )
|
||||||
|
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
|
||||||
|
BEGIN
|
||||||
|
WORD
|
||||||
|
(find)
|
||||||
|
( is word )
|
||||||
|
IF DUP IMMED? IF EXECUTE ELSE , THEN
|
||||||
|
( maybe number )
|
||||||
|
ELSE (parse) LITN THEN
|
||||||
|
AGAIN ;
|
||||||
|
( from PSP ) ';' SWAP 4 - C!
|
2
blk/420
2
blk/420
@ -8,6 +8,6 @@ itself to a full intepreter, which can then be relinked with
|
|||||||
the Relinker. There is no loader for these libraries because
|
the Relinker. There is no loader for these libraries because
|
||||||
you will typically XPACK (B267) them.
|
you will typically XPACK (B267) them.
|
||||||
|
|
||||||
422 core 438 print
|
422 core 440 print
|
||||||
442 fmt 447 readln
|
442 fmt 447 readln
|
||||||
453 blk
|
453 blk
|
||||||
|
13
blk/438
13
blk/438
@ -1,13 +0,0 @@
|
|||||||
: EMIT
|
|
||||||
( 0x53==(emit) override )
|
|
||||||
83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
|
|
||||||
|
|
||||||
: (print)
|
|
||||||
BEGIN
|
|
||||||
C@+ ( a+1 c )
|
|
||||||
( exit if null or 0xd )
|
|
||||||
DUP 13 = OVER NOT OR IF 2DROP EXIT THEN
|
|
||||||
EMIT ( a )
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
16
blk/439
16
blk/439
@ -1,16 +0,0 @@
|
|||||||
: ,"
|
|
||||||
BEGIN
|
|
||||||
C<
|
|
||||||
( 34 is ASCII for " )
|
|
||||||
DUP 34 = IF DROP EXIT THEN C,
|
|
||||||
AGAIN ;
|
|
||||||
|
|
||||||
: ."
|
|
||||||
34 , ( 34 == litWord ) ," 0 C,
|
|
||||||
COMPILE (print)
|
|
||||||
; IMMEDIATE
|
|
||||||
|
|
||||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
|
||||||
|
|
||||||
: (uflw) ABORT" stack underflow" ;
|
|
||||||
|
|
1
blk/440
1
blk/440
@ -1,3 +1,4 @@
|
|||||||
|
: (uflw) ABORT" stack underflow" ;
|
||||||
: BS 8 EMIT ;
|
: BS 8 EMIT ;
|
||||||
: LF 10 EMIT ;
|
: LF 10 EMIT ;
|
||||||
: CR 13 EMIT ;
|
: CR 13 EMIT ;
|
||||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
@ -4,6 +4,8 @@
|
|||||||
212 LOAD ( z80 assembler )
|
212 LOAD ( z80 assembler )
|
||||||
262 LOAD ( xcomp )
|
262 LOAD ( xcomp )
|
||||||
: CODE XCODE ;
|
: CODE XCODE ;
|
||||||
|
: COMPILE XCOMPILE ; IMMEDIATE
|
||||||
|
: [COMPILE] X[COMPILE] ; IMMEDIATE
|
||||||
: IMMEDIATE XIMM ;
|
: IMMEDIATE XIMM ;
|
||||||
: (entry) (xentry) ;
|
: (entry) (xentry) ;
|
||||||
: : [ ' X: , ] ;
|
: : [ ' X: , ] ;
|
||||||
|
@ -10,6 +10,8 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
|
|||||||
212 LOAD ( z80 assembler )
|
212 LOAD ( z80 assembler )
|
||||||
262 LOAD ( xcomp )
|
262 LOAD ( xcomp )
|
||||||
: CODE XCODE ;
|
: CODE XCODE ;
|
||||||
|
: COMPILE XCOMPILE ; IMMEDIATE
|
||||||
|
: [COMPILE] X[COMPILE] ; IMMEDIATE
|
||||||
: IMMEDIATE XIMM ;
|
: IMMEDIATE XIMM ;
|
||||||
: (entry) (xentry) ;
|
: (entry) (xentry) ;
|
||||||
: CREATE XCREATE ;
|
: CREATE XCREATE ;
|
||||||
|
@ -9,6 +9,8 @@ RAMSTART 0x72 + CONSTANT KBD_MEM
|
|||||||
262 LOAD ( xcomp )
|
262 LOAD ( xcomp )
|
||||||
522 LOAD ( font compiler )
|
522 LOAD ( font compiler )
|
||||||
: CODE XCODE ;
|
: CODE XCODE ;
|
||||||
|
: COMPILE XCOMPILE ; IMMEDIATE
|
||||||
|
: [COMPILE] X[COMPILE] ; IMMEDIATE
|
||||||
: IMMEDIATE XIMM ;
|
: IMMEDIATE XIMM ;
|
||||||
: (entry) (xentry) ;
|
: (entry) (xentry) ;
|
||||||
: CREATE XCREATE ; ( for KBD tbls )
|
: CREATE XCREATE ; ( for KBD tbls )
|
||||||
|
@ -4,6 +4,8 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
|
|||||||
212 LOAD ( z80 assembler )
|
212 LOAD ( z80 assembler )
|
||||||
262 LOAD ( xcomp )
|
262 LOAD ( xcomp )
|
||||||
: CODE XCODE ;
|
: CODE XCODE ;
|
||||||
|
: COMPILE XCOMPILE ; IMMEDIATE
|
||||||
|
: [COMPILE] X[COMPILE] ; IMMEDIATE
|
||||||
: IMMEDIATE XIMM ;
|
: IMMEDIATE XIMM ;
|
||||||
: (entry) (xentry) ;
|
: (entry) (xentry) ;
|
||||||
: : [ ' X: , ] ;
|
: : [ ' X: , ] ;
|
||||||
|
Loading…
Reference in New Issue
Block a user