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

Compare commits

..

No commits in common. "7c20501f2705680018f09468e5d4e9ca73fd45b2" and "6a5ff3adcbc3203aa5641875e3a3b4f94308c036" have entirely different histories.

53 changed files with 375 additions and 369 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
439 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

@ -1,9 +1,9 @@
( Relink a regular Forth full interpreter. ) ( Relink a regular Forth full interpreter. )
: RLCORE : RLCORE
LIT< [ (find) DROP ( target ) LIT< H@ (find) DROP ( target )
DUP 3 - @ ( t prevoff ) DUP 3 - @ ( t prevoff )
( subtract [ name length ) ( subtract H@ name length )
1- ( t o ) 2- ( t o )
RLDICT RLDICT
; ;

View File

@ -1,3 +1,3 @@
SD Card driver SD Card driver
Load range: 372-387 Load range: 372-381

View File

@ -12,4 +12,4 @@
0 0x08 RAM+ ! ( 08 == C<* override ) 0 0x08 RAM+ ! ( 08 == C<* override )
LIT< INTERPRET (find) DROP EXECUTE LIT< INTERPRET (find) DROP EXECUTE
; ;
1 25 LOADR+ ( xcomp core low ) 1 19 LOADR+

13
blk/409
View File

@ -4,13 +4,6 @@
(find) (find)
NOT IF (parse) ELSE EXECUTE THEN NOT IF (parse) ELSE EXECUTE THEN
C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN
AGAIN ; AGAIN
XCURRENT @ _xapply ( to PSP ) ;
( Drop RSP until I-2 == INTERPRET. )
: EXIT!
[ LITN ] ( I, from PSP )
BEGIN ( I )
DUP ( I I )
R> DROP I 2- @ ( I I a )
= UNTIL
DROP ;

13
blk/413
View File

@ -1,13 +0,0 @@
: '? WORD (find) ;
: '
'? (?br) [ 4 , ] EXIT
LIT< (wnf) (find) DROP EXECUTE
;
: 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 ;

14
blk/415
View File

@ -1,13 +1 @@
: WORD( 1 4 LOADR+
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 !
;

23
blk/416
View File

@ -1,13 +1,14 @@
: BLKMEM+ 0x59 RAM+ @ + ; : EMIT
( n -- Fetches block n and write it to BLK( ) ( 0x53==(emit) override )
: BLK@* 0 BLKMEM+ ; 0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
( n -- Write back BLK( to storage at block n )
: BLK!* 2 BLKMEM+ ; : (print)
( Current blk pointer in ( ) BEGIN
: BLK> 4 BLKMEM+ ; C@+ ( a+1 c )
( Whether buffer is dirty ) ( exit if null or 0xd )
: BLKDTY 6 BLKMEM+ ; DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
: BLK( 8 BLKMEM+ ; EMIT ( a )
: BLK) BLK( 1024 + ; AGAIN
;

21
blk/417
View File

@ -1,12 +1,13 @@
: BLK$ : ,"
H@ 0x59 RAM+ ! BEGIN
( 1024 for the block, 8 for variables ) C<
1032 ALLOT ( 34 is ASCII for " )
( LOAD detects end of block with ASCII EOT. This is why DUP 34 = IF DROP EXIT THEN C,
we write it there. EOT == 0x04 ) AGAIN ;
4 C,
0 BLKDTY !
-1 BLK> !
;
: ."
34 , ( 34 == litWord ) ," 0 C,
COMPILE (print)
; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE

23
blk/418
View File

@ -1,13 +1,14 @@
: BLK! ( -- ) ( LITN has to be defined after the last immediate usage of
BLK> @ BLK!* @ EXECUTE it to avoid bootstrapping issues )
0 BLKDTY ! : LITN 32 , , ( 32 == NUMBER ) ;
;
: FLUSH BLKDTY @ IF BLK! THEN ;
: BLK@ ( n -- )
FLUSH
DUP BLK> @ = IF DROP EXIT THEN
DUP BLK> ! BLK@* @ EXECUTE
;
: BLK!! 1 BLKDTY ! ; : 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

@ -1 +0,0 @@
1 16 LOADR+ ( xcomp core high )

14
blk/421
View File

@ -1,14 +0,0 @@
: EMIT
( 0x53==(emit) override )
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null or 0xd )
DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
EMIT ( a )
AGAIN
;

15
blk/422
View File

@ -1,15 +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
: 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 ;

16
blk/423
View File

@ -1,16 +0,0 @@
: _
999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
BEGIN
DUP 0 = IF DROP EXIT THEN
10 /MOD ( r q )
SWAP '0' + SWAP ( d q )
AGAIN ;
: . ( n -- )
( handle negative )
DUP 0< IF '-' EMIT -1 * THEN
_
BEGIN
DUP '9' > IF DROP EXIT THEN ( stop indicator )
EMIT
AGAIN ;

16
blk/424
View File

@ -1,16 +0,0 @@
: ? @ . ;
: _
DUP 9 > IF 10 - 'a' +
ELSE '0' + THEN
;
( For hex display, there are no negatives )
: .x
256 MOD ( ensure < 0x100 )
16 /MOD ( l h )
_ EMIT ( l )
_ EMIT
;
: .X
256 /MOD ( l h )
.x .x
;

13
blk/425
View File

@ -1,13 +0,0 @@
: _ ( a -- a+8 )
DUP ( a a )
':' EMIT DUP .x SPC
4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP
DROP ( a )
8 0 DO
C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT
LOOP NL ;
: DUMP ( n a -- )
LF
SWAP 8 /MOD SWAP IF 1+ THEN
0 DO _ LOOP
;

28
blk/428
View File

@ -1,16 +1,12 @@
: (rdlnc) ( -- f ) Core words
( buffer overflow? same as if we typed a newline )
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c ) These words follow cross-compiled words, but unlike them, these
DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace ) are self-bootstrapping and don't depend on the Cross Compiler.
DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr ) They will typically be included in source form right after a
( echo back ) stage1 binary which will interpret it on boot and bootstrap
DUP EMIT ( c ) itself to a full intepreter, which can then be relinked with
( bacspace? handle and exit ) the Relinker. There is no loader for these libraries because
DUP 0x8 = IF (inbs) EXIT THEN you will typically XPACK (B267) them.
( write and advance )
DUP ( keep as result ) ( c c ) 430 core 442 fmt
( We take advantage of the fact that c's MSB is always zero and 447 readln 453 blk
thus ! automatically null-terminates our string )
IN> @ ! 1 IN> +! ( c )
( if newline, replace with zero to indicate EOL )
DUP 0xd = IF DROP 0 THEN ;

25
blk/430
View File

@ -1,12 +1,15 @@
( Initializes the readln subsystem ) : [ INTERPRET ; IMMEDIATE
: RDLN$ : ] R> DROP ;
( 57 == rdln's memory ) : LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
H@ 0x57 RAM+ ! : LITA 36 , , ;
( plus 2 for extra bytes after buffer: 1 for : '? WORD (find) ;
the last typed 0x0a and one for the following NULL. ) : '
IN) IN> - 2+ ALLOT '? (?br) [ 4 , ] EXIT
(infl) LIT< (wnf) (find) DROP EXECUTE
LIT< RDLN< (find) DROP 0x0c RAM+ !
1 0x06 RAM+ ! ( 06 == C<? )
; ;
: ['] ' LITA ; IMMEDIATE
: COMPILE ' LITA ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE

24
blk/431
View File

@ -1,13 +1,13 @@
: .2 DUP 10 < IF SPC THEN . ; : _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
: EOL? ( c -- f ) DUP 0xd = SWAP NOT OR ; 40 CURRENT @ 4 - C!
: LIST ( Hello, hello, krkrkrkr... do you hear me?
BLK@ Ah, voice at last! Some lines above need comments
16 0 DO BTW: Forth lines limited to 64 cols because of default
I 1+ .2 SPC input buffer size in Collapse OS
64 I * BLK( + DUP 64 + SWAP DO
I C@ DUP EOL? IF DROP LEAVE ELSE EMIT THEN
LOOP
NL
LOOP
;
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. )

27
blk/432
View File

@ -1,16 +1,11 @@
: _ : IF ( -- a | a: br cell addr )
(boot<) COMPILE (?br)
DUP 4 = IF H@ ( push a )
( We drop our char, but also "a" from WORD: it won't 2 ALLOT ( br cell allot )
have the opportunity to balance PSP because we're ; IMMEDIATE
EXIT!ing. )
2DROP : THEN ( a -- | a: br cell addr )
( We're finished interpreting ) DUP H@ -^ SWAP ( a-H a )
EXIT! !
THEN ; IMMEDIATE
;
XCURRENT @ _xapply ( to PSP, for LOAD )
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
is to check whether we're restoring to "_", the word above.
if yes, then we're in a nested load. Also, the 1 in 0x06 is
to avoid tons of "ok" displays. )

28
blk/433
View File

@ -1,16 +1,12 @@
: LOAD : ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
BLK> @ >R ( save restorable variables to RSP ) COMPILE (br)
0x08 RAM+ @ >R ( 08 == C<* override ) 2 ALLOT
0x06 RAM+ @ >R ( C<? ) DUP H@ -^ SWAP ( a-H a )
0x2e RAM+ @ >R ( boot ptr ) !
BLK@ H@ 2- ( push a. -2 for allot offset )
BLK( 0x2e RAM+ ! ( Point to beginning of BLK ) ; IMMEDIATE
[ LITN ( from PSP, B432 ) ] 0x08 RAM+ !
1 0x06 RAM+ ! ( 06 == C<? ) : [IF]
INTERPRET IF EXIT THEN
R> 0x2e RAM+ ! R> 0x06 RAM+ ! LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
I 0x08 RAM+ @ = IF ( nested load ) : [THEN] ;
R> DROP ( C<* ) R> BLK@
ELSE ( not nested )
R> 0x08 RAM+ ! R> DROP ( BLK> )
THEN ;

18
blk/434
View File

@ -1,4 +1,14 @@
: LOAD+ BLK> @ + LOAD ; : DOES>
( b1 b2 -- ) ( Overwrite cellWord in CURRENT )
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; ( 43 == doesWord )
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; 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 )
;

20
blk/435
View File

@ -1,14 +1,8 @@
( LITN has to be defined after the last immediate usage of : VARIABLE CREATE 2 ALLOT ;
it to avoid bootstrapping issues ) : CONSTANT CREATE , DOES> @ ;
: 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
( 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 )

27
blk/436
View File

@ -1,16 +1,11 @@
XCURRENT @ ( to PSP ) : ROLL
: : DUP NOT IF EXIT THEN
(entry) 1+ DUP PICK ( n val )
( We cannot use LITN as IMMEDIATE because of bootstrapping SWAP 2 * (roll) ( val )
issues. Same thing for ",". SWAP DROP
32 == NUMBER 14 == compiledWord ) ;
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
BEGIN : 2OVER 3 PICK 3 PICK ;
WORD : 2SWAP 3 ROLL 3 ROLL ;
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse) LITN THEN
AGAIN ;
( from PSP ) ';' SWAP 4 - C!

View File

13
blk/438 Normal file
View File

@ -0,0 +1,13 @@
: 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 !
;

20
blk/439
View File

@ -1,12 +1,10 @@
Core words ( Drop RSP until I-2 == INTERPRET. )
: EXIT!
['] INTERPRET ( I )
BEGIN ( I )
DUP ( I I )
R> DROP I 2- @ ( I I a )
= UNTIL
DROP
;
These words follow cross-compiled words, but unlike them, these
are self-bootstrapping and don't depend on the Cross Compiler.
They will typically be included in source form right after a
stage1 binary which will interpret it on boot and bootstrap
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.
440 core 447 readln
453 blk

21
blk/440
View File

@ -1,10 +1,11 @@
: [ INTERPRET ; IMMEDIATE : (uflw) ABORT" stack underflow" ;
: ] R> DROP ; : BS 8 EMIT ;
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE : LF 10 EMIT ;
: LITA 36 , , ; : CR 13 EMIT ;
: ['] ' LITA ; IMMEDIATE : CRLF CR LF ;
: COMPILE ' LITA ['] , , ; IMMEDIATE : SPC 32 EMIT ;
: [COMPILE] ' , ; IMMEDIATE : NL 0x0a RAM+ @ ( NLPTR ) DUP IF EXECUTE ELSE DROP CRLF THEN ;
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE : (wnf) (print) SPC ABORT" word not found" ;
: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE : (ok) SPC ." ok" NL ;

13
blk/441
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. )

27
blk/442
View File

@ -1,11 +1,16 @@
: IF ( -- a | a: br cell addr ) : _
COMPILE (?br) 999 SWAP ( stop indicator )
H@ ( push a ) DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
2 ALLOT ( br cell allot ) BEGIN
; IMMEDIATE DUP 0 = IF DROP EXIT THEN
10 /MOD ( r q )
: THEN ( a -- | a: br cell addr ) SWAP '0' + SWAP ( d q )
DUP H@ -^ SWAP ( a-H a ) AGAIN ;
! : . ( n -- )
; IMMEDIATE ( handle negative )
DUP 0< IF '-' EMIT -1 * THEN
_
BEGIN
DUP '9' > IF DROP EXIT THEN ( stop indicator )
EMIT
AGAIN ;

28
blk/443
View File

@ -1,12 +1,16 @@
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) : ? @ . ;
COMPILE (br) : _
2 ALLOT DUP 9 > IF 10 - 'a' +
DUP H@ -^ SWAP ( a-H a ) ELSE '0' + THEN
! ;
H@ 2- ( push a. -2 for allot offset ) ( For hex display, there are no negatives )
; IMMEDIATE : .x
256 MOD ( ensure < 0x100 )
: [IF] 16 /MOD ( l h )
IF EXIT THEN _ EMIT ( l )
LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ; _ EMIT
: [THEN] ; ;
: .X
256 /MOD ( l h )
.x .x
;

28
blk/444
View File

@ -1,14 +1,16 @@
: DOES> : _ ( a -- a+8 )
( Overwrite cellWord in CURRENT ) DUP ( save for 2nd loop )
( 43 == doesWord ) ':' EMIT DUP .x SPC
43 CURRENT @ C! 4 0 DO
( When we have a DOES>, we forcefully place HERE to 4 DUP @ 256 /MOD SWAP
bytes after CURRENT. This allows a DOES word to use "," .x .x SPC 2+
and "C," without messing everything up. ) LOOP
CURRENT @ 3 + HERE ! DROP
( HERE points to where we should write R> ) 8 0 DO
R> , C@+
( We're done. Because we've popped RS, we'll exit parent DUP 0x20 0x7e =><= NOT
definition ) IF DROP '.' THEN
EMIT
LOOP
NL
; ;

12
blk/445
View File

@ -1,8 +1,6 @@
: VARIABLE CREATE 2 ALLOT ; : DUMP ( n a -- )
: CONSTANT CREATE , DOES> @ ; LF
SWAP 8 /MOD SWAP IF 1+ THEN
0 DO _ LOOP
;
( 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 )

View File

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

View File

@ -1,10 +1,11 @@
64 CONSTANT INBUFSZ
: RDLNMEM+ 0x57 RAM+ @ + ; : RDLNMEM+ 0x57 RAM+ @ + ;
( current position in INBUF ) ( current position in INBUF )
: IN> 0 RDLNMEM+ ; : IN> 0 RDLNMEM+ ;
( points to INBUF ) ( points to INBUF )
: IN( 2 RDLNMEM+ ; : IN( 2 RDLNMEM+ ;
( points to INBUF's end ) ( points to INBUF's end )
: IN) 0x40 ( buffer size ) 2+ RDLNMEM+ ; : IN) INBUFSZ 2+ RDLNMEM+ ;
( flush input buffer ) ( flush input buffer )
( set IN> to IN( and set IN> @ to null ) ( set IN> to IN( and set IN> @ to null )

View File

16
blk/449 Normal file
View File

@ -0,0 +1,16 @@
: (rdlnc) ( -- f )
( buffer overflow? same as if we typed a newline )
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c )
DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
( echo back )
DUP EMIT ( c )
( bacspace? handle and exit )
DUP 0x8 = IF (inbs) EXIT THEN
( write and advance )
DUP ( keep as result ) ( c c )
( We take advantage of the fact that c's MSB is always zero and
thus ! automatically null-terminates our string )
IN> @ ! 1 IN> +! ( c )
( if newline, replace with zero to indicate EOL )
DUP 0xd = IF DROP 0 THEN ;

View File

12
blk/451 Normal file
View File

@ -0,0 +1,12 @@
( Initializes the readln subsystem )
: RDLN$
( 57 == rdln's memory )
H@ 0x57 RAM+ !
( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
the last typed 0x0a and one for the following NULL. )
INBUFSZ 4 + ALLOT
(infl)
['] RDLN< 0x0c RAM+ !
1 0x06 RAM+ ! ( 06 == C<? )
;

13
blk/453 Normal file
View File

@ -0,0 +1,13 @@
: BLKMEM+ 0x59 RAM+ @ + ;
( n -- Fetches block n and write it to BLK( )
: BLK@* 0 BLKMEM+ ;
( n -- Write back BLK( to storage at block n )
: BLK!* 2 BLKMEM+ ;
( Current blk pointer in ( )
: BLK> 4 BLKMEM+ ;
( Whether buffer is dirty )
: BLKDTY 6 BLKMEM+ ;
: BLK( 8 BLKMEM+ ;
: BLK) BLK( 1024 + ;

12
blk/454 Normal file
View File

@ -0,0 +1,12 @@
: BLK$
H@ 0x59 RAM+ !
( 1024 for the block, 8 for variables )
1032 ALLOT
( LOAD detects end of block with ASCII EOT. This is why
we write it there. EOT == 0x04 )
4 C,
0 BLKDTY !
-1 BLK> !
;

13
blk/455 Normal file
View File

@ -0,0 +1,13 @@
: BLK! ( -- )
BLK> @ BLK!* @ EXECUTE
0 BLKDTY !
;
: FLUSH BLKDTY @ IF BLK! THEN ;
: BLK@ ( n -- )
FLUSH
DUP BLK> @ = IF DROP EXIT THEN
DUP BLK> ! BLK@* @ EXECUTE
;
: BLK!! 1 BLKDTY ! ;

13
blk/456 Normal file
View File

@ -0,0 +1,13 @@
: .2 DUP 10 < IF SPC THEN . ;
: EOL? ( c -- f ) DUP 0xd = SWAP NOT OR ;
: LIST
BLK@
16 0 DO
I 1+ .2 SPC
64 I * BLK( + DUP 64 + SWAP DO
I C@ DUP EOL? IF DROP LEAVE ELSE EMIT THEN
LOOP
NL
LOOP
;

16
blk/457 Normal file
View File

@ -0,0 +1,16 @@
: _
(boot<)
DUP 4 = IF
( We drop our char, but also "a" from WORD: it won't
have the opportunity to balance PSP because we're
EXIT!ing. )
2DROP
( We're finished interpreting )
EXIT!
THEN
;
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
is to check whether we're restoring to "_", the word above.
if yes, then we're in a nested load. Also, the 1 in 0x06 is
to avoid tons of "ok" displays. )

16
blk/458 Normal file
View File

@ -0,0 +1,16 @@
: LOAD
BLK> @ >R ( save restorable variables to RSP )
0x08 RAM+ @ >R
0x06 RAM+ @ >R ( C<? )
0x2e RAM+ @ >R ( boot ptr )
BLK@
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
['] _ 0x08 RAM+ ! ( 08 == C<* override )
1 0x06 RAM+ ! ( 06 == C<? )
INTERPRET
R> 0x2e RAM+ ! R> 0x06 RAM+ !
I 0x08 RAM+ @ = IF ( nested load )
R> DROP ( C<* ) R> BLK@
ELSE ( not nested )
R> 0x08 RAM+ ! R> DROP ( BLK> )
THEN ;

4
blk/459 Normal file
View File

@ -0,0 +1,4 @@
: LOAD+ BLK> @ + LOAD ;
( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;

Binary file not shown.

View File

@ -13,15 +13,15 @@
CURRENT @ XCURRENT ! CURRENT @ XCURRENT !
282 LOAD ( boot.z80 ) 282 LOAD ( boot.z80 )
393 LOAD ( xcomp core low ) 393 LOAD ( icore low )
: (emit) 0 PC! ; : (emit) 0 PC! ;
: (key) 0 PC@ ; : (key) 0 PC@ ;
420 LOAD ( xcomp core high ) 415 LOAD ( icore high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
440 446 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

@ -19,6 +19,7 @@ design.
## Gathering parts ## Gathering parts
* A RC2014 Classic * A RC2014 Classic
* `stage2.bin` from the base recipe
* A MicroSD breakout board. I use Adafruit's. * A MicroSD breakout board. I use Adafruit's.
* A proto board + header pins with 39 positions so we can make a RC2014 card. * A proto board + header pins with 39 positions so we can make a RC2014 card.
* Diodes, resistors and stuff * Diodes, resistors and stuff
@ -68,30 +69,12 @@ matter. However, it *does* matter for the `SELECT` line, so I don't follow my
own schematic with regards to the `M1` and `A2` lines and use two inverters own schematic with regards to the `M1` and `A2` lines and use two inverters
instead. instead.
## Building your binary ## Building your stage 3
Your Collapse OS binary needs the SDC drivers which need to be inserted during Using the same technique as you used in the `eeprom` recipe, you can append
Cross Compilation, which needs you need to recompile it from stage 1. First, required words to your boot binary. There's only one required unit: `blk` from
look at B370. You'll see that it indicates a block range for the driver. That core words (B453). The SD card driver was already included in the base recipe
needs to be loaded. to save you the troubles of rebuilding from stage 1 for this recipe.
Open xcomp.fs from base recipe and locate acia loading. You'll insert a line
right after that that will look like:
372 387 LOADR ( sdc )
Normally, that's all you need to do. However, you have a little problem: You're
busting the 8K ROM limit. But it's ok, you can remove the linker's XPACKing
line: because you'll have access to the blkfs from SD card, you can load it
from there!
Removing the linker from XPACKing will free enough space for your binary to fit
in 8K. You also have to add `BLK$` to initialization routine.
Build it and write it to EEPROM.
If you want, once you're all set with the SD card, you can relink core words
like you did in the base recipe for optimal resource usage.
## Testing in the emulator ## Testing in the emulator

View File

@ -20,13 +20,14 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
CURRENT @ XCURRENT ! CURRENT @ XCURRENT !
282 LOAD ( boot.z80 ) 282 LOAD ( boot.z80 )
393 LOAD ( xcomp core low ) 393 LOAD ( icore low )
352 LOAD ( acia ) 352 LOAD ( acia )
420 LOAD ( xcomp core high ) 372 381 LOADR ( sdc )
415 LOAD ( icore high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
440 446 XPACKR ( core ) 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

@ -66,15 +66,15 @@ CURRENT @ XCURRENT !
0x100 BIN( ! 0x100 BIN( !
282 LOAD ( boot.z80 ) 282 LOAD ( boot.z80 )
393 LOAD ( xcomp core low ) 393 LOAD ( icore low )
CREATE ~FNT CPFNT3x5 CREATE ~FNT CPFNT3x5
555 560 LOADR ( LCD low ) 555 560 LOADR ( LCD low )
566 570 LOADR ( KBD low ) 566 570 LOADR ( KBD low )
420 LOAD ( xcomp core high ) 415 LOAD ( icore high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
440 446 XPACKR ( core ) 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

@ -15,13 +15,13 @@ CURRENT @ XCURRENT !
0x3000 BIN( ! 0x3000 BIN( !
282 LOAD ( boot.z80 ) 282 LOAD ( boot.z80 )
492 LOAD ( trs80.z80 ) 492 LOAD ( trs80.z80 )
393 LOAD ( xcomp core low ) 393 LOAD ( icore low )
420 LOAD ( xcomp core high ) 415 LOAD ( icore high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
440 446 XPACKR ( core ) 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$ ; _ "