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

Compare commits

...

7 Commits

Author SHA1 Message Date
Virgil Dupras
7c20501f27 Move core's blk to xcomp core (low and high)
TODO: implement X['] so that I can remove those XCURRENT patterns.
2020-05-13 10:50:46 -04:00
Virgil Dupras
d956386e9b Move core's readln to xcomp core (high) 2020-05-13 09:28:32 -04:00
Virgil Dupras
029df00ad4 Free some space for xcomp core 2020-05-13 09:11:57 -04:00
Virgil Dupras
56af516d07 Move core's fmt to xcomp core (high) 2020-05-13 09:02:44 -04:00
Virgil Dupras
e2e9faef2c Move a bunch of words from core to xcomp core 2020-05-13 08:50:07 -04:00
Virgil Dupras
d6a3e79394 Free some space for xcomp core low 2020-05-13 08:00:49 -04:00
Virgil Dupras
ddf23e3d02 Move a bunch of words from core to xcomp core 2020-05-13 07:55:36 -04:00
53 changed files with 369 additions and 375 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
428 Core words 480 AT28 Driver 439 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< H@ (find) DROP ( target ) LIT< [ (find) DROP ( target )
DUP 3 - @ ( t prevoff ) DUP 3 - @ ( t prevoff )
( subtract H@ name length ) ( subtract [ name length )
2- ( t o ) 1- ( t o )
RLDICT RLDICT
; ;

View File

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

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 19 LOADR+ 1 25 LOADR+ ( xcomp core low )

13
blk/409
View File

@ -4,6 +4,13 @@
(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 Normal file
View File

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

View File

14
blk/415
View File

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

23
blk/416
View File

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

21
blk/417
View File

@ -1,13 +1,12 @@
: ," : BLK$
BEGIN H@ 0x59 RAM+ !
C< ( 1024 for the block, 8 for variables )
( 34 is ASCII for " ) 1032 ALLOT
DUP 34 = IF DROP EXIT THEN C, ( LOAD detects end of block with ASCII EOT. This is why
AGAIN ; we write it there. EOT == 0x04 )
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,14 +1,13 @@
( LITN has to be defined after the last immediate usage of : BLK! ( -- )
it to avoid bootstrapping issues ) BLK> @ BLK!* @ EXECUTE
: LITN 32 , , ( 32 == NUMBER ) ; 0 BLKDTY !
;
: FLUSH BLKDTY @ IF BLK! THEN ;
: BLK@ ( n -- )
FLUSH
DUP BLK> @ = IF DROP EXIT THEN
DUP BLK> ! BLK@* @ EXECUTE
;
: IMMED? 1- C@ 0x80 AND ; : BLK!! 1 BLKDTY ! ;
( ';' 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
View File

@ -1,16 +0,0 @@
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!

1
blk/420 Normal file
View File

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

14
blk/421 Normal file
View File

@ -0,0 +1,14 @@
: 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 Normal file
View File

@ -0,0 +1,15 @@
: ,"
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 Normal file
View File

@ -0,0 +1,16 @@
: _
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 Normal file
View File

@ -0,0 +1,16 @@
: ? @ . ;
: _
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 Normal file
View File

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

View File

@ -1,11 +1,10 @@
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) INBUFSZ 2+ RDLNMEM+ ; : IN) 0x40 ( buffer size ) 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

28
blk/428
View File

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

25
blk/430
View File

@ -1,15 +1,12 @@
: [ INTERPRET ; IMMEDIATE ( Initializes the readln subsystem )
: ] R> DROP ; : RDLN$
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE ( 57 == rdln's memory )
: LITA 36 , , ; H@ 0x57 RAM+ !
: '? WORD (find) ; ( plus 2 for extra bytes after buffer: 1 for
: ' the last typed 0x0a and one for the following NULL. )
'? (?br) [ 4 , ] EXIT IN) IN> - 2+ ALLOT
LIT< (wnf) (find) DROP EXECUTE (infl)
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 @@
: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE : .2 DUP 10 < IF SPC THEN . ;
40 CURRENT @ 4 - C! : EOL? ( c -- f ) DUP 0xd = SWAP NOT OR ;
( Hello, hello, krkrkrkr... do you hear me? : LIST
Ah, voice at last! Some lines above need comments BLK@
BTW: Forth lines limited to 64 cols because of default 16 0 DO
input buffer size in Collapse OS I 1+ .2 SPC
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,11 +1,16 @@
: IF ( -- a | a: br cell addr ) : _
COMPILE (?br) (boot<)
H@ ( push a ) DUP 4 = IF
2 ALLOT ( br cell allot ) ( We drop our char, but also "a" from WORD: it won't
; IMMEDIATE have the opportunity to balance PSP because we're
EXIT!ing. )
: THEN ( a -- | a: br cell addr ) 2DROP
DUP H@ -^ SWAP ( a-H a ) ( We're finished interpreting )
! EXIT!
; IMMEDIATE THEN
;
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,12 +1,16 @@
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) : LOAD
COMPILE (br) BLK> @ >R ( save restorable variables to RSP )
2 ALLOT 0x08 RAM+ @ >R ( 08 == C<* override )
DUP H@ -^ SWAP ( a-H a ) 0x06 RAM+ @ >R ( C<? )
! 0x2e RAM+ @ >R ( boot ptr )
H@ 2- ( push a. -2 for allot offset ) BLK@
; IMMEDIATE BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
[ LITN ( from PSP, B432 ) ] 0x08 RAM+ !
: [IF] 1 0x06 RAM+ ! ( 06 == C<? )
IF EXIT THEN INTERPRET
LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ; R> 0x2e RAM+ ! R> 0x06 RAM+ !
: [THEN] ; I 0x08 RAM+ @ = IF ( nested load )
R> DROP ( C<* ) R> BLK@
ELSE ( not nested )
R> 0x08 RAM+ ! R> DROP ( BLK> )
THEN ;

18
blk/434
View File

@ -1,14 +1,4 @@
: DOES> : LOAD+ BLK> @ + LOAD ;
( Overwrite cellWord in CURRENT ) ( b1 b2 -- )
( 43 == doesWord ) : LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
43 CURRENT @ C! : LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
( 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,8 +1,14 @@
: VARIABLE CREATE 2 ALLOT ; ( LITN has to be defined after the last immediate usage of
: CONSTANT CREATE , DOES> @ ; 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
( 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,11 +1,16 @@
: ROLL XCURRENT @ ( to PSP )
DUP NOT IF EXIT THEN : :
1+ DUP PICK ( n val ) (entry)
SWAP 2 * (roll) ( val ) ( We cannot use LITN as IMMEDIATE because of bootstrapping
SWAP DROP issues. Same thing for ",".
; 32 == NUMBER 14 == compiledWord )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
: 2OVER 3 PICK 3 PICK ; BEGIN
: 2SWAP 3 ROLL 3 ROLL ; WORD
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse) LITN THEN
AGAIN ;
( from PSP ) ';' SWAP 4 - C!

13
blk/438
View File

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

13
blk/441 Normal file
View File

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

28
blk/443
View File

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

28
blk/444
View File

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

12
blk/445
View File

@ -1,6 +1,8 @@
: DUMP ( n a -- ) : VARIABLE CREATE 2 ALLOT ;
LF : CONSTANT CREATE , DOES> @ ;
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 )

3
blk/446 Normal file
View File

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

16
blk/449
View File

@ -1,16 +0,0 @@
: (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 ;

12
blk/451
View File

@ -1,12 +0,0 @@
( 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
View File

@ -1,13 +0,0 @@
: 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
View File

@ -1,12 +0,0 @@
: 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
View File

@ -1,13 +0,0 @@
: 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
View File

@ -1,13 +0,0 @@
: .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
View File

@ -1,16 +0,0 @@
: _
(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
View File

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

View File

@ -1,4 +0,0 @@
: 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 ( icore low ) 393 LOAD ( xcomp core low )
: (emit) 0 PC! ; : (emit) 0 PC! ;
: (key) 0 PC@ ; : (key) 0 PC@ ;
415 LOAD ( icore high ) 420 LOAD ( xcomp core high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
430 459 XPACKR 440 446 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,7 +19,6 @@ 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
@ -69,12 +68,30 @@ 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 stage 3 ## Building your binary
Using the same technique as you used in the `eeprom` recipe, you can append Your Collapse OS binary needs the SDC drivers which need to be inserted during
required words to your boot binary. There's only one required unit: `blk` from Cross Compilation, which needs you need to recompile it from stage 1. First,
core words (B453). The SD card driver was already included in the base recipe look at B370. You'll see that it indicates a block range for the driver. That
to save you the troubles of rebuilding from stage 1 for this recipe. needs to be loaded.
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,14 +20,13 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
CURRENT @ XCURRENT ! CURRENT @ XCURRENT !
282 LOAD ( boot.z80 ) 282 LOAD ( boot.z80 )
393 LOAD ( icore low ) 393 LOAD ( xcomp core low )
352 LOAD ( acia ) 352 LOAD ( acia )
372 381 LOADR ( sdc ) 420 LOAD ( xcomp core high )
415 LOAD ( icore high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
430 452 XPACKR ( core fmt readln ) 440 446 XPACKR ( core )
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 ( icore low ) 393 LOAD ( xcomp core 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 )
415 LOAD ( icore high ) 420 LOAD ( xcomp core high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
430 451 XPACKR ( core fmt readln ) 440 446 XPACKR ( core )
," : _ 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 ( icore low ) 393 LOAD ( xcomp core low )
415 LOAD ( icore high ) 420 LOAD ( xcomp core high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
430 459 XPACKR ( core readln fmt blk ) 440 446 XPACKR ( core )
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$ ; _ "