1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 06:30:55 +11:00

Compare commits

..

3 Commits

Author SHA1 Message Date
Virgil Dupras
6a5ff3adcb rc2014: unify SD Card driver
Now more low/high layers.
2020-05-12 21:48:29 -04:00
Virgil Dupras
cbf5baf3b6 Pack core words a bit
This leaves space for xcomp-core which is growing.
2020-05-12 21:27:06 -04:00
Virgil Dupras
dfe474ca0e 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.
2020-05-12 21:08:18 -04:00
35 changed files with 187 additions and 180 deletions

View File

@ -7,7 +7,7 @@ MASTER INDEX
200 Z80 assembler 260 Cross compilation
280 Z80 boot code 350 ACIA driver
370 SD Card driver 390 Cross-compiled core
420 Core words 480 AT28 Driver
428 Core words 480 AT28 Driver
490 TRS-80 Recipe 520 Fonts
550 TI-84+ Recipe

View File

@ -5,7 +5,11 @@ VARIABLE XCURRENT
: (xentry) XCON (entry) XCOFF ;
: XCREATE (xentry) 11 C, ;
: XCODE XCON CODE 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 )
IF ( a )
DUP IMMED? IF ABORT THEN
DUP ORG @ > IF ORG @ - BIN( @ + THEN ,
_xapply ,
ELSE ( w )
0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
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
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )

View File

@ -1,4 +1,3 @@
SD Card driver
Load the z80 part with "372 LOAD", the Forth part with
"374 LOAD".
Load range: 372-381

View File

@ -10,5 +10,3 @@ CODE _sdcSR ( n -- n )
L A LDrr,
HL PUSHqq,
;CODE
373 LOAD

View File

@ -9,8 +9,8 @@ unusable directly. For the same reason, any reference to a word
in the host system will obviously be wrong in the target
system. More details in B260.
These rules result in some practicals do's and dont's:
1. No LEAVE in DO..LOOP
(cont.)

View File

@ -13,3 +13,4 @@
: ALLOT HERE +! ;
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
: LEAVE R> R> DROP I 1- >R >R ;

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
it to avoid bootstrapping issues )
: LITN 32 , , ( 32 == NUMBER ) ;
: EMIT
( 0x53==(emit) override )
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
WORD
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse) LITN THEN
C<
( 34 is ASCII for " )
DUP 34 = IF DROP EXIT THEN C,
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!

10
blk/422
View File

@ -1,10 +0,0 @@
: [ INTERPRET ; IMMEDIATE
: ] R> DROP ;
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
: LITA 36 , , ;
: '? WORD (find) ;
: '
'? (?br) [ 4 , ] EXIT
LIT< (wnf) (find) DROP EXECUTE
;
: ['] ' LITA ; IMMEDIATE

View File

@ -1,5 +0,0 @@
: COMPILE ' LITA ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE

13
blk/424
View File

@ -1,13 +0,0 @@
: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
40 CURRENT @ 4 - C!
( Hello, hello, krkrkrkr... do you hear me?
Ah, voice at last! Some lines above need comments
BTW: Forth lines limited to 64 cols because of default
input buffer size in Collapse OS
40 is ASCII for '('. We do this to simplify XPACK's task of
not mistakenly consider '(' definition as a comment.
LIT<: 34 == litWord
LITA: 36 == addrWord
COMPILE: Tough one. Get addr of caller word (example above
(br)) and then call LITA on it. )

12
blk/426
View File

@ -1,12 +0,0 @@
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
COMPILE (br)
2 ALLOT
DUP H@ -^ SWAP ( a-H a )
!
H@ 2- ( push a. -2 for allot offset )
; IMMEDIATE
: [IF]
IF EXIT THEN
LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
: [THEN] ;

View File

@ -8,6 +8,5 @@ itself to a full intepreter, which can then be relinked with
the Relinker. There is no loader for these libraries because
you will typically XPACK (B267) them.
422 core 438 print
442 fmt 447 readln
453 blk
430 core 442 fmt
447 readln 453 blk

27
blk/430
View File

@ -1,14 +1,15 @@
: DOES>
( Overwrite cellWord in CURRENT )
( 43 == doesWord )
43 CURRENT @ C!
( When we have a DOES>, we forcefully place HERE to 4
bytes after CURRENT. This allows a DOES word to use ","
and "C," without messing everything up. )
CURRENT @ 3 + HERE !
( HERE points to where we should write R> )
R> ,
( We're done. Because we've popped RS, we'll exit parent
definition )
: [ INTERPRET ; IMMEDIATE
: ] R> DROP ;
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
: LITA 36 , , ;
: '? WORD (find) ;
: '
'? (?br) [ 4 , ] EXIT
LIT< (wnf) (find) DROP EXECUTE
;
: ['] ' LITA ; IMMEDIATE
: COMPILE ' LITA ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE

19
blk/431
View File

@ -1,8 +1,13 @@
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE , DOES> @ ;
: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
40 CURRENT @ 4 - C!
( Hello, hello, krkrkrkr... do you hear me?
Ah, voice at last! Some lines above need comments
BTW: Forth lines limited to 64 cols because of default
input buffer size in Collapse OS
( 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 R> R> DROP I 1- >R >R ;
40 is ASCII for '('. We do this to simplify XPACK's task of
not mistakenly consider '(' definition as a comment.
LIT<: 34 == litWord
LITA: 36 == addrWord
COMPILE: Tough one. Get addr of caller word (example above
(br)) and then call LITA on it. )

View File

21
blk/433
View File

@ -1,11 +1,12 @@
: ROLL
DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
SWAP DROP
;
: 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ;
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
COMPILE (br)
2 ALLOT
DUP H@ -^ SWAP ( a-H a )
!
H@ 2- ( push a. -2 for allot offset )
; IMMEDIATE
: [IF]
IF EXIT THEN
LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
: [THEN] ;

27
blk/434
View File

@ -1,13 +1,14 @@
: MOVE ( a1 a2 u -- )
( u ) 0 DO ( a1 a2 )
SWAP C@+ ( a2 a1+1 x )
ROT C!+ ( a1+1 a2+1 )
LOOP 2DROP ;
: MOVE- ( a1 a2 u -- )
SWAP OVER + 1- ( a1 u a2+u-1 )
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
ROT ( u ) 0 DO ( a2 a1 )
C@- ( a2 a1-1 x )
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
LOOP 2DROP ;
: PREV 3 - DUP @ - ;
: DOES>
( Overwrite cellWord in CURRENT )
( 43 == doesWord )
43 CURRENT @ C!
( When we have a DOES>, we forcefully place HERE to 4
bytes after CURRENT. This allows a DOES word to use ","
and "C," without messing everything up. )
CURRENT @ 3 + HERE !
( HERE points to where we should write R> )
R> ,
( We're done. Because we've popped RS, we'll exit parent
definition )
;

21
blk/435
View File

@ -1,13 +1,8 @@
: WORD(
DUP 1- C@ ( name len field )
127 AND ( 0x7f. remove IMMEDIATE flag )
3 + ( fixed header len )
-
;
: FORGET
' DUP ( w w )
( HERE must be at the end of prev's word, that is, at the
beginning of w. )
WORD( HERE ! ( w )
PREV CURRENT !
;
: 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 )

17
blk/436
View File

@ -1,10 +1,11 @@
( Drop RSP until I-2 == INTERPRET. )
: EXIT!
['] INTERPRET ( I )
BEGIN ( I )
DUP ( I I )
R> DROP I 2- @ ( I I a )
= UNTIL
DROP
: ROLL
DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
SWAP DROP
;
: 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ;

13
blk/437 Normal file
View File

@ -0,0 +1,13 @@
: MOVE ( a1 a2 u -- )
( u ) 0 DO ( a1 a2 )
SWAP C@+ ( a2 a1+1 x )
ROT C!+ ( a1+1 a2+1 )
LOOP 2DROP ;
: MOVE- ( a1 a2 u -- )
SWAP OVER + 1- ( a1 u a2+u-1 )
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
ROT ( u ) 0 DO ( a2 a1 )
C@- ( a2 a1-1 x )
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
LOOP 2DROP ;
: PREV 3 - DUP @ - ;

24
blk/438
View File

@ -1,13 +1,13 @@
: 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
: WORD(
DUP 1- C@ ( name len field )
127 AND ( 0x7f. remove IMMEDIATE flag )
3 + ( fixed header len )
-
;
: FORGET
' DUP ( w w )
( HERE must be at the end of prev's word, that is, at the
beginning of w. )
WORD( HERE ! ( w )
PREV CURRENT !
;

24
blk/439
View File

@ -1,16 +1,10 @@
: ,"
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" ;
( Drop RSP until I-2 == INTERPRET. )
: EXIT!
['] INTERPRET ( I )
BEGIN ( I )
DUP ( I I )
R> DROP I 2- @ ( I I a )
= UNTIL
DROP
;

View File

@ -1,3 +1,4 @@
: (uflw) ABORT" stack underflow" ;
: BS 8 EMIT ;
: LF 10 EMIT ;
: CR 13 EMIT ;

Binary file not shown.

View File

@ -4,6 +4,8 @@
212 LOAD ( z80 assembler )
262 LOAD ( xcomp )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: : [ ' X: , ] ;
@ -19,7 +21,7 @@ CURRENT @ XCURRENT !
( Update LATEST )
PC ORG @ 8 + !
," CURRENT @ HERE ! "
422 459 XPACKR
430 459 XPACKR
," ' (key) 12 RAM+ ! "
ORG @ 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC!

View File

@ -72,10 +72,9 @@ instead.
## Building your stage 3
Using the same technique as you used in the `eeprom` recipe, you can append
required words to your boot binary. Required units `blk` (B464) and the SD Card
driver (B370). You only need the Forth part. You of course actually need
Z80 SDC words but to save you the troubles of rebuilding from stage 1 for this
recipe, we took the liberty of already having included it in the base recipe.
required words to your boot binary. There's only one required unit: `blk` from
core words (B453). The SD card driver was already included in the base recipe
to save you the troubles of rebuilding from stage 1 for this recipe.
## Testing in the emulator

View File

@ -10,6 +10,8 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
212 LOAD ( z80 assembler )
262 LOAD ( xcomp )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: CREATE XCREATE ;
@ -20,12 +22,12 @@ CURRENT @ XCURRENT !
282 LOAD ( boot.z80 )
393 LOAD ( icore low )
352 LOAD ( acia )
372 LOAD ( sdc.z80 )
372 381 LOADR ( sdc )
415 LOAD ( icore high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
422 452 XPACKR ( core print fmt readln )
430 452 XPACKR ( core fmt readln )
123 132 XPACKR ( linker )
," : _ ACIA$ RDLN$ (ok) ; _ "
ORG @ 256 /MOD 2 PC! 2 PC!

View File

@ -9,6 +9,8 @@ RAMSTART 0x72 + CONSTANT KBD_MEM
262 LOAD ( xcomp )
522 LOAD ( font compiler )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: CREATE XCREATE ; ( for KBD tbls )
@ -72,7 +74,7 @@ CREATE ~FNT CPFNT3x5
(entry) _
( Update LATEST )
PC ORG @ 8 + !
422 451 XPACKR ( core print fmt readln )
430 451 XPACKR ( core fmt readln )
," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC!

View File

@ -4,6 +4,8 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
212 LOAD ( z80 assembler )
262 LOAD ( xcomp )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: : [ ' X: , ] ;
@ -19,7 +21,7 @@ CURRENT @ XCURRENT !
( Update LATEST )
PC ORG @ 8 + !
," CURRENT @ HERE ! "
422 459 XPACKR ( core print readln fmt blk )
430 459 XPACKR ( core readln fmt blk )
499 500 XPACKR ( trs80.fs )
( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "