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 200 Z80 assembler 260 Cross compilation
280 Z80 boot code 350 ACIA driver 280 Z80 boot code 350 ACIA driver
370 SD Card driver 390 Cross-compiled core 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 490 TRS-80 Recipe 520 Fonts
550 TI-84+ Recipe 550 TI-84+ Recipe

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,4 +1,3 @@
SD Card driver SD Card driver
Load the z80 part with "372 LOAD", the Forth part with Load range: 372-381
"374 LOAD".

View File

@ -10,5 +10,3 @@ CODE _sdcSR ( n -- n )
L A LDrr, L A LDrr,
HL PUSHqq, HL PUSHqq,
;CODE ;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 in the host system will obviously be wrong in the target
system. More details in B260. system. More details in B260.
These rules result in some practicals do's and dont's:
1. No LEAVE in DO..LOOP
(cont.) (cont.)

View File

@ -13,3 +13,4 @@
: ALLOT HERE +! ; : ALLOT HERE +! ;
: CREATE (entry) 11 ( 11 == cellWord ) C, ; : 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 : 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!

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 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 430 core 442 fmt
442 fmt 447 readln 447 readln 453 blk
453 blk

27
blk/430
View File

@ -1,14 +1,15 @@
: DOES> : [ INTERPRET ; IMMEDIATE
( Overwrite cellWord in CURRENT ) : ] R> DROP ;
( 43 == doesWord ) : LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
43 CURRENT @ C! : LITA 36 , , ;
( When we have a DOES>, we forcefully place HERE to 4 : '? WORD (find) ;
bytes after CURRENT. This allows a DOES word to use "," : '
and "C," without messing everything up. ) '? (?br) [ 4 , ] EXIT
CURRENT @ 3 + HERE ! LIT< (wnf) (find) DROP EXECUTE
( HERE points to where we should write R> )
R> ,
( We're done. Because we've popped RS, we'll exit parent
definition )
; ;
: ['] ' 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 ; : _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
: CONSTANT CREATE , DOES> @ ; 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 40 is ASCII for '('. We do this to simplify XPACK's task of
variables are sent to PS at runtime ) not mistakenly consider '(' definition as a comment.
: DO COMPILE 2>R H@ ; IMMEDIATE LIT<: 34 == litWord
: LOOP COMPILE (loop) H@ - , ; IMMEDIATE LITA: 36 == addrWord
: LEAVE R> R> DROP I 1- >R >R ; 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 : ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
DUP NOT IF EXIT THEN COMPILE (br)
1+ DUP PICK ( n val ) 2 ALLOT
SWAP 2 * (roll) ( val ) DUP H@ -^ SWAP ( a-H a )
SWAP DROP !
; H@ 2- ( push a. -2 for allot offset )
; IMMEDIATE
: 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ;
: [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 -- ) : DOES>
( u ) 0 DO ( a1 a2 ) ( Overwrite cellWord in CURRENT )
SWAP C@+ ( a2 a1+1 x ) ( 43 == doesWord )
ROT C!+ ( a1+1 a2+1 ) 43 CURRENT @ C!
LOOP 2DROP ; ( When we have a DOES>, we forcefully place HERE to 4
: MOVE- ( a1 a2 u -- ) bytes after CURRENT. This allows a DOES word to use ","
SWAP OVER + 1- ( a1 u a2+u-1 ) and "C," without messing everything up. )
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 ) CURRENT @ 3 + HERE !
ROT ( u ) 0 DO ( a2 a1 ) ( HERE points to where we should write R> )
C@- ( a2 a1-1 x ) R> ,
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 ) ( We're done. Because we've popped RS, we'll exit parent
LOOP 2DROP ; definition )
: PREV 3 - DUP @ - ; ;

21
blk/435
View File

@ -1,13 +1,8 @@
: WORD( : VARIABLE CREATE 2 ALLOT ;
DUP 1- C@ ( name len field ) : CONSTANT CREATE , DOES> @ ;
127 AND ( 0x7f. remove IMMEDIATE flag )
3 + ( fixed header len ) ( 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
: FORGET : LOOP COMPILE (loop) H@ - , ; IMMEDIATE
' DUP ( w w ) ( LEAVE is implemented in xcomp )
( HERE must be at the end of prev's word, that is, at the
beginning of w. )
WORD( HERE ! ( w )
PREV CURRENT !
;

17
blk/436
View File

@ -1,10 +1,11 @@
( Drop RSP until I-2 == INTERPRET. ) : ROLL
: EXIT! DUP NOT IF EXIT THEN
['] INTERPRET ( I ) 1+ DUP PICK ( n val )
BEGIN ( I ) SWAP 2 * (roll) ( val )
DUP ( I I ) SWAP DROP
R> DROP I 2- @ ( I I a )
= UNTIL
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 : WORD(
( 0x53==(emit) override ) DUP 1- C@ ( name len field )
83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ; 127 AND ( 0x7f. remove IMMEDIATE flag )
3 + ( fixed header len )
: (print) -
BEGIN ;
C@+ ( a+1 c ) : FORGET
( exit if null or 0xd ) ' DUP ( w w )
DUP 13 = OVER NOT OR IF 2DROP EXIT THEN ( HERE must be at the end of prev's word, that is, at the
EMIT ( a ) beginning of w. )
AGAIN WORD( HERE ! ( w )
PREV CURRENT !
; ;

24
blk/439
View File

@ -1,16 +1,10 @@
: ," ( Drop RSP until I-2 == INTERPRET. )
BEGIN : EXIT!
C< ['] INTERPRET ( I )
( 34 is ASCII for " ) BEGIN ( I )
DUP 34 = IF DROP EXIT THEN C, DUP ( I I )
AGAIN ; R> DROP I 2- @ ( I I a )
= UNTIL
: ." DROP
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: , ] ;
@ -19,7 +21,7 @@ CURRENT @ XCURRENT !
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
422 459 XPACKR 430 459 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!

View File

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

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 ;
@ -20,12 +22,12 @@ CURRENT @ XCURRENT !
282 LOAD ( boot.z80 ) 282 LOAD ( boot.z80 )
393 LOAD ( icore low ) 393 LOAD ( icore low )
352 LOAD ( acia ) 352 LOAD ( acia )
372 LOAD ( sdc.z80 ) 372 381 LOADR ( sdc )
415 LOAD ( icore high ) 415 LOAD ( icore high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
422 452 XPACKR ( core print fmt readln ) 430 452 XPACKR ( core fmt readln )
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!

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 )
@ -72,7 +74,7 @@ CREATE ~FNT CPFNT3x5
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
422 451 XPACKR ( core print fmt readln ) 430 451 XPACKR ( core fmt readln )
," : _ 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!

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: , ] ;
@ -19,7 +21,7 @@ CURRENT @ XCURRENT !
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
422 459 XPACKR ( core print readln fmt blk ) 430 459 XPACKR ( core readln fmt blk )
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$ ; _ "