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

Compare commits

..

No commits in common. "6a5ff3adcbc3203aa5641875e3a3b4f94308c036" and "44b065ff99ae4e38243dfff571e28977a1092903" have entirely different histories.

35 changed files with 180 additions and 187 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 420 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,11 +5,7 @@ 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
_xapply , DUP ORG @ > IF ORG @ - BIN( @ + THEN ,
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, tight on the 0x100 limit ) PC ORG @ 0x22 + ! ( litWord, 0xf7, very 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,3 +1,4 @@
SD Card driver SD Card driver
Load range: 372-381 Load the z80 part with "372 LOAD", the Forth part with
"374 LOAD".

View File

@ -10,3 +10,5 @@ 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,4 +13,3 @@
: 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 4 LOADR+ 1 2 LOADR+

22
blk/416
View File

@ -1,14 +1,14 @@
: EMIT ( LITN has to be defined after the last immediate usage of
( 0x53==(emit) override ) it to avoid bootstrapping issues )
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ; : LITN 32 , , ( 32 == NUMBER ) ;
: (print) : IMMED? 1- C@ 0x80 AND ;
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,13 +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 BEGIN
C< WORD
( 34 is ASCII for " ) (find)
DUP 34 = IF DROP EXIT THEN C, ( is word )
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
View File

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

View File

@ -8,5 +8,6 @@ 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.
430 core 442 fmt 422 core 438 print
447 readln 453 blk 442 fmt 447 readln
453 blk

10
blk/422 Normal file
View File

@ -0,0 +1,10 @@
: [ 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

5
blk/423 Normal file
View File

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

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

View File

12
blk/426 Normal file
View File

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

@ -1,15 +1,14 @@
: [ INTERPRET ; IMMEDIATE : DOES>
: ] R> DROP ; ( Overwrite cellWord in CURRENT )
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE ( 43 == doesWord )
: LITA 36 , , ; 43 CURRENT @ C!
: '? WORD (find) ; ( When we have a DOES>, we forcefully place HERE to 4
: ' bytes after CURRENT. This allows a DOES word to use ","
'? (?br) [ 4 , ] EXIT and "C," without messing everything up. )
LIT< (wnf) (find) DROP EXECUTE 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 )
; ;
: ['] ' 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,13 +1,8 @@
: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE : VARIABLE CREATE 2 ALLOT ;
40 CURRENT @ 4 - C! : CONSTANT CREATE , DOES> @ ;
( 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 ( In addition to pushing H@ this compiles 2>R so that loop
not mistakenly consider '(' definition as a comment. variables are sent to PS at runtime )
LIT<: 34 == litWord : DO COMPILE 2>R H@ ; IMMEDIATE
LITA: 36 == addrWord : LOOP COMPILE (loop) H@ - , ; IMMEDIATE
COMPILE: Tough one. Get addr of caller word (example above : LEAVE R> R> DROP I 1- >R >R ;
(br)) and then call LITA on it. )

21
blk/433
View File

@ -1,12 +1,11 @@
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) : ROLL
COMPILE (br) DUP NOT IF EXIT THEN
2 ALLOT 1+ DUP PICK ( n val )
DUP H@ -^ SWAP ( a-H a ) SWAP 2 * (roll) ( val )
! 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,14 +1,13 @@
: DOES> : MOVE ( a1 a2 u -- )
( Overwrite cellWord in CURRENT ) ( u ) 0 DO ( a1 a2 )
( 43 == doesWord ) SWAP C@+ ( a2 a1+1 x )
43 CURRENT @ C! ROT C!+ ( a1+1 a2+1 )
( When we have a DOES>, we forcefully place HERE to 4 LOOP 2DROP ;
bytes after CURRENT. This allows a DOES word to use "," : MOVE- ( a1 a2 u -- )
and "C," without messing everything up. ) SWAP OVER + 1- ( a1 u a2+u-1 )
CURRENT @ 3 + HERE ! ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
( HERE points to where we should write R> ) ROT ( u ) 0 DO ( a2 a1 )
R> , C@- ( a2 a1-1 x )
( We're done. Because we've popped RS, we'll exit parent ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
definition ) LOOP 2DROP ;
; : PREV 3 - DUP @ - ;

21
blk/435
View File

@ -1,8 +1,13 @@
: VARIABLE CREATE 2 ALLOT ; : WORD(
: CONSTANT CREATE , DOES> @ ; DUP 1- C@ ( name len field )
127 AND ( 0x7f. remove IMMEDIATE flag )
( In addition to pushing H@ this compiles 2>R so that loop 3 + ( fixed header len )
variables are sent to PS at runtime ) -
: DO COMPILE 2>R H@ ; IMMEDIATE ;
: LOOP COMPILE (loop) H@ - , ; IMMEDIATE : FORGET
( LEAVE is implemented in xcomp ) ' 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 !
;

17
blk/436
View File

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

13
blk/437
View File

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

24
blk/439
View File

@ -1,10 +1,16 @@
( Drop RSP until I-2 == INTERPRET. ) : ,"
: EXIT! BEGIN
['] INTERPRET ( I ) C<
BEGIN ( I ) ( 34 is ASCII for " )
DUP ( I I ) DUP 34 = IF DROP EXIT THEN C,
R> DROP I 2- @ ( I I a ) AGAIN ;
= UNTIL
DROP : ."
; 34 , ( 34 == litWord ) ," 0 C,
COMPILE (print)
; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
: (uflw) ABORT" stack underflow" ;

View File

@ -1,4 +1,3 @@
: (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,8 +4,6 @@
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: , ] ;
@ -21,7 +19,7 @@ CURRENT @ XCURRENT !
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
430 459 XPACKR 422 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,9 +72,10 @@ 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. There's only one required unit: `blk` from required words to your boot binary. Required units `blk` (B464) and the SD Card
core words (B453). The SD card driver was already included in the base recipe driver (B370). You only need the Forth part. You of course actually need
to save you the troubles of rebuilding from stage 1 for this recipe. 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.
## Testing in the emulator ## Testing in the emulator

View File

@ -10,8 +10,6 @@ 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 ;
@ -22,12 +20,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 381 LOADR ( sdc ) 372 LOAD ( sdc.z80 )
415 LOAD ( icore high ) 415 LOAD ( icore high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
430 452 XPACKR ( core fmt readln ) 422 452 XPACKR ( core print 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,8 +9,6 @@ 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 )
@ -74,7 +72,7 @@ CREATE ~FNT CPFNT3x5
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
430 451 XPACKR ( core fmt readln ) 422 451 XPACKR ( core print 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,8 +4,6 @@ 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: , ] ;
@ -21,7 +19,7 @@ CURRENT @ XCURRENT !
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
430 459 XPACKR ( core readln fmt blk ) 422 459 XPACKR ( core print 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$ ; _ "