1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-27 15:08:05 +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:
Virgil Dupras 2020-05-12 21:08:18 -04:00
parent 44b065ff99
commit dfe474ca0e
17 changed files with 71 additions and 60 deletions

View File

@ -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 ;

View File

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

View File

@ -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 )

View File

@ -1 +1 @@
1 2 LOADR+ 1 4 LOADR+

22
blk/416
View File

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

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

View File

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

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

@ -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" ;

View File

@ -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 ;

Binary file not shown.

View File

@ -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: , ] ;

View File

@ -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 ;

View File

@ -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 )

View File

@ -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: , ] ;