izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 08:30:55 +11:00
Code Issues Releases Wiki Activity

Compare commits

base: izaya:6c51ea1ebb28417390b437c3e2006ccfdeb19188
Branches Tags
izaya:master
izaya:z80asm
izaya:wip
izaya:forth
..
compare: izaya:a2f164ecc362110ecae89a7bf01bf758d4d835dd
Branches Tags
izaya:master
izaya:z80asm
izaya:wip
izaya:forth

No commits in common. "6c51ea1ebb28417390b437c3e2006ccfdeb19188" and "a2f164ecc362110ecae89a7bf01bf758d4d835dd" have entirely different histories.
6c51ea1ebb ... a2f164ecc3

45 changed files with 1335 additions and 363 deletions
Show Stats Expand all files Collapse all files

3
blk/001
View File

@ -2,8 +2,6 @@ MASTER INDEX
3 Usage 30 Dictionary
70 Implementation notes 100 Block editor
120 Linker 140 Addressed devices
150 AT28 Driver
200 Z80 assembler 260 Cross compilation
280 Z80 boot code 350 ACIA driver
370 SD Card driver 390 Inner core
@ -15,3 +13,4 @@ MASTER INDEX

16
blk/120
View File

@ -1,16 +0,0 @@
Linker
Relink a dictionary by applying offsets to all word references
in words of the "compiled" type.
A typical usage of this unit would be to, right after a
bootstrap-from-icore-from-source operation, identify the root
word of the source part, probably "H@", and run " ' thatword
RLDICT ". Then, take the resulting relinked binary, concatenate
it to the boot binary, and write to boot media.
LIMITATIONS
This unit can't automatically detect all offsets needing
relinking. This is a list of situations that aren't handled:
(cont.)

8
blk/121
View File

@ -1,8 +0,0 @@
Cells: It's not possible to know for sure whether a cellWord
contains an address or a number. They are therefore not
automatically relinked. You have to manually relink each of
them with RLCELL. In the case of a DOES> word, PFA+2, which
is always an offset, is automatically relinked, but not
PFA+0.
Load with "122 LOAD"

1
blk/122
View File

@ -1 +0,0 @@
123 132 LOADR

15
blk/123
View File

