1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 02: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
280 Z80 boot code 350 ACIA driver
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
550 TI-84+ Recipe

View File

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

View File

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

View File

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

13
blk/409
View File

@ -4,6 +4,13 @@
(find)
NOT IF (parse) ELSE EXECUTE 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
( 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
;
: 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 + ;

21
blk/417
View File

@ -1,13 +1,12 @@
: ,"
BEGIN
C<
( 34 is ASCII for " )
DUP 34 = IF DROP EXIT THEN C,
AGAIN ;
: 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> !
;
: ."
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
it to avoid bootstrapping issues )
: LITN 32 , , ( 32 == NUMBER ) ;
: BLK! ( -- )
BLK> @ BLK!* @ EXECUTE
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 ;
( ';' 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
: BLK!! 1 BLKDTY ! ;

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+ @ + ;
( current position in INBUF )
: IN> 0 RDLNMEM+ ;
( points to INBUF )
: IN( 2 RDLNMEM+ ;
( points to INBUF's end )
: IN) INBUFSZ 2+ RDLNMEM+ ;
: IN) 0x40 ( buffer size ) 2+ RDLNMEM+ ;
( flush input buffer )
( set IN> to IN( and set IN> @ to null )

View File

28
blk/428
View File

@ -1,12 +1,16 @@
Core words
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.
430 core 442 fmt
447 readln 453 blk
: (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

25
blk/430
View File

@ -1,15 +1,12 @@
: [ INTERPRET ; IMMEDIATE
: ] R> DROP ;
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
: LITA 36 , , ;
: '? WORD (find) ;
: '
'? (?br) [ 4 , ] EXIT
LIT< (wnf) (find) DROP EXECUTE
( Initializes the readln subsystem )
: RDLN$
( 57 == rdln's memory )
H@ 0x57 RAM+ !
( plus 2 for extra bytes after buffer: 1 for
the last typed 0x0a and one for the following NULL. )
IN) IN> - 2+ ALLOT
(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
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
: .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
;
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)
H@ ( push a )
2 ALLOT ( br cell allot )
; IMMEDIATE
: THEN ( a -- | a: br cell addr )
DUP H@ -^ SWAP ( a-H a )
!
; IMMEDIATE
: _
(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
;
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 )
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] ;
: LOAD
BLK> @ >R ( save restorable variables to RSP )
0x08 RAM+ @ >R ( 08 == C<* override )
0x06 RAM+ @ >R ( C<? )
0x2e RAM+ @ >R ( boot ptr )
BLK@
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
[ LITN ( from PSP, B432 ) ] 0x08 RAM+ !
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 ;

18
blk/434
View File

@ -1,14 +1,4 @@
: 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 )
;
: LOAD+ BLK> @ + LOAD ;
( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;

20
blk/435
View File

@ -1,8 +1,14 @@
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE , DOES> @ ;
( 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
( 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
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 ;
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!

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. )
: EXIT!
['] INTERPRET ( I )
BEGIN ( I )
DUP ( I I )
R> DROP I 2- @ ( I I a )
= UNTIL
DROP
;
Core words
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" ;
: 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 ;
: (wnf) (print) SPC ABORT" word not found" ;
: (ok) SPC ." ok" NL ;
: [ INTERPRET ; IMMEDIATE
: ] R> DROP ;
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
: LITA 36 , , ;
: ['] ' LITA ; IMMEDIATE
: COMPILE ' LITA ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: 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 @@
: _
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 ;
: IF ( -- a | a: br cell addr )
COMPILE (?br)
H@ ( push a )
2 ALLOT ( br cell allot )
; IMMEDIATE
: THEN ( a -- | a: br cell addr )
DUP H@ -^ SWAP ( a-H a )
!
; IMMEDIATE

28
blk/443
View File

@ -1,16 +1,12 @@
: ? @ . ;
: _
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
;
: 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] ;

28
blk/444
View File

@ -1,16 +1,14 @@
: _ ( a -- a+8 )
DUP ( save for 2nd loop )
':' EMIT DUP .x SPC
4 0 DO
DUP @ 256 /MOD SWAP
.x .x SPC 2+
LOOP
DROP
8 0 DO
C@+
DUP 0x20 0x7e =><= NOT
IF DROP '.' THEN
EMIT
LOOP
NL
: 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 )
;

12
blk/445
View File

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

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 !
282 LOAD ( boot.z80 )
393 LOAD ( icore low )
393 LOAD ( xcomp core low )
: (emit) 0 PC! ;
: (key) 0 PC@ ;
415 LOAD ( icore high )
420 LOAD ( xcomp core high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
," CURRENT @ HERE ! "
430 459 XPACKR
440 446 XPACKR
," ' (key) 12 RAM+ ! "
ORG @ 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC!

View File

@ -19,7 +19,6 @@ design.
## Gathering parts
* A RC2014 Classic
* `stage2.bin` from the base recipe
* A MicroSD breakout board. I use Adafruit's.
* A proto board + header pins with 39 positions so we can make a RC2014 card.
* 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
instead.
## Building your stage 3
## Building your binary
Using the same technique as you used in the `eeprom` recipe, you can append
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.
Your Collapse OS binary needs the SDC drivers which need to be inserted during
Cross Compilation, which needs you need to recompile it from stage 1. First,
look at B370. You'll see that it indicates a block range for the driver. That
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

View File

@ -20,14 +20,13 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
CURRENT @ XCURRENT !
282 LOAD ( boot.z80 )
393 LOAD ( icore low )
393 LOAD ( xcomp core low )
352 LOAD ( acia )
372 381 LOADR ( sdc )
415 LOAD ( icore high )
420 LOAD ( xcomp core high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
430 452 XPACKR ( core fmt readln )
440 446 XPACKR ( core )
123 132 XPACKR ( linker )
," : _ ACIA$ RDLN$ (ok) ; _ "
ORG @ 256 /MOD 2 PC! 2 PC!

View File

@ -66,15 +66,15 @@ CURRENT @ XCURRENT !
0x100 BIN( !
282 LOAD ( boot.z80 )
393 LOAD ( icore low )
393 LOAD ( xcomp core low )
CREATE ~FNT CPFNT3x5
555 560 LOADR ( LCD low )
566 570 LOADR ( KBD low )
415 LOAD ( icore high )
420 LOAD ( xcomp core high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
430 451 XPACKR ( core fmt readln )
440 446 XPACKR ( core )
," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC!

View File

@ -15,13 +15,13 @@ CURRENT @ XCURRENT !
0x3000 BIN( !
282 LOAD ( boot.z80 )
492 LOAD ( trs80.z80 )
393 LOAD ( icore low )
415 LOAD ( icore high )
393 LOAD ( xcomp core low )
420 LOAD ( xcomp core high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
," CURRENT @ HERE ! "
430 459 XPACKR ( core readln fmt blk )
440 446 XPACKR ( core )
499 500 XPACKR ( trs80.fs )
( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "