mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 06:20:55 +11:00
Compare commits
6 Commits
a2f164ecc3
...
6c51ea1ebb
Author | SHA1 | Date | |
---|---|---|---|
|
6c51ea1ebb | ||
|
f690cb2e5b | ||
|
865f4f9256 | ||
|
7c692c1111 | ||
|
dee7eea497 | ||
|
4d8574c1fe |
3
blk/001
3
blk/001
@ -2,6 +2,8 @@ MASTER INDEX
|
|||||||
|
|
||||||
3 Usage 30 Dictionary
|
3 Usage 30 Dictionary
|
||||||
70 Implementation notes 100 Block editor
|
70 Implementation notes 100 Block editor
|
||||||
|
120 Linker 140 Addressed devices
|
||||||
|
150 AT28 Driver
|
||||||
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 Inner core
|
370 SD Card driver 390 Inner core
|
||||||
@ -13,4 +15,3 @@ MASTER INDEX
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
16
blk/120
Normal file
16
blk/120
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
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
Normal file
8
blk/121
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
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"
|
15
blk/123
Normal file
15
blk/123
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
( 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
Normal file
11
blk/124
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
( 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
Normal file
16
blk/125
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
: 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
Normal file
15
blk/126
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
( 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
Normal file
16
blk/127
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
: 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
Normal file
16
blk/128
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
( 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
Normal file
16
blk/130
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
( 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
Normal file
16
blk/131
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
: 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
Normal file
9
blk/132
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
( 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
Normal file
10
blk/140
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
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"
|
15
blk/143
Normal file
15
blk/143
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
: 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
Normal file
11
blk/144
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
( 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
Normal file
6
blk/150
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
AT28 Driver
|
||||||
|
|
||||||
|
Write to an AT28 EEPROM while making sure that proper timing
|
||||||
|
is followed and verify data integrity.
|
||||||
|
|
||||||
|
Load with "151 LOAD"
|
@ -1,9 +1,7 @@
|
|||||||
( With dst being assumed to be an AT28 EEPROM, perform !
|
( With dst being assumed to be an AT28 EEPROM, perform !
|
||||||
operation while doing the right thing. Checks data integrity
|
operation while doing the right thing. Checks data integrity
|
||||||
and ABORT on mismatch.
|
and ABORT on mismatch. )
|
||||||
)
|
: AT28! ( n a -- )
|
||||||
( n a -- )
|
|
||||||
: AT28!
|
|
||||||
2DUP C!
|
2DUP C!
|
||||||
( as long as writing operation is running, IO/6 will toggle at each
|
( 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
|
read attempt. We know that write is finished when we read the same
|
13
blk/357
13
blk/357
@ -1,14 +1 @@
|
|||||||
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
|
358 360 LOADR
|
||||||
|
29
blk/358
29
blk/358
@ -1,16 +1,13 @@
|
|||||||
: ACIA$
|
0x20 CONSTANT ACIABUFSZ
|
||||||
H@ DUP DUP ACIA( ! ACIAR> !
|
|
||||||
1+ ACIAW> ! ( write index starts one position later )
|
( Points to ACIA buf )
|
||||||
ACIABUFSZ ALLOT
|
: ACIA( [ ACIA_MEM 4 + LITN ] ;
|
||||||
H@ ACIA) !
|
( Points to ACIA buf end )
|
||||||
( setup ACIA
|
: ACIA) [ ACIA_MEM 6 + LITN ] ;
|
||||||
CR7 (1) - Receive Interrupt enabled
|
( Read buf pointer. Pre-inc )
|
||||||
CR6:5 (00) - RTS low, transmit interrupt disabled.
|
: ACIAR> [ ACIA_MEM LITN ] ;
|
||||||
CR4:2 (101) - 8 bits + 1 stop bit
|
( Write buf pointer. Post-inc )
|
||||||
CR1:0 (10) - Counter divide: 64 )
|
: ACIAW> [ ACIA_MEM 2 + LITN ] ;
|
||||||
0b10010110 ACIA_CTL PC!
|
( This means that if W> == R>, buffer is full.
|
||||||
( setup interrupt )
|
If R>+1 == W>, buffer is empty. )
|
||||||
0xc3 0x4e RAM+ C! ( c3==JP, 4e==INTJUMP )
|
|
||||||
['] ~ACIA 0x4f RAM+ !
|
|
||||||
(im1)
|
|
||||||
;
|
|
||||||
|
28
blk/359
28
blk/359
@ -1,14 +1,16 @@
|
|||||||
: KEY
|
: ACIA$
|
||||||
( inc then fetch )
|
H@ DUP DUP ACIA( ! ACIAR> !
|
||||||
ACIAR> @ 1+ DUP ACIA) @ = IF
|
1+ ACIAW> ! ( write index starts one position later )
|
||||||
DROP ACIA( @
|
ACIABUFSZ ALLOT
|
||||||
THEN
|
H@ ACIA) !
|
||||||
|
( setup ACIA
|
||||||
( As long as R> == W>-1, it means that buffer is empty )
|
CR7 (1) - Receive Interrupt enabled
|
||||||
BEGIN DUP ACIAW> @ = NOT UNTIL
|
CR6:5 (00) - RTS low, transmit interrupt disabled.
|
||||||
|
CR4:2 (101) - 8 bits + 1 stop bit
|
||||||
ACIAR> !
|
CR1:0 (10) - Counter divide: 64 )
|
||||||
ACIAR> @ C@
|
0b10010110 ACIA_CTL PC!
|
||||||
|
( setup interrupt )
|
||||||
|
0xc3 0x4e RAM+ C! ( c3==JP, 4e==INTJUMP )
|
||||||
|
['] ~ACIA 0x4f RAM+ !
|
||||||
|
(im1)
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
||||||
|
11
blk/360
11
blk/360
@ -1,7 +1,16 @@
|
|||||||
|
: 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
|
: EMIT
|
||||||
( As long at CTL bit 1 is low, we are transmitting. wait )
|
( As long at CTL bit 1 is low, we are transmitting. wait )
|
||||||
BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
|
BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
|
||||||
( The way is clear, go! )
|
( The way is clear, go! )
|
||||||
ACIA_IO PC!
|
ACIA_IO PC!
|
||||||
;
|
;
|
||||||
|
|
||||||
|
69
drv/acia.fs
69
drv/acia.fs
@ -1,69 +0,0 @@
|
|||||||
( 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!
|
|
||||||
;
|
|
||||||
|
|
215
drv/sdc.fs
215
drv/sdc.fs
@ -1,215 +0,0 @@
|
|||||||
( -- 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
3
emul/.gitignore
vendored
@ -3,6 +3,5 @@
|
|||||||
/stage2
|
/stage2
|
||||||
/forth
|
/forth
|
||||||
/*-bin.h
|
/*-bin.h
|
||||||
/core.bin
|
/stage1.bin
|
||||||
/forth?.bin
|
|
||||||
/blkfs
|
/blkfs
|
||||||
|
@ -1,7 +0,0 @@
|
|||||||
# 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.
|
|
@ -1,34 +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.
|
|
||||||
)
|
|
||||||
|
|
||||||
: 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
95
forth/blk.fs
@ -1,95 +0,0 @@
|
|||||||
( 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
42
forth/cmp.fs
@ -1,42 +0,0 @@
|
|||||||
( 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
203
forth/core.fs
@ -1,203 +0,0 @@
|
|||||||
: 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
73
forth/fmt.fs
@ -1,73 +0,0 @@
|
|||||||
( 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
185
forth/link.fs
@ -1,185 +0,0 @@
|
|||||||
( 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
|
|
||||||
;
|
|
@ -1,76 +0,0 @@
|
|||||||
( 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*) !
|
|
@ -1,38 +0,0 @@
|
|||||||
( 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 ;
|
|
@ -1,87 +0,0 @@
|
|||||||
( 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<? )
|
|
||||||
;
|
|
||||||
|
|
@ -5,24 +5,9 @@ EDIR = $(BASEDIR)/emul
|
|||||||
STAGE2 = $(EDIR)/stage2
|
STAGE2 = $(EDIR)/stage2
|
||||||
EMUL = $(BASEDIR)/emul/hw/rc2014/classic
|
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
|
.PHONY: all
|
||||||
all: $(TARGET)
|
all: $(TARGET)
|
||||||
$(TARGET): z80c.bin $(PATHS)
|
$(TARGET): xcomp.fs $(STAGE2)
|
||||||
cp z80c.bin $@
|
|
||||||
cat $(PATHS) | $(STRIPFC) >> $@
|
|
||||||
|
|
||||||
z80c.bin: xcomp.fs
|
|
||||||
cat xcomp.fs | $(STAGE2) > $@
|
cat xcomp.fs | $(STAGE2) > $@
|
||||||
|
|
||||||
$(SLATEST):
|
$(SLATEST):
|
||||||
|
@ -64,12 +64,10 @@ 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
|
but that would rob you of all your fun, right? Instead, we'll run that 2nd
|
||||||
stage on the RC2014 itself!
|
stage on the RC2014 itself!
|
||||||
|
|
||||||
To build your stage 1, run `make` in this folder, this will yield `os.bin`.
|
To build your stage 1, run `make` in this folder, this will yield `stage1.bin`.
|
||||||
This will contain that tiny core and, appended to it, the Forth source code it
|
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
|
needs to run to bootstrap itself. When it's finished bootstrapping, you will
|
||||||
get a prompt to an almost-full Forth interpreter (there's not enough space in
|
get a prompt to a full Forth interpreter.
|
||||||
8K to fit both link.fs and readln.fs, so we ditch readln. Our prompt is raw. No
|
|
||||||
backspace no buffer. Hardcore mode.)
|
|
||||||
|
|
||||||
### Emulate
|
### Emulate
|
||||||
|
|
||||||
@ -122,15 +120,18 @@ 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.
|
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.
|
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
|
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
|
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
|
0xa00-or-so base offset, that is, something suitable to be appended to the boot
|
||||||
binary, in ROM, in binary form.
|
binary, in ROM, in binary form.
|
||||||
|
|
||||||
Fortunately, inside the compiled source is the contents of link.fs which will
|
Fortunately, inside the compiled source is the contents of the Linker (B120)
|
||||||
allow us to relink our compiled dictionary so that in can be relocated in ROM,
|
which will allow us to relink our compiled dictionary so that in can be
|
||||||
next to our boot binary. I won't go into relinking details. Look at the source.
|
relocated in ROM, next to our boot binary. I won't go into relinking details.
|
||||||
For now, let's just use it:
|
Look at the source. For now, let's just use it:
|
||||||
|
|
||||||
RLCORE
|
RLCORE
|
||||||
|
|
||||||
@ -182,9 +183,15 @@ 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
|
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
|
`36192` is `8d60` and `3198` is `99de-8d60`. This needs to be prepended by the
|
||||||
boot binary. But that one, we already have. It's `z80c.bin`
|
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`:
|
||||||
|
|
||||||
cat z80c.bin dict.bin > stage2.bin
|
dd if=stage1.bin bs=1 count=2443 > s1pre.bin
|
||||||
|
|
||||||
|
Now we can combine our binaries:
|
||||||
|
|
||||||
|
cat s1pre.bin dict.bin > stage2.bin
|
||||||
|
|
||||||
Is it ready to run yet? no. There are 3 adjustments we need to manually make
|
Is it ready to run yet? no. There are 3 adjustments we need to manually make
|
||||||
using our hex editor.
|
using our hex editor.
|
||||||
@ -202,7 +209,12 @@ using our hex editor.
|
|||||||
|
|
||||||
Now are we ready yet? ALMOST! There's one last thing we need to do: add runtime
|
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
|
source. In our case, because we have a compiled dict, the only source we need
|
||||||
to include is `run.fs`:
|
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:
|
||||||
|
|
||||||
cat stage2.bin run.fs > stage2r.bin
|
cat stage2.bin run.fs > stage2r.bin
|
||||||
|
|
||||||
@ -212,48 +224,6 @@ That's it! our binary is ready to run!
|
|||||||
|
|
||||||
And there you have it, a stage2 binary that you've assembled yourself.
|
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
|
[rc2014]: https://rc2014.co.uk
|
||||||
[romwrite]: https://github.com/hsoft/romwrite
|
[romwrite]: https://github.com/hsoft/romwrite
|
||||||
[stage2]: ../../emul
|
[stage2]: ../../emul
|
||||||
|
@ -8,7 +8,7 @@ itself.
|
|||||||
## Gathering parts
|
## Gathering parts
|
||||||
|
|
||||||
* A RC2014 Classic
|
* A RC2014 Classic
|
||||||
* `stage3.bin` from the base recipe
|
* `stage2.bin` from the base recipe
|
||||||
* An extra AT28C64B
|
* An extra AT28C64B
|
||||||
* 1x 40106 inverter gates
|
* 1x 40106 inverter gates
|
||||||
* Proto board, RC2014 header pins, wires, IC sockets, etc.
|
* Proto board, RC2014 header pins, wires, IC sockets, etc.
|
||||||
@ -33,11 +33,46 @@ in write protection mode, but I preferred building my own module.
|
|||||||
|
|
||||||
I don't think you need a schematic. It's really simple.
|
I don't think you need a schematic. It's really simple.
|
||||||
|
|
||||||
## Building your stage 4
|
### Assembling stage 3
|
||||||
|
|
||||||
Using the same technique as you used for building your stage 3, you can append
|
Stage 2 gives you a full interpreter, but it's missing the "Addressed devices"
|
||||||
required words to your boot binary. Required units are `forth/adev.fs` and
|
module and the AT28 driver. We'll need to assemble a stage 3.
|
||||||
`drv/at28.fs`.
|
|
||||||
|
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$`.
|
||||||
|
|
||||||
## Writing contents to the AT28
|
## Writing contents to the AT28
|
||||||
|
|
||||||
|
@ -1,2 +0,0 @@
|
|||||||
: x KEY DUP EMIT ;
|
|
||||||
: _ ACIA$ (ok) ['] x 0x0c RAM+ ! ; _
|
|
@ -19,7 +19,7 @@ design.
|
|||||||
## Gathering parts
|
## Gathering parts
|
||||||
|
|
||||||
* A RC2014 Classic
|
* A RC2014 Classic
|
||||||
* `stage3.bin` from the base recipe
|
* `stage2.bin` from the base recipe
|
||||||
* A MicroSD breakout board. I use Adafruit's.
|
* A MicroSD breakout board. I use Adafruit's.
|
||||||
* A proto board + header pins with 39 positions so we can make a RC2014 card.
|
* A proto board + header pins with 39 positions so we can make a RC2014 card.
|
||||||
* Diodes, resistors and stuff
|
* Diodes, resistors and stuff
|
||||||
@ -69,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
|
own schematic with regards to the `M1` and `A2` lines and use two inverters
|
||||||
instead.
|
instead.
|
||||||
|
|
||||||
## Building your stage 4
|
## Building your stage 3
|
||||||
|
|
||||||
Using the same technique as you used for building your stage 3, you can append
|
Using the same technique as you used in the `eeprom` recipe, you can append
|
||||||
required words to your boot binary. Required units are `forth/blk.fs` and
|
required words to your boot binary. Required units `blk` (B464) and the SD Card
|
||||||
`drv/sdc.fs`. You also need `drv/sdc.z80` but to save you the troubles of
|
driver (B370). You only need the Forth part. You of course actually need
|
||||||
rebuilding from stage 1 for this recipe, we took the liberty of already having
|
Z80 SDC words but to save you the troubles of rebuilding from stage 1 for this
|
||||||
included it in the base recipe.
|
recipe, we took the liberty of already having included it in the base recipe.
|
||||||
|
|
||||||
## Testing in the emulator
|
## Testing in the emulator
|
||||||
|
|
||||||
The RC2014 emulator includes SDC emulation. You can attach a SD card image to
|
The RC2014 emulator includes SDC emulation. You can attach a SD card image to
|
||||||
it by invoking it with a second argument:
|
it by invoking it with a second argument:
|
||||||
|
|
||||||
../../../emul/hw/rc2014/classic stage4.bin ../../../emul/blkfs
|
../../../emul/hw/rc2014/classic stage3.bin ../../../emul/blkfs
|
||||||
|
|
||||||
You will then run with a SD card having the contents from `/blk`.
|
You will then run with a SD card having the contents from `/blk`.
|
||||||
|
|
||||||
|
@ -6,31 +6,60 @@ either for another RC2014 or for an OS upgrade.
|
|||||||
|
|
||||||
## Gathering parts
|
## Gathering parts
|
||||||
|
|
||||||
* stage4 from `sdcard` recipe. If you want to write to EEPROM as the final step,
|
* stage3 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.
|
you'll need a hybrid stage3 that also includes stuff from the `eeprom` recipe.
|
||||||
|
|
||||||
## Building stage 1
|
## Building stage 1
|
||||||
|
|
||||||
### Part 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
|
||||||
Building the first part of stage 1 (the binary part, before the inlined-source
|
`Makefile`, you'll see `cat xcomp.fs | $(STAGE2)`. That's the thing. Open
|
||||||
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.
|
`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
|
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`.
|
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.
|
Those commands will inform you of the begin/end offsets of the assembled binary.
|
||||||
|
|
||||||
The meaning of these commands is not explained here. You are encouraged to read
|
I'm not going to explain in detail what each command do, but only give you an
|
||||||
the in-system documentation for more information.
|
overview of what is happening. You are encouraged to read the in-system
|
||||||
|
documentation for more information.
|
||||||
|
|
||||||
However, one thing you should know is that because the SD card driver is a bit
|
The first part is configuration of your new system. When RAM starts, where RSP
|
||||||
slow, some of these commands take a long time. Multiple minutes. Be patient.
|
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.
|
||||||
|
|
||||||
Once all your commands are run and that you have your begin/end offset (write
|
Once all your commands are run and that you have your begin/end offset (write
|
||||||
them down somewhere), you're ready to assemble part 2.
|
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!
|
||||||
|
|
||||||
### What to do on SDerr?
|
### What to do on SDerr?
|
||||||
|
|
||||||
@ -48,7 +77,3 @@ 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
|
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
|
of that word. That offset goes in `HERE`. Once you've done that, relaunch your
|
||||||
LOAD.
|
LOAD.
|
||||||
|
|
||||||
### Part 2
|
|
||||||
|
|
||||||
TODO
|
|
||||||
|
@ -24,4 +24,11 @@ H@ XOFF !
|
|||||||
(entry) _
|
(entry) _
|
||||||
( Update LATEST )
|
( Update LATEST )
|
||||||
H@ XOFF @ - XOFF @ 8 + !
|
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!
|
H@ 256 /MOD 2 PC! 2 PC!
|
||||||
|
@ -4,13 +4,12 @@ UPLOAD_TGT = upload
|
|||||||
FONTCOMPILE_TGT = fontcompile
|
FONTCOMPILE_TGT = fontcompile
|
||||||
TTYSAFE_TGT = ttysafe
|
TTYSAFE_TGT = ttysafe
|
||||||
PINGPONG_TGT = pingpong
|
PINGPONG_TGT = pingpong
|
||||||
STRIPFC_TGT = stripfc
|
|
||||||
BIN2C_TGT = bin2c
|
BIN2C_TGT = bin2c
|
||||||
EXEC_TGT = exec
|
EXEC_TGT = exec
|
||||||
BLKPACK_TGT = blkpack
|
BLKPACK_TGT = blkpack
|
||||||
BLKUNPACK_TGT = blkunpack
|
BLKUNPACK_TGT = blkunpack
|
||||||
TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
|
TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
|
||||||
$(TTYSAFE_TGT) $(PINGPONG_TGT) $(STRIPFC_TGT) \
|
$(TTYSAFE_TGT) $(PINGPONG_TGT) \
|
||||||
$(BIN2C_TGT) $(EXEC_TGT) $(BLKPACK_TGT) $(BLKUNPACK_TGT)
|
$(BIN2C_TGT) $(EXEC_TGT) $(BLKPACK_TGT) $(BLKUNPACK_TGT)
|
||||||
OBJS = common.o
|
OBJS = common.o
|
||||||
|
|
||||||
@ -26,7 +25,6 @@ $(UPLOAD_TGT): $(UPLOAD_TGT).c
|
|||||||
$(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
|
$(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
|
||||||
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
|
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
|
||||||
$(PINGPONG_TGT): $(PINGPONG_TGT).c
|
$(PINGPONG_TGT): $(PINGPONG_TGT).c
|
||||||
$(STRIPFC_TGT): $(STRIPFC_TGT).c
|
|
||||||
$(BIN2C_TGT): $(BIN2C_TGT).c
|
$(BIN2C_TGT): $(BIN2C_TGT).c
|
||||||
$(EXEC_TGT): $(EXEC_TGT).c
|
$(EXEC_TGT): $(EXEC_TGT).c
|
||||||
$(BLKPACK_TGT): $(BLKPACK_TGT).c
|
$(BLKPACK_TGT): $(BLKPACK_TGT).c
|
||||||
|
@ -1,57 +0,0 @@
|
|||||||
#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;
|
|
||||||
}
|
|
Loading…
Reference in New Issue
Block a user