@ -1,15 +0,0 @@
( Skip atom, considering special atom types. )
: ASKIP ( a -- a+n )
DUP @ ( a n )
( ?br or br or NUMBER )
DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
IF DROP 4 + EXIT THEN
( regular word )
0x22 = NOT IF 2+ EXIT THEN
( it's a lit, skip to null char )
( a )
1+ ( we skip by 2, but the loop below is pre-inc... )
BEGIN 1+ DUP C@ NOT UNTIL
( skip null char )
1+
;

11
blk/124
View File

@ -1,11 +0,0 @@
( RLATOM pre-comment
Relink atom at a, applying offset o with limit ol.
Returns a, appropriately skipped.
0x24 = IF: 0x24 is an addrWord, which should be offsetted in
the same way that a regular word would. To achieve this, we
skip ASKIP and instead of skipping 4 bytes like a numberWord,
we skip only 2, which means that our number will be treated
like a regular wordref. )

16
blk/125
View File

@ -1,16 +0,0 @@
: RLATOM ( a o ol -- a+n )
ROT ( o ol a )
DUP @ ( o ol a n )
DUP 0x24 = IF
DROP 2+ ( o ol a+2 )
ROT ROT 2DROP ( a ) EXIT
THEN
ROT ( o a n ol )
< IF ( under limit, do nothing )
SWAP DROP ( a )
ELSE ( o a )
SWAP OVER @ ( a o n )
-^ ( a n-o )
OVER ! ( a )
THEN
ASKIP ;

15
blk/126
View File

@ -1,15 +0,0 @@
( RLWORD pre-comment
Relink a word with specified offset. If it's not of the type
"compiled word", ignore. If it is, advance in word until a2
is met, and for each word that is above ol, reduce that
reference by o.
Arguments: a1: wordref a2: word end addr o: offset to apply
ol: offset limit. don't apply on refs under it.
The 0x0e and 0x2b check at the beginning is to ensure we have
either a compiledWord or a doesWord. If we don't, we do
nothing. The further 0x2b check is because if we have a
doesWord, we start 2 bytes later.
)

16
blk/127
View File

@ -1,16 +0,0 @@
: RLWORD ( ol o a1 a2 -- )
SWAP DUP C@ ( ol o a2 a1 n )
DUP <>{ 0x0e &= 0x2b |= <>} NOT IF ( unwind all args )
2DROP 2DROP EXIT THEN
0x2b = IF 2+ THEN ( ol o a2 a1 )
1+ ( ol o a2 a1+1 )
BEGIN ( ol o a2 a1 )
2OVER SWAP ( ol o a2 a1 o ol )
RLATOM ( ol o a2 a+n )
2DUP < IF ABORT THEN ( Something is very wrong )
2DUP = ( ol o a2 a+n f )
IF ( unwind )
2DROP 2DROP EXIT
THEN
AGAIN
;

16
blk/128
View File

@ -1,16 +0,0 @@
( RLDICT pre-comment: Copy dict from target wordref, including
header, up to HERE. We're going relocate those words by
specified offset. To do this, we're copying this whole memory
area in HERE and then iterate through that copied area and call
RLWORD on each word. That results in a dict that can be
concatenated to target's prev entry in a more compact way.
This copy of data doesn't allocate anything, so H@ doesn't
move. Moreover, we reserve 4 bytes at H@ to write our target
and offset because otherwise, things get too complicated with
the PSP.
The output of this word is 3 numbers: top copied address, top
copied CURRENT, and then the beginning of the copied dict at
the end to indicate that we're finished processing.
cont. )

16
blk/130
View File

@ -1,16 +0,0 @@
( Note that the last word is always skipped because it's not
possible to reliably detect its end. If you need that last
word, define a dummy word before calling RLDICT.
We first start by copying the affected area to H@+4. This is
where the relinking will take place.
Then we iterate the new dict from the top, keeping track of
wr, the current wordref and we, wr's end offset.
Initially, we get our wr and we, withH@ and CURRENT, which we
offset by u+4. +4 before, remember, we're using 4 bytes
as variable space.
At each iteration, we becomes wr-header and wr is fetched from
PREV field. )

16
blk/131
View File

@ -1,16 +0,0 @@
: RLDICT ( target offset -- )
H@ 2+ ! H@ ! ( H@+2 == offset, H@ == target )
H@ @ WORD( DUP H@ -^ ( src u )
DUP ROT SWAP H@ 4 + ( u src u dst )
SWAP MOVE ( u )
4 + DUP CURRENT @ WORD( + ( u we )
DUP .X CRLF
SWAP CURRENT @ PREV + DUP .X CRLF ( we wr )
BEGIN ( we wr )
DUP ROT ( wr wr we )
H@ @ H@ 2+ @ ( wr wr we ol o )
2SWAP RLWORD ( wr )
DUP PREV SWAP ( wr oldwr )
WORD( SWAP ( we wr )
DUP 4 - H@ <= ( are we finished? )
UNTIL H@ 4 + .X CRLF ;

9
blk/132
View File

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

10
blk/140
View File

@ -1,10 +0,0 @@
Addressed devices
Abstractions to read and write to devices that allow addressed
access. At all times, we have one active "fetch" device and
one active "store" device, A@ and A!.
Those words have the same signature as C@ and C!, and in fact,
initially default to proxy of those words.
Load with "142 LOAD"

1
blk/142
View File

@ -1 +0,0 @@
143 144 LOADR

15
blk/143
View File

@ -1,15 +0,0 @@
: ADEVMEM+ 0x55 RAM+ @ + ;
: A@* 0 ADEVMEM+ ;
: A!* 2 ADEVMEM+ ;
: ADEV$
H@ 0x55 RAM+ !
4 ALLOT
['] C@ A@* !
['] C! A!* !
;
: A@ A@* @ EXECUTE ;
: A! A!* @ EXECUTE ;

11
blk/144
View File

@ -1,11 +0,0 @@
( Same as MOVE, but with A@ and A! )
( src dst u -- )
: AMOVE
( u ) 0 DO
SWAP DUP I + A@ ( dst src x )
ROT SWAP OVER I + ( src dst x dst )
A! ( src dst )
LOOP
2DROP
;

6
blk/150
View File

@ -1,6 +0,0 @@
AT28 Driver
Write to an AT28 EEPROM while making sure that proper timing
is followed and verify data integrity.
Load with "151 LOAD"

13
blk/357
View File

@ -1 +1,14 @@
0x20 CONSTANT ACIABUFSZ
( Points to ACIA buf )
: ACIA( [ ACIA_MEM 4 + LITN ] ;
( Points to ACIA buf end )
: ACIA) [ ACIA_MEM 6 + LITN ] ;
( Read buf pointer. Pre-inc )
: ACIAR> [ ACIA_MEM LITN ] ;
( Write buf pointer. Post-inc )
: ACIAW> [ ACIA_MEM 2 + LITN ] ;
( This means that if W> == R>, buffer is full.
If R>+1 == W>, buffer is empty. )
358 360 LOADR

29
blk/358
View File

@ -1,13 +1,16 @@
0x20 CONSTANT ACIABUFSZ
( Points to ACIA buf )
: ACIA( [ ACIA_MEM 4 + LITN ] ;
( Points to ACIA buf end )
: ACIA) [ ACIA_MEM 6 + LITN ] ;
( Read buf pointer. Pre-inc )
: ACIAR> [ ACIA_MEM LITN ] ;
( Write buf pointer. Post-inc )
: ACIAW> [ ACIA_MEM 2 + LITN ] ;
( This means that if W> == R>, buffer is full.
If R>+1 == W>, buffer is empty. )
: ACIA$
H@ DUP DUP ACIA( ! ACIAR> !
1+ ACIAW> ! ( write index starts one position later )
ACIABUFSZ ALLOT
H@ ACIA) !
( setup ACIA
CR7 (1) - Receive Interrupt enabled
CR6:5 (00) - RTS low, transmit interrupt disabled.
CR4:2 (101) - 8 bits + 1 stop bit
CR1:0 (10) - Counter divide: 64 )
0b10010110 ACIA_CTL PC!
( setup interrupt )
0xc3 0x4e RAM+ C! ( c3==JP, 4e==INTJUMP )
['] ~ACIA 0x4f RAM+ !
(im1)
;

28
blk/359
View File

@ -1,16 +1,14 @@
: ACIA$
H@ DUP DUP ACIA( ! ACIAR> !
1+ ACIAW> ! ( write index starts one position later )
ACIABUFSZ ALLOT
H@ ACIA) !
( setup ACIA
CR7 (1) - Receive Interrupt enabled
CR6:5 (00) - RTS low, transmit interrupt disabled.
CR4:2 (101) - 8 bits + 1 stop bit
CR1:0 (10) - Counter divide: 64 )
0b10010110 ACIA_CTL PC!
( setup interrupt )
0xc3 0x4e RAM+ C! ( c3==JP, 4e==INTJUMP )
['] ~ACIA 0x4f RAM+ !
(im1)
: KEY
( inc then fetch )
ACIAR> @ 1+ DUP ACIA) @ = IF
DROP ACIA( @
THEN
( As long as R> == W>-1, it means that buffer is empty )
BEGIN DUP ACIAW> @ = NOT UNTIL
ACIAR> !
ACIAR> @ C@
;

11
blk/360
View File

@ -1,16 +1,7 @@
: KEY
( inc then fetch )
ACIAR> @ 1+ DUP ACIA) @ = IF
DROP ACIA( @
THEN
( As long as R> == W>-1, it means that buffer is empty )
BEGIN DUP ACIAW> @ = NOT UNTIL
ACIAR> !
ACIAR> @ C@
;
: EMIT
( As long at CTL bit 1 is low, we are transmitting. wait )
BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
( The way is clear, go! )
ACIA_IO PC!
;

69
drv/acia.fs Normal file
View File

@ -0,0 +1,69 @@
( ACIA
Manage I/O from an asynchronous communication interface adapter
(ACIA). provides "EMIT" to put c char on the ACIA as well as
an input buffer. You have to call "~ACIA" on interrupt for
this module to work well.
CONFIGURATION
ACIA_CTL: IO port for the ACIA's control registers
ACIA_IO: IO port for the ACIA's data registers
ACIA_MEM: Address in memory that can be used variables shared
with ACIA's native words. 8 bytes used.
)
0x20 CONSTANT ACIABUFSZ
( Points to ACIA buf )
: ACIA( [ ACIA_MEM 4 + LITN ] ;
( Points to ACIA buf end )
: ACIA) [ ACIA_MEM 6 + LITN ] ;
( Read buf pointer. Pre-inc )
: ACIAR> [ ACIA_MEM LITN ] ;
( Write buf pointer. Post-inc )
: ACIAW> [ ACIA_MEM 2 + LITN ] ;
( This means that if W> == R>, buffer is full.
If R>+1 == W>, buffer is empty. )
: ACIA$
H@ DUP DUP ACIA( ! ACIAR> !
1+ ACIAW> ! ( write index starts one position later )
ACIABUFSZ ALLOT
H@ ACIA) !
( setup ACIA
CR7 (1) - Receive Interrupt enabled
CR6:5 (00) - RTS low, transmit interrupt disabled.
CR4:2 (101) - 8 bits + 1 stop bit
CR1:0 (10) - Counter divide: 64
)
0b10010110 ACIA_CTL PC!
( setup interrupt )
( 4e == INTJUMP )
0xc3 0x4e RAM+ C! ( JP upcode )
['] ~ACIA 0x4f RAM+ !
(im1)
;
: KEY
( inc then fetch )
ACIAR> @ 1+ DUP ACIA) @ = IF
DROP ACIA( @
THEN
( As long as R> == W>-1, it means that buffer is empty )
BEGIN DUP ACIAW> @ = NOT UNTIL
ACIAR> !
ACIAR> @ C@
;
: EMIT
( As long at CTL bit 1 is low, we are transmitting. wait )
BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
( The way is clear, go! )
ACIA_IO PC!
;

6
blk/151 → drv/at28.fs
View File

@ -1,7 +1,9 @@
( With dst being assumed to be an AT28 EEPROM, perform !
operation while doing the right thing. Checks data integrity
and ABORT on mismatch. )
: AT28! ( n a -- )
and ABORT on mismatch.
)
( n a -- )
: AT28!
2DUP C!
( as long as writing operation is running, IO/6 will toggle at each
read attempt. We know that write is finished when we read the same

215
drv/sdc.fs Normal file
View File

@ -0,0 +1,215 @@
( -- n )
: _idle 0xff _sdcSR ;
( -- n )
( _sdcSR 0xff until the response is something else than 0xff
for a maximum of 20 times. Returns 0xff if no response. )
: _wait
0 ( cnt )
BEGIN
_idle
DUP 0xff = IF DROP ELSE SWAP DROP EXIT THEN
1+
DUP 20 = UNTIL
DROP 0xff
;
( -- )
( The opposite of sdcWaitResp: we wait until response is 0xff.
After a successful read or write operation, the card will be
busy for a while. We need to give it time before interacting
with it again. Technically, we could continue processing on
our side while the card it busy, and maybe we will one day,
but at the moment, I'm having random write errors if I don't
do this right after a write, so I prefer to stay cautious
for now. )
: _ready BEGIN _idle 0xff = UNTIL ;
( c n -- c )
( Computes n into crc c with polynomial 0x09
Note that the result is "left aligned", that is, that 8th
bit to the "right" is insignificant (will be stop bit). )
: _crc7
XOR ( c )
8 0 DO
2 * ( <<1 )
DUP 255 > IF
( MSB was set, apply polynomial )
0xff AND
0x12 XOR ( 0x09 << 1, we apply CRC on high bits )
THEN
LOOP
;
( c n -- c )
( Computes n into crc c with polynomial 0x1021 )
: _crc16
SWAP DUP 256 / ( n c c>>8 )
ROT XOR ( c x )
DUP 16 / XOR ( c x^x>>4 )
SWAP 256 * ( x c<<8 )
OVER 4096 * XOR ( x c^x<<12 )
OVER 32 * XOR ( x c^x<<5 )
XOR ( c )
;
( send-and-crc7 )
( n c -- c )
: _s+crc SWAP DUP _sdcSR DROP _crc7 ;
( cmd arg1 arg2 -- resp )
( Sends a command to the SD card, along with arguments and
specified CRC fields. (CRC is only needed in initial commands
though).
This does *not* handle CS. You have to select/deselect the
card outside this routine. )
: _cmd
_wait DROP
ROT ( a1 a2 cmd )
0 _s+crc ( a1 a2 crc )
ROT 256 /MOD ( a2 crc h l )
ROT ( a2 h l crc )
_s+crc ( a2 h crc )
_s+crc ( a2 crc )
SWAP 256 /MOD ( crc h l )
ROT ( h l crc )
_s+crc ( h crc )
_s+crc ( crc )
( send CRC )
0x01 OR ( ensure stop bit )
_sdcSR DROP
( And now we just have to wait for a valid response... )
_wait
;
( cmd arg1 arg2 -- r )
( Send a command that expects a R1 response, handling CS. )
: SDCMDR1 _sdcSel _cmd _sdcDesel ;
( cmd arg1 arg2 -- r arg1 arg2 )
( Send a command that expects a R7 response, handling CS. A R7
is a R1 followed by 4 bytes. arg1 contains bytes 0:1, arg2
has 2:3 )
: SDCMDR7
_sdcSel
_cmd ( r )
_idle 256 * ( r h )
_idle + ( r arg1 )
_idle 256 * ( r arg1 h )
_idle + ( r arg1 arg2 )
_sdcDesel
;
: _err _sdcDesel ABORT" SDerr" ;
( Initialize a SD card. This should be called at least 1ms
after the powering up of the card. )
: SDC$
( Wake the SD card up. After power up, a SD card has to
receive at least 74 dummy clocks with CS and DI high. We
send 80. )
10 0 DO _idle DROP LOOP
( call cmd0 and expect a 0x01 response (card idle)
this should be called multiple times. we're actually
expected to. let's call this for a maximum of 10 times. )
0 ( dummy )
10 0 DO ( r )
DROP
0b01000000 0 0 ( CMD0 )
SDCMDR1
DUP 0x01 = IF LEAVE THEN
LOOP
0x01 = NOT IF _err THEN
( Then comes the CMD8. We send it with a 0x01aa argument
and expect a 0x01aa argument back, along with a 0x01 R1
response. )
0b01001000 0 0x1aa ( CMD8 )
SDCMDR7 ( r arg1 arg2 )
0x1aa = NOT IF _err THEN ( arg2 check )
0 = NOT IF _err THEN ( arg1 check )
0x01 = NOT IF _err THEN ( r check )
( Now we need to repeatedly run CMD55+CMD41 (0x40000000)
until the card goes out of idle mode, that is, when
it stops sending us 0x01 response and send us 0x00
instead. Any other response means that initialization
failed. )
BEGIN
0b01110111 0 0 ( CMD55 )
SDCMDR1
0x01 = NOT IF _err THEN
0b01101001 0x4000 0x0000 ( CMD41 )
SDCMDR1
DUP 0x01 > IF _err THEN
NOT UNTIL
( Out of idle mode! Success! )
;
( dstaddr blkno -- )
: _sdc@
_sdcSel
0x51 ( CMD17 )
0 ROT ( a cmd 0 blkno )
_cmd
IF _err THEN
_wait
0xfe = NOT IF _err THEN
0 SWAP ( crc a )
512 0 DO ( crc a )
DUP ( crc a a )
_idle ( crc a a n )
DUP ROT ( crc a n n a )
C! ( crc a n )
ROT SWAP ( a crc n )
_crc16 ( a crc )
SWAP 1+ ( crc a+1 )
LOOP
DROP ( crc1 )
_idle 256 *
_idle + ( crc2 )
_wait DROP
_sdcDesel
= NOT IF _err THEN
;
: SDC@
2 * DUP BLK( SWAP ( b a b )
_sdc@
1+ BLK( 512 + SWAP
_sdc@
;
( srcaddr blkno -- )
: _sdc!
_sdcSel
0x58 ( CMD24 )
0 ROT ( a cmd 0 blkno )
_cmd
IF _err THEN
_idle DROP
0xfe _sdcSR DROP
0 SWAP ( crc a )
512 0 DO ( crc a )
C@+ ( crc a+1 n )
ROT OVER ( a n crc n )
_crc16 ( a n crc )
SWAP ( a crc n )
_sdcSR DROP ( a crc )
SWAP ( crc a )
LOOP
DROP ( crc )
256 /MOD ( lsb msb )
_sdcSR DROP ( lsb )
_sdcSR DROP
_wait DROP
_sdcDesel
;
: SDC!
2 * DUP BLK( SWAP ( b a b )
_sdc!
1+ BLK( 512 + SWAP
_sdc!
;

3
emul/.gitignore vendored
View File

@ -3,5 +3,6 @@
/stage2
/forth
/*-bin.h
/stage1.bin
/core.bin
/forth?.bin
/blkfs

7
forth/README.md Normal file
View File

@ -0,0 +1,7 @@
# Forth
**WIP** A Forth interpreter. Far from complete, but you can do stuff like
KEY EMIT KEY EMIT
See dictionary.txt for a word reference.

34
forth/adev.fs Normal file
View File

@ -0,0 +1,34 @@
( Addressed devices.
Abstractions to read and write to devices that allow addressed
access. At all times, we have one active "fetch" device and
one active "store" device, A@ and A!.
Those words have the same signature as C@ and C!, and in fact,
initially default to proxy of those words.
)
: ADEVMEM+ 0x55 RAM+ @ + ;
: A@* 0 ADEVMEM+ ;
: A!* 2 ADEVMEM+ ;
: ADEV$
H@ 0x55 RAM+ !
4 ALLOT
['] C@ A@* !
['] C! A!* !
;
: A@ A@* @ EXECUTE ;
: A! A!* @ EXECUTE ;
( Same as MOVE, but with A@ and A! )
( src dst u -- )
: AMOVE
( u ) 0 DO
SWAP DUP I + A@ ( dst src x )
ROT SWAP OVER I + ( src dst x dst )
A! ( src dst )
LOOP
2DROP
;

95
forth/blk.fs Normal file
View File

@ -0,0 +1,95 @@
( I/O blocks )
: BLKMEM+ 0x57 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$
H@ 0x57 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> !
;
( -- )
: BLK!
BLK> @ BLK!* @ EXECUTE
0 BLKDTY !
;
( n -- )
: BLK@
DUP BLK> @ = IF DROP EXIT THEN
BLKDTY @ IF BLK! THEN
DUP BLK> ! BLK@* @ EXECUTE
;
: BLK!! 1 BLKDTY ! ;
: .2 DUP 10 < IF SPC THEN . ;
: LIST
BLK@
16 0 DO
I 1+ .2 SPC
64 I * BLK( + (print)
CRLF
LOOP
;
: _
(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
;
: LOAD
( save restorable variables to RSP )
BLK> @ >R
0x08 RAM+ @ >R
0x06 RAM+ @ >R ( C<? )
0x2e RAM+ @ >R ( boot ptr )
BLK@
( Point to beginning of BLK )
BLK( 0x2e RAM+ !
( 08 == C<* override )
['] _ 0x08 RAM+ !
( While we interpret, don't print "ok" after every word )
1 0x06 RAM+ ! ( 06 == C<? )
INTERPRET
R> 0x2e RAM+ !
R> 0x06 RAM+ !
( Before we restore C<* are we restoring it to "_"?
if yes, it means we're in a nested LOAD which means we
should also load back the saved BLK>. Otherwise, we can
ignore the BLK> from RSP. )
I 0x08 RAM+ @ = IF
( nested load )
R> DROP ( C<* )
R> BLK@
ELSE
( not nested )
R> 0x08 RAM+ !
R> DROP ( BLK> )
THEN
;
( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;

42
forth/cmp.fs Normal file
View File

@ -0,0 +1,42 @@
( Words useful for complex comparison operations )
: >= < NOT ;
: <= > NOT ;
: 0>= 0< NOT ;
( n1 -- n1 true )
: <>{ 1 ;
( n1 f -- f )
: <>} SWAP DROP ;
: _|&
( n1 n2 cell )
>R >R DUP R> R> ( n1 n1 n2 cell )
@ EXECUTE ( n1 f )
;
( n1 f n2 -- n1 f )
: _|
CREATE , DOES>
( n1 f n2 cell )
ROT IF 2DROP 1 EXIT THEN ( n1 true )
_|&
;
: _&
CREATE , DOES>
( n1 f n2 cell )
ROT NOT IF 2DROP 0 EXIT THEN ( n1 true )
_|&
;
( All words below have this signature:
n1 f n2 -- n1 f )
' = _| |=
' = _& &=
' > _| |>
' > _& &>
' < _| |<
' < _& &<

203
forth/core.fs Normal file
View File

@ -0,0 +1,203 @@
: H@ HERE @ ;
: IMMEDIATE
CURRENT @ 1-
DUP C@ 128 OR SWAP C!
;
: [ INTERPRET ; IMMEDIATE
: ] R> DROP ;
: LITS 34 , SCPY ;
: LIT< WORD LITS ; IMMEDIATE
: LITA 36 , , ;
: '
WORD (find) (?br) [ 4 , ] EXIT
LIT< (wnf) (find) DROP EXECUTE
;
: ['] ' LITA ; IMMEDIATE
: COMPILE ' LITA ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE
: _ 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
"_": words starting with "_" are meant to be "private",
that is, only used by their immediate surrondings.
40 is ASCII for '('. We do this to simplify XPACK's task of
not mistakenly consider '(' definition as a comment.
LITS: 34 == litWord
LITA: 36 == addrWord
COMPILE: Tough one. Get addr of caller word (example above
(br)) and then call LITA on it. )
: +! SWAP OVER @ + SWAP ! ;
: -^ SWAP - ;
: ALLOT HERE +! ;
: 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
: 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
( During a CASE, the stack grows by 1 at each ENDOF so that
we can fill all those ENDOF branching addrs. So that we
know when to stop, we put a 0 on PSP. That's our stopgap. )
: CASE 0 COMPILE >R ; IMMEDIATE
: OF
COMPILE I COMPILE =
[COMPILE] IF
; IMMEDIATE
: ENDOF [COMPILE] ELSE ; IMMEDIATE
( At this point, we have something like "0 e1 e2 e3 val". We
want top drop val, and then call THEN as long as we don't
hit 0. )
: ENDCASE
BEGIN
DUP NOT IF
DROP COMPILE R> COMPILE DROP EXIT
THEN
[COMPILE] THEN
AGAIN
; IMMEDIATE
: CREATE
(entry) ( empty header with name )
11 ( 11 == cellWord )
C, ( write it )
;
( We run this when we're in an entry creation context. Many
things we need to do.
1. Change the code link to doesWord
2. Leave 2 bytes for regular cell variable.
3. Write down RS' RTOS to entry.
4. exit parent definition
)
: 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 )
;
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE , DOES> @ ;
: / /MOD SWAP DROP ;
: MOD /MOD DROP ;
( In addition to pushing H@ this compiles 2 >R so that loop
variables are sent to PS at runtime )
: DO
COMPILE SWAP COMPILE >R COMPILE >R
H@
; IMMEDIATE
( Increase loop counter and returns whether we should loop. )
: _
R> ( IP, keep for later )
R> 1+ ( ip i+1 )
DUP >R ( ip i )
I' = ( ip f )
SWAP >R ( f )
;
( One could think that we should have a sub word to avoid all
these COMPILE, but we can't because otherwise it messes with
the RS )
: LOOP
COMPILE _ COMPILE (?br)
H@ - ,
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
; IMMEDIATE
: LEAVE R> R> DROP I 1- >R >R ;
: ROLL
DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
SWAP DROP
;
: 2DUP OVER OVER ;
: 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ;
( a1 a2 u -- )
: MOVE
( u ) 0 DO
SWAP DUP I + C@ ( a2 a1 x )
ROT SWAP OVER I + ( a1 a2 x a2 )
C! ( a1 a2 )
LOOP
2DROP
;
: DELW
1- 0 SWAP C!
;
: PREV
3 - DUP @ ( a o )
- ( a-o )
;
: 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 !
;
: EMPTY
LIT< _sys (find) NOT IF ABORT THEN
DUP HERE ! CURRENT !
;
( Drop RSP until I-2 == INTERPRET. )
: EXIT!
['] INTERPRET ( I )
BEGIN ( I )
DUP ( I I )
R> DROP I 2- @ ( I I a )
= UNTIL
DROP
;
( a -- a+1 c )
: C@+ DUP C@ SWAP 1+ SWAP ;

73
forth/fmt.fs Normal file
View File

@ -0,0 +1,73 @@
( requires core, parse, cmp )
: _
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, we're done )
EMIT
AGAIN
;
: ? @ . ;
: _
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
;
( 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 |> <>}
IF DROP '.' THEN
EMIT
LOOP
CRLF
;
( n a -- )
: DUMP
LF
BEGIN
OVER 1 < IF 2DROP EXIT THEN
_
SWAP 8 - SWAP
AGAIN
;

185
forth/link.fs Normal file
View File

@ -0,0 +1,185 @@
( depends: cmp, parse
Relink a dictionary by applying offsets to all word
references in words of the "compiled" type.
A typical usage of this unit would be to, right after a
bootstrap-from-icore-from-source operation, identify the
root word of the source part, probably "H@", and run
" ' thatword RLDICT ". Then, take the resulting relinked
binary, concatenate it to the boot binary, and write to
boot media.
LIMITATIONS
This unit can't automatically detect all offsets needing
relinking. This is a list of situations that aren't handled:
Cells: It's not possible to know for sure whether a cellWord
contains an address or a number. They are therefore not
automatically relinked. You have to manually relink each of
them with RLCELL. In the case of a DOES> word, PFA+2, which
is always an offset, is automatically relinked, but not
PFA+0.
)
( Skip atom, considering special atom types. )
( a -- a+n )
: ASKIP
DUP @ ( a n )
( ?br or br or NUMBER )
DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
IF DROP 4 + EXIT THEN
( regular word )
0x22 = NOT IF 2+ EXIT THEN
( it's a lit, skip to null char )
( a )
1+ ( we skip by 2, but the loop below is pre-inc... )
BEGIN 1+ DUP C@ NOT UNTIL
( skip null char )
1+
;
( Relink atom at a, applying offset o with limit ol.
Returns a, appropriately skipped.
)
( a o ol -- a+n )
: RLATOM
ROT ( o ol a )
DUP @ ( o ol a n )
DUP 0x24 = IF
( 0x24 is an addrWord, which should be offsetted in
the same way that a regular word would. To achieve
this, we skip ASKIP and instead of skipping 4 bytes
like a numberWord, we skip only 2, which means that
our number will be treated like a regular wordref.
)
DROP
2+ ( o ol a+2 )
ROT ROT 2DROP ( a )
EXIT
THEN
ROT ( o a n ol )
< IF ( under limit, do nothing )
SWAP DROP ( a )
ELSE
( o a )
SWAP OVER @ ( a o n )
-^ ( a n-o )
OVER ! ( a )
THEN
ASKIP
;
( Relink a word with specified offset. If it's not of the type
"compiled word", ignore. If it is, advance in word until a2
is met, and for each word that is above ol, reduce that
reference by o.
Arguments: a1: wordref a2: word end addr o: offset to apply
ol: offset limit. don't apply on refs under it.
)
( ol o a1 a2 -- )
: RLWORD
SWAP DUP C@ ( ol o a2 a1 n )
( 0e == compiledWord, 2b == doesWord )
DUP <>{ 0x0e &= 0x2b |= <>} NOT IF
( unwind all args )
2DROP 2DROP
EXIT
THEN
( we have a compiled word or doesWord, proceed )
( doesWord is processed exactly like a compiledWord, but
starts 2 bytes further. )
( ol o a2 a1 n )
0x2b = IF 2+ THEN
( ol o a2 a1 )
1+ ( ol o a2 a1+1 )
BEGIN ( ol o a2 a1 )
2OVER ( ol o a2 a1 ol o )
SWAP ( ol o a2 a1 o ol )
RLATOM ( ol o a2 a+n )
2DUP < IF ABORT THEN ( Something is very wrong )
2DUP = ( ol o a2 a+n f )
IF
( unwind )
2DROP 2DROP
EXIT
THEN
AGAIN
;
( TODO implement RLCELL )
( Copy dict from target wordref, including header, up to HERE.
We're going relocate those words by specified offset. To do
this, we're copying this whole memory area in HERE and then
iterate through that copied area and call RLWORD on each
word. That results in a dict that can be concatenated to
target's prev entry in a more compact way.
This copy of data doesn't allocate anything, so H@ doesn't
move. Moreover, we reserve 4 bytes at H@ to write our target
and offset because otherwise, things get too complicated
with the PSP.
The output of this word is 3 numbers: top copied address,
top copied CURRENT, and then the beginning of the copied dict
at the end to indicate that we're finished processing.
Note that the last word is always skipped because it's not
possible to reliably detect its end. If you need that last
word, define a dummy word before calling RLDICT.
)
( target offset -- )
: RLDICT
( First of all, let's get our offset. It's easy, it's
target's prev field, which is already an offset, minus
its name length. We expect, in RLDICT that a target's
prev word is a "hook word", that is, an empty word. )
( H@+2 == offset )
H@ 2+ ! ( target )
( H@ == target )
H@ ! ( )
( We have our offset, now let's copy our memory chunk )
H@ @ WORD( ( src )
DUP H@ -^ ( src u )
DUP ROT SWAP ( u src u )
H@ 4 + ( u src u dst )
SWAP ( u src dst u )
MOVE ( u )
( Now, let's iterate that dict down )
( wr == wordref we == word end )
( To get our wr and we, we use H@ and CURRENT, which we
offset by u+4. +4 before, remember, we're using 4 bytes
as variable space. )
4 + ( u+4 )
DUP CURRENT @ WORD( + ( u we )
DUP .X CRLF
SWAP CURRENT @ PREV + ( we wr )
DUP .X CRLF
BEGIN ( we wr )
DUP ROT ( wr wr we )
( call RLWORD. we need a sig: ol o wr we )
H@ @ ( wr wr we ol )
H@ 2+ @ ( wr wr we ol o )
2SWAP ( wr ol o wr we )
RLWORD ( wr )
( wr becomes wr's prev and we is wr-header )
DUP ( wr wr )
PREV ( oldwr newwr )
SWAP ( wr oldwr )
WORD( ( wr we )
SWAP ( we wr )
( Are we finished? We're finished if wr-4 <= H@ )
DUP 4 - H@ <=
UNTIL
H@ 4 + .X CRLF
;
( Relink a regular Forth full interpreter. )
: RLCORE
LIT< H@ (find) DROP ( target )
DUP 3 - @ ( t prevoff )
( subtract H@ name length )
2- ( t o )
RLDICT
;

76
forth/parse.fs Normal file
View File

@ -0,0 +1,76 @@
( requires core, str )
( string being sent to parse routines are always null
terminated )
: (parsec) ( a -- n f )
( apostrophe is ASCII 39 )
DUP C@ 39 = NOT IF 0 EXIT THEN ( a 0 )
DUP 2+ C@ 39 = NOT IF 0 EXIT THEN ( a 0 )
( surrounded by apos, good, return )
1+ C@ 1 ( n 1 )
;
( returns negative value on error )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0< IF EXIT THEN ( bad )
DUP 10 < IF EXIT THEN ( good )
( 'a' is ASCII 97. 59 = 97 - 48 )
49 -
DUP 0< IF EXIT THEN ( bad )
DUP 6 < IF 10 + EXIT THEN ( good )
( bad )
255 -
;
: (parseh) ( a -- n f )
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0x" prefix )
2+
0 ( a r )
BEGIN
SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 )
_ ( r a n )
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
ROT 16 * + ( a r*16+n )
AGAIN
;
( returns negative value on error )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0< IF EXIT THEN ( bad )
DUP 2 < IF EXIT THEN ( good )
( bad )
255 -
;
: (parseb) ( a -- n f )
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0b" prefix )
2+
0 ( a r )
BEGIN
SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 1 EXIT THEN ( r 1 )
_ ( r a n )
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
ROT 2 * + ( a r*2+n )
AGAIN
;
: (parse) ( a -- n )
(parsec) IF EXIT THEN
(parseh) IF EXIT THEN
(parseb) IF EXIT THEN
(parsed) IF EXIT THEN
( nothing works )
LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
;
' (parse) (parse*) !

38
forth/print.fs Normal file
View File

@ -0,0 +1,38 @@
( Words allowing printing strings. Require core )
( This used to be in core, but some drivers providing EMIT
are much much easier to write with access to core words,
and these words below need EMIT... )
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null )
DUP NOT IF 2DROP EXIT THEN
EMIT ( a )
AGAIN
;
: ,"
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" ;
: BS 8 EMIT ;
: LF 10 EMIT ;
: CR 13 EMIT ;
: CRLF CR LF ;
: SPC 32 EMIT ;
: (wnf) (print) SPC ABORT" word not found" ;
: (ok) SPC ." ok" CRLF ;

87
forth/readln.fs Normal file
View File

@ -0,0 +1,87 @@
( requires core, parse, print )
( Managing variables in a core module is tricky. Sure, we
have (sysv), but here we need to allocate a big buffer, and
that cannot be done through (sysv). What we do is that we
allocate that buffer at runtime and use (sysv) to point to
it, a pointer that is set during the initialization
routine. )
64 CONSTANT INBUFSZ
: RDLNMEM+ 0x53 RAM+ @ + ;
( current position in INBUF )
: IN> 0 RDLNMEM+ ;
( points to INBUF )
: IN( 2 RDLNMEM+ ;
( points to INBUF's end )
: IN) INBUFSZ 2+ RDLNMEM+ ;
( flush input buffer )
( set IN> to IN( and set IN> @ to null )
: (infl) 0 IN( DUP IN> ! ! ;
( handle backspace: go back one char in IN>, if possible, then
emit SPC + BS )
: (inbs)
( already at IN( ? )
IN> @ IN( = IF EXIT THEN
IN> @ 1- IN> !
SPC BS
;
( read one char into input buffer and returns whether we
should continue, that is, whether CR was not met. )
: (rdlnc) ( -- f )
( buffer overflow? same as if we typed a newline )
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c )
( del? same as backspace )
DUP 0x7f = IF DROP 0x8 THEN
( lf? same as cr )
DUP 0x0a = IF DROP 0xd THEN
( echo back )
DUP EMIT ( c )
( bacspace? handle and exit )
DUP 0x8 = IF (inbs) EXIT THEN
( write and advance )
DUP ( keep as result ) ( c c )
( Here, 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
;
( Read one line in input buffer and make IN> point to it )
: (rdln)
(infl)
BEGIN (rdlnc) NOT UNTIL
LF IN( IN> !
;
( And finally, implement C<* )
: RDLN<
IN> @ C@
DUP IF
( not EOL? good, inc and return )
1 IN> +!
ELSE
( EOL ? readline. we still return null though )
(rdln)
THEN
( update C<? flag )
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? )
;
( Initializes the readln subsystem )
: RDLN$
( 53 == rdln's memory )
H@ 0x53 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<? )
;

17
recipes/rc2014/Makefile
View File

@ -5,9 +5,24 @@ EDIR = $(BASEDIR)/emul
STAGE2 = $(EDIR)/stage2
EMUL = $(BASEDIR)/emul/hw/rc2014/classic
PATHS = \
$(FDIR)/core.fs \
$(FDIR)/cmp.fs \
$(FDIR)/parse.fs \
$(BASEDIR)/drv/acia.fs \
$(FDIR)/print.fs \
$(FDIR)/fmt.fs \
$(FDIR)/link.fs \
run.fs
STRIPFC = $(BASEDIR)/tools/stripfc
.PHONY: all
all: $(TARGET)
$(TARGET): xcomp.fs $(STAGE2)
$(TARGET): z80c.bin $(PATHS)
cp z80c.bin $@
cat $(PATHS) | $(STRIPFC) >> $@
z80c.bin: xcomp.fs
cat xcomp.fs | $(STAGE2) > $@
$(SLATEST):

76
recipes/rc2014/README.md
View File

@ -64,10 +64,12 @@ We could have this recipe automate that 2 stage build process all automatically,
but that would rob you of all your fun, right? Instead, we'll run that 2nd
stage on the RC2014 itself!
To build your stage 1, run `make` in this folder, this will yield `stage1.bin`.
To build your stage 1, run `make` in this folder, this will yield `os.bin`.
This will contain that tiny core and, appended to it, the Forth source code it
needs to run to bootstrap itself. When it's finished bootstrapping, you will
get a prompt to a full Forth interpreter.
get a prompt to an almost-full Forth interpreter (there's not enough space in
8K to fit both link.fs and readln.fs, so we ditch readln. Our prompt is raw. No
backspace no buffer. Hardcore mode.)
### Emulate
@ -120,18 +122,15 @@ Our stage 1 prompt is the result of Forth's inner core interpreting the source
code of the Full Forth, which was appended to the binary inner core in ROM.
This results in a compiled dictionary, in RAM, at address 0x8000+system RAM.
Wouldn't it be great if we could save that compiled binary in ROM and save the
system the trouble of recompiling itself on boot?
Unfortunately, this compiled dictionary isn't usable as-is. Offsets compiled in
there are compiled based on a 0x8000-or-so base offset. What we need is a
0xa00-or-so base offset, that is, something suitable to be appended to the boot
binary, in ROM, in binary form.
Fortunately, inside the compiled source is the contents of the Linker (B120)
which will allow us to relink our compiled dictionary so that in can be
relocated in ROM, next to our boot binary. I won't go into relinking details.
Look at the source. For now, let's just use it:
Fortunately, inside the compiled source is the contents of link.fs which will
allow us to relink our compiled dictionary so that in can be relocated in ROM,
next to our boot binary. I won't go into relinking details. Look at the source.
For now, let's just use it:
RLCORE
@ -183,15 +182,9 @@ So, the end of our compiled dict is actually `99de`. Alright, let's extract it:
dd if=memdump bs=1 skip=36192 count=3198 > dict.bin
`36192` is `8d60` and `3198` is `99de-8d60`. This needs to be prepended by the
boot binary. We already have `stage1.bin`, but this binary contains bootstrap
source code we don't need any more. To strip it, we'll need to `dd` it out to
`LATEST`, in my case `098b`:
boot binary. But that one, we already have. It's `z80c.bin`
dd if=stage1.bin bs=1 count=2443 > s1pre.bin
Now we can combine our binaries:
cat s1pre.bin dict.bin > stage2.bin
cat z80c.bin dict.bin > stage2.bin
Is it ready to run yet? no. There are 3 adjustments we need to manually make
using our hex editor.
@ -209,12 +202,7 @@ using our hex editor.
Now are we ready yet? ALMOST! There's one last thing we need to do: add runtime
source. In our case, because we have a compiled dict, the only source we need
to include is initialization code. We've stripped it from our stage1 earlier,
we need to re-add it.
Look at `xcomp.fs`. You see that `," bla bla bla"` line? That's initialization
code. Copy it to a file like `run.fs` (without the `,"`) and build your final
binary:
to include is `run.fs`:
cat stage2.bin run.fs > stage2r.bin
@ -224,6 +212,48 @@ That's it! our binary is ready to run!
And there you have it, a stage2 binary that you've assembled yourself.
### Assembling stage 3
Stage 2 gives you a useable prompt, but bare. Because 8K isn't a lot of space
to cram source code, we're limited in what we can include for this stage.
However, now that we have a usable prompt, we can do a lot (be cautious though:
there is no `readln` yet, so you have no backspace), for example, build a
stage 3 with `readln`.
Copy the unit's source
cat ../../forth/readln.fs | ../../tools/stripfc | xclip
and just paste it in your terminal. If you're doing the real thing and not
using the emulator, pasting so much code at once might freeze up the RC2014, so
it is recommended that you use `/tools/exec` that let the other side enough
time to breathe.
After your pasting, you'll have a compiled dict of that code in memory. You'll
need to relocate it in the same way you did for stage 2, but instead of using
`RLCORE`, which is a convenience word hardcoded for stage 1, we'll parametrize
`RLDICT`, the word doing the real work.
`RLDICT` takes 2 arguments, `target` and `offset`. `target` is the first word
of your relocated dict. In our case, it's going to be `' INBUFSZ`. `offset` is
the offset we'll apply to every eligible word references in our dict. In our
case, that offset is the offset of the *beginning* of the `INBUFSZ` entry (that
is, `' INBUFSZ WORD(` minus the offset of the last word (which should be a hook
word) in the ROM binary.
That offset can be conveniently fetched from code because it is the value of
the `LATEST` constant in stable ABI, which is at offset `0x08`. Therefore, our
offset value is:
' INBUFSZ WORD( 0x08 @ -
You can now run `RLDICT` and proceed with concatenation (and manual adjustments
of course) as you did with stage 2. Don't forget to adjust `run.fs` so that it
initializes `RDLN$` instead of creating a minimal `(c<)`.
Keep that `stage3.bin` around, you will need it for further recipes.
[rc2014]: https://rc2014.co.uk
[romwrite]: https://github.com/hsoft/romwrite
[stage2]: ../../emul

45
recipes/rc2014/eeprom/README.md
View File

@ -8,7 +8,7 @@ itself.
## Gathering parts
* A RC2014 Classic
* `stage2.bin` from the base recipe
* `stage3.bin` from the base recipe
* An extra AT28C64B
* 1x 40106 inverter gates
* Proto board, RC2014 header pins, wires, IC sockets, etc.
@ -33,46 +33,11 @@ in write protection mode, but I preferred building my own module.
I don't think you need a schematic. It's really simple.
### Assembling stage 3
## Building your stage 4
Stage 2 gives you a full interpreter, but it's missing the "Addressed devices"
module and the AT28 driver. We'll need to assemble a stage 3.
When you'll have a system with function disk block system, you'll be able to
directly `LOAD` them, but for this recipe, we can't assume you have, so what
you'll have to do is to manually paste the code from the appropriate blocks.
Addressed devices are at B140. To know what you have to paste, open the loader
block (B142) and see what blocks it loads. For each of the blocks, copy/paste
the code in your interpreter.
Do the same thing with the AT28 driver (B150)
If you're doing the real thing and not using the emulator, pasting so much code
at once might freeze up the RC2014, so it is recommended that you use
`/tools/exec` that let the other side enough time to breathe.
After your pasting, you'll have a compiled dict of that code in memory. You'll
need to relocate it in the same way you did for stage 2, but instead of using
`RLCORE`, which is a convenience word hardcoded for stage 1, we'll parametrize
`RLDICT`, the word doing the real work.
`RLDICT` takes 2 arguments, `target` and `offset`. `target` is the first word
of your relocated dict. In our case, it's going to be `' ADEVMEM+`. `offset` is
the offset we'll apply to every eligible word references in our dict. In our
case, that offset is the offset of the *beginning* of the `ADEVMEM+` entry (that
is, `' ADEVMEM+ WORD(` minus the offset of the last word (which should be a hook
word) in the ROM binary.
That offset can be conveniently fetched from code because it is the value of
the `LATEST` constant in stable ABI, which is at offset `0x08`. Therefore, our
offset value is:
' ADEVMEM+ WORD( 0x08 @ -
You can now run `RLDICT` and proceed with concatenation (and manual adjustments
of course) as you did with stage 2. Don't forget to adjust `run.fs` so that it
runs `ADEV$`.
Using the same technique as you used for building your stage 3, you can append
required words to your boot binary. Required units are `forth/adev.fs` and
`drv/at28.fs`.
## Writing contents to the AT28

2
recipes/rc2014/run.fs Normal file
View File

@ -0,0 +1,2 @@
: x KEY DUP EMIT ;
: _ ACIA$ (ok) ['] x 0x0c RAM+ ! ; _

16
recipes/rc2014/sdcard/README.md
View File

@ -19,7 +19,7 @@ design.
## Gathering parts
* A RC2014 Classic
* `stage2.bin` from the base recipe
* `stage3.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,20 +69,20 @@ 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 stage 4
Using the same technique as you used in the `eeprom` recipe, you can append
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.
Using the same technique as you used for building your stage 3, you can append
required words to your boot binary. Required units are `forth/blk.fs` and
`drv/sdc.fs`. You also need `drv/sdc.z80` 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
The RC2014 emulator includes SDC emulation. You can attach a SD card image to
it by invoking it with a second argument:
../../../emul/hw/rc2014/classic stage3.bin ../../../emul/blkfs
../../../emul/hw/rc2014/classic stage4.bin ../../../emul/blkfs
You will then run with a SD card having the contents from `/blk`.

59
recipes/rc2014/selfhost/README.md
View File

@ -6,60 +6,31 @@ either for another RC2014 or for an OS upgrade.
## Gathering parts
* stage3 from `sdcard` recipe. If you want to write to EEPROM as the final step,
you'll need a hybrid stage3 that also includes stuff from the `eeprom` recipe.
* stage4 from `sdcard` recipe. If you want to write to EEPROM as the final step,
you'll need a hybrid stage4 that also includes stuff from the `eeprom` recipe.
## Building stage 1
Build Collapse OS' stage 1 from within Collapse OS is very similar to how we do
it from the makefile. If you take the time to look at the base recipe
`Makefile`, you'll see `cat xcomp.fs | $(STAGE2)`. That's the thing. Open
### Part 1
Building the first part of stage 1 (the binary part, before the inlined-source
part) from within Collapse OS is actually very similar from building it from a
modern environment. If you take the time to look at the base recipe `Makefile`,
you'll see `cat xcomp.fs | $(STAGE2)`. That command builds part 1. Open
`xcomp.fs` in a text editor and take a look at it.
To assemble stage 1 from RC2014, all you need to do is to type those commands
in the same order, and replace the `H@ 256 /MOD 2 PC! 2 PC!` lines with `H@ .X`.
Those commands will inform you of the begin/end offsets of the assembled binary.
I'm not going to explain in detail what each command do, but only give you an
overview of what is happening. You are encouraged to read the in-system
documentation for more information.
The meaning of these commands is not explained here. You are encouraged to read
the in-system documentation for more information.
The first part is configuration of your new system. When RAM starts, where RSP
starts, what ports to use for what device, etc. These configuration declarations
are expected in the boot code and driver code.
Then, we load the Z80 assembler and the cross compiler (xcomp for short), which
we'll of course need for the task ahead.
Then come xcomp overrides, which are needed for xcomp to be effective.
At this point, we're about to begin spitting binary content, so we want to know
where we're at. That's why you'll need to type `H@ .X` and write down the
result. That's the starting offset.
Then, we assemble the boot binary, drivers' native words, then inner core,
close the binary with a hook word. We're finished with cross-compiling.
We're at the offset that will be `CURRENT` on boot, so we update `LATEST`.
Then, we spit the course code that will be interpreted by stage 1 on boot so
that it bootstraps itself to a full interpreter. Not all units are there
because they don't fit in 8K, but they're sufficient for our needs. We also
need the linker so that we can relink ourselves to stage 2.
Finally, we have initialization code, then a spit of the ending offset.
Go ahead, run that. However, one thing you should know is that because the SD
card driver is a bit slow, some of these commands take a long time. Multiple
minutes. Be patient.
However, one thing you should know is that because the SD card driver is a bit
slow, some of these commands take a long time. Multiple minutes. Be patient.
Once all your commands are run and that you have your begin/end offset (write
them down somewhere), you're at the same point as you were after the `make`
part of the base recipe. The contents between your start and end offset is the
exact same as the contents of `stage1.bin` when you run `make`. Continue your
deployment from there.
Good luck!
them down somewhere), you're ready to assemble part 2.
### What to do on SDerr?
@ -77,3 +48,7 @@ You're looking at the offset of the last wordref of the *previous* LOAD
operation. That offset is going in `XCURRENT`. Then, you're looking at the end
of that word. That offset goes in `HERE`. Once you've done that, relaunch your
LOAD.
### Part 2
TODO

7
recipes/rc2014/xcomp.fs
View File

@ -24,11 +24,4 @@ H@ XOFF !
(entry) _
( Update LATEST )
H@ XOFF @ - XOFF @ 8 + !
422 441 XPACKR ( core cmp )
446 452 XPACKR ( parse )
358 360 XPACKR ( acia.fs )
442 445 XPACKR ( print )
453 463 XPACKR ( readln fmt )
123 132 XPACKR ( linker )
," : _ ACIA$ RDLN$ (ok) ; _ "
H@ 256 /MOD 2 PC! 2 PC!

4
tools/Makefile
View File

@ -4,12 +4,13 @@ UPLOAD_TGT = upload
FONTCOMPILE_TGT = fontcompile
TTYSAFE_TGT = ttysafe
PINGPONG_TGT = pingpong
STRIPFC_TGT = stripfc
BIN2C_TGT = bin2c
EXEC_TGT = exec
BLKPACK_TGT = blkpack
BLKUNPACK_TGT = blkunpack
TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
$(TTYSAFE_TGT) $(PINGPONG_TGT) \
$(TTYSAFE_TGT) $(PINGPONG_TGT) $(STRIPFC_TGT) \
$(BIN2C_TGT) $(EXEC_TGT) $(BLKPACK_TGT) $(BLKUNPACK_TGT)
OBJS = common.o
@ -25,6 +26,7 @@ $(UPLOAD_TGT): $(UPLOAD_TGT).c
$(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
$(PINGPONG_TGT): $(PINGPONG_TGT).c
$(STRIPFC_TGT): $(STRIPFC_TGT).c
$(BIN2C_TGT): $(BIN2C_TGT).c
$(EXEC_TGT): $(EXEC_TGT).c
$(BLKPACK_TGT): $(BLKPACK_TGT).c

57
tools/stripfc.c Normal file
View File

@ -0,0 +1,57 @@
#include <stdio.h>
/* read stdin and strip Forth-style comments before spitting in stdout. This
also deduplicate spaces and newlines.
THIS PARSING IS IMPERFECT. Only a Forth interpreter can reliably detect
comments. For example, a naive parser misinterprets the "(" word definition as
a comment.
We work around this by considering as a comment opener only "(" chars preceeded
by more than once space or by a newline. Hackish, but works.
*/
int main()
{
int spccnt = 1; // if the first char is a (, consider it a comment opener.
int incomment = 0;
int c;
c = getchar();
while ( c != EOF ) {
if (c == '\n') {
if (!incomment) {
// We still spit newlines whenever we see them, Forth interpreter
// doesn't like when they're not there...
putchar(c);
}
spccnt += 1;
} else if (c == ' ') {
spccnt++;
} else {
if (incomment) {
if ((c == ')') && spccnt) {
incomment = 0;
}
} else {
if ((c == '(') && spccnt) {
putchar(' ');
spccnt = 0;
int next = getchar();
if (next <= ' ') {
incomment = 1;
continue;
}
putchar(c);
c = next;
}
if (spccnt) {
putchar(' ');
}
putchar(c);
}
spccnt = 0;
}
c = getchar();
}
return 0;
}