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
280 Z80 boot code 350 ACIA driver
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
550 TI-84+ Recipe

View File

@ -5,11 +5,7 @@ VARIABLE XCURRENT
: (xentry) XCON (entry) XCOFF ;
: XCREATE (xentry) 11 C, ;
: XCODE XCON CODE 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 )
IF ( a )
DUP IMMED? IF ABORT THEN
_xapply ,
DUP ORG @ > IF ORG @ - BIN( @ + THEN ,
ELSE ( w )
0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
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
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )

View File

@ -1,3 +1,4 @@
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,
HL PUSHqq,
;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
system. More details in B260.
These rules result in some practicals do's and dont's:
1. No LEAVE in DO..LOOP
(cont.)

View File

@ -13,4 +13,3 @@
: ALLOT HERE +! ;
: 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
( 0x53==(emit) override )
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
( LITN has to be defined after the last immediate usage of
it to avoid bootstrapping issues )
: LITN 32 , , ( 32 == NUMBER ) ;
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null or 0xd )
DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
EMIT ( a )
AGAIN
;
: 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

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
C<
( 34 is ASCII for " )
DUP 34 = IF DROP EXIT THEN C,
WORD
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse) LITN THEN
AGAIN ;
: ."
34 , ( 34 == litWord ) ," 0 C,
COMPILE (print)
; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
( from PSP ) ';' SWAP 4 - C!

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
you will typically XPACK (B267) them.
430 core 442 fmt
447 readln 453 blk
422 core 438 print
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
: ] R> DROP ;
: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
: LITA 36 , , ;
: '? WORD (find) ;
: '
'? (?br) [ 4 , ] EXIT
LIT< (wnf) (find) DROP EXECUTE
: 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 )
;
: ['] ' 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
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
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE , DOES> @ ;
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. )
( 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 R> R> DROP I 1- >R >R ;

21
blk/433
View File

@ -1,12 +1,11 @@
: 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
: 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 ;
: [IF]
IF EXIT THEN
LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
: [THEN] ;

27
blk/434
View File

@ -1,14 +1,13 @@
: 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 )
;
: 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 @ - ;

21
blk/435
View File

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

17
blk/436
View File

@ -1,11 +1,10 @@
: ROLL
DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
SWAP DROP
( Drop RSP until I-2 == INTERPRET. )
: EXIT!
['] INTERPRET ( I )
BEGIN ( I )
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(
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 !
: EMIT
( 0x53==(emit) override )
83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null or 0xd )
DUP 13 = OVER NOT OR IF 2DROP EXIT THEN
EMIT ( a )
AGAIN
;

24
blk/439
View File

@ -1,10 +1,16 @@
( Drop RSP until I-2 == INTERPRET. )
: EXIT!
['] INTERPRET ( I )
BEGIN ( I )
DUP ( I I )
R> DROP I 2- @ ( I I a )
= UNTIL
DROP
;
: ,"
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
: (uflw) ABORT" stack underflow" ;

View File

@ -1,4 +1,3 @@
: (uflw) ABORT" stack underflow" ;
: BS 8 EMIT ;
: LF 10 EMIT ;
: CR 13 EMIT ;

Binary file not shown.

View File

@ -4,8 +4,6 @@
212 LOAD ( z80 assembler )
262 LOAD ( xcomp )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: : [ ' X: , ] ;
@ -21,7 +19,7 @@ CURRENT @ XCURRENT !
( Update LATEST )
PC ORG @ 8 + !
," CURRENT @ HERE ! "
430 459 XPACKR
422 459 XPACKR
," ' (key) 12 RAM+ ! "
ORG @ 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC!

View File

@ -72,9 +72,10 @@ instead.
## Building your stage 3
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.
required words to your boot binary. Required units `blk` (B464) and the SD Card
driver (B370). You only need the Forth part. You of course actually need
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

View File

@ -10,8 +10,6 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
212 LOAD ( z80 assembler )
262 LOAD ( xcomp )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: CREATE XCREATE ;
@ -22,12 +20,12 @@ CURRENT @ XCURRENT !
282 LOAD ( boot.z80 )
393 LOAD ( icore low )
352 LOAD ( acia )
372 381 LOADR ( sdc )
372 LOAD ( sdc.z80 )
415 LOAD ( icore high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
430 452 XPACKR ( core fmt readln )
422 452 XPACKR ( core print fmt readln )
123 132 XPACKR ( linker )
," : _ ACIA$ RDLN$ (ok) ; _ "
ORG @ 256 /MOD 2 PC! 2 PC!

View File

@ -9,8 +9,6 @@ RAMSTART 0x72 + CONSTANT KBD_MEM
262 LOAD ( xcomp )
522 LOAD ( font compiler )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: CREATE XCREATE ; ( for KBD tbls )
@ -74,7 +72,7 @@ CREATE ~FNT CPFNT3x5
(entry) _
( Update LATEST )
PC ORG @ 8 + !
430 451 XPACKR ( core fmt readln )
422 451 XPACKR ( core print fmt readln )
," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
ORG @ 0x100 - 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 )
262 LOAD ( xcomp )
: CODE XCODE ;
: COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: : [ ' X: , ] ;
@ -21,7 +19,7 @@ CURRENT @ XCURRENT !
( Update LATEST )
PC ORG @ 8 + !
," CURRENT @ HERE ! "
430 459 XPACKR ( core readln fmt blk )
422 459 XPACKR ( core print readln fmt blk )
499 500 XPACKR ( trs80.fs )
( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "