mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +11:00
Compare commits
No commits in common. "44403c3d4c4557ab72ee2d0a2c9607452540dd9a" and "fcd77f80ab4d3d690fd0d6f21afa17d86e2dbd3b" have entirely different histories.
44403c3d4c
...
fcd77f80ab
4
blk/001
4
blk/001
@ -3,8 +3,8 @@ MASTER INDEX
|
|||||||
3 Usage 30 Dictionary
|
3 Usage 30 Dictionary
|
||||||
70 Implementation notes 100 Block editor
|
70 Implementation notes 100 Block editor
|
||||||
200 Z80 assembler 260 Cross compilation
|
200 Z80 assembler 260 Cross compilation
|
||||||
280 Z80 boot code 350 ACIA driver
|
280 Z80 boot code
|
||||||
370 SD Card driver 390 Inner core
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
15
blk/350
15
blk/350
@ -1,15 +0,0 @@
|
|||||||
ACIA driver
|
|
||||||
|
|
||||||
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.
|
|
||||||
|
|
||||||
Load z80 words with "352 LOAD" and Forth words with "357 LOAD".
|
|
||||||
15
blk/352
15
blk/352
@ -1,15 +0,0 @@
|
|||||||
( Save ACIA conf )
|
|
||||||
ACIA_CTL
|
|
||||||
: ACIA_CTL [ LITN ] ;
|
|
||||||
ACIA_IO
|
|
||||||
: ACIA_IO [ LITN ] ;
|
|
||||||
ACIA_MEM
|
|
||||||
: ACIA_MEM [ LITN ] ;
|
|
||||||
( Memory layout
|
|
||||||
+0 ACIAR>
|
|
||||||
+2 ACIAW>
|
|
||||||
+4 ACIA(
|
|
||||||
+6 ACIA) )
|
|
||||||
|
|
||||||
353 356 LOADR
|
|
||||||
|
|
||||||
16
blk/353
16
blk/353
@ -1,16 +0,0 @@
|
|||||||
(entry) ~ACIA
|
|
||||||
AF PUSHqq,
|
|
||||||
HL PUSHqq,
|
|
||||||
DE PUSHqq,
|
|
||||||
( Read our character from ACIA into our BUFIDX )
|
|
||||||
ACIA_CTL INAn,
|
|
||||||
0x01 ANDn, ( is ACIA rcv buf full? )
|
|
||||||
IFNZ,
|
|
||||||
( correct interrupt cause )
|
|
||||||
( +2 == ACIAW> )
|
|
||||||
ACIA_MEM 2+ LDHL(nn),
|
|
||||||
( is it == to ACIAR>? )
|
|
||||||
( +0 == ACIAR> )
|
|
||||||
DE ACIA_MEM LDdd(nn),
|
|
||||||
( carry cleared from ANDn above )
|
|
||||||
DE SBCHLss, ( cont. )
|
|
||||||
16
blk/354
16
blk/354
@ -1,16 +0,0 @@
|
|||||||
IFNZ, ( buffer full? )
|
|
||||||
( no, continue )
|
|
||||||
DE ADDHLss, ( restore ACIAW> )
|
|
||||||
( buffer not full, let's write )
|
|
||||||
ACIA_IO INAn,
|
|
||||||
(HL) A LDrr,
|
|
||||||
( advance W> )
|
|
||||||
HL INCss,
|
|
||||||
( +2 == ACIAW> )
|
|
||||||
ACIA_MEM 2+ LD(nn)HL,
|
|
||||||
( +6 == ACIA) )
|
|
||||||
DE ACIA_MEM 6 + LDdd(nn),
|
|
||||||
DE SUBHLss,
|
|
||||||
|
|
||||||
|
|
||||||
( cont. )
|
|
||||||
16
blk/356
16
blk/356
@ -1,16 +0,0 @@
|
|||||||
IFZ, ( end of buffer reached? )
|
|
||||||
( yes )
|
|
||||||
( +4 == ACIA( )
|
|
||||||
ACIA_MEM 4 + LDHL(nn),
|
|
||||||
( +2 == ACIAW> )
|
|
||||||
ACIA_MEM 2+ LD(nn)HL,
|
|
||||||
THEN,
|
|
||||||
THEN,
|
|
||||||
THEN,
|
|
||||||
DE POPqq,
|
|
||||||
HL POPqq,
|
|
||||||
AF POPqq,
|
|
||||||
EI,
|
|
||||||
RETI,
|
|
||||||
|
|
||||||
|
|
||||||
14
blk/357
14
blk/357
@ -1,14 +0,0 @@
|
|||||||
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
|
|
||||||
16
blk/358
16
blk/358
@ -1,16 +0,0 @@
|
|||||||
: 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)
|
|
||||||
;
|
|
||||||
14
blk/359
14
blk/359
@ -1,14 +0,0 @@
|
|||||||
: 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@
|
|
||||||
;
|
|
||||||
|
|
||||||
|
|
||||||
7
blk/360
7
blk/360
@ -1,7 +0,0 @@
|
|||||||
: 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!
|
|
||||||
;
|
|
||||||
|
|
||||||
4
blk/370
4
blk/370
@ -1,4 +0,0 @@
|
|||||||
SD Card driver
|
|
||||||
|
|
||||||
Load the z80 part with "372 LOAD", the Forth part with
|
|
||||||
"374 LOAD".
|
|
||||||
9
blk/373
9
blk/373
@ -1,9 +0,0 @@
|
|||||||
CODE _sdcSel
|
|
||||||
SDC_CSLOW OUTnA,
|
|
||||||
;CODE
|
|
||||||
|
|
||||||
CODE _sdcDesel
|
|
||||||
SDC_CSHIGH OUTnA,
|
|
||||||
;CODE
|
|
||||||
|
|
||||||
|
|
||||||
16
blk/374
16
blk/374
@ -1,16 +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
|
|
||||||
;
|
|
||||||
375 386 LOADR
|
|
||||||
10
blk/375
10
blk/375
@ -1,10 +0,0 @@
|
|||||||
( -- )
|
|
||||||
( 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 ;
|
|
||||||
16
blk/376
16
blk/376
@ -1,16 +0,0 @@
|
|||||||
( 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
|
|
||||||
;
|
|
||||||
|
|
||||||
16
blk/377
16
blk/377
@ -1,16 +0,0 @@
|
|||||||
( 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 ;
|
|
||||||
|
|
||||||
16
blk/378
16
blk/378
@ -1,16 +0,0 @@
|
|||||||
( 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 ROT ( a2 h l crc )
|
|
||||||
_s+crc _s+crc ( a2 crc )
|
|
||||||
SWAP 256 /MOD ROT ( h l crc )
|
|
||||||
_s+crc _s+crc ( crc )
|
|
||||||
0x01 OR ( ensure stop bit )
|
|
||||||
_sdcSR DROP ( send CRC )
|
|
||||||
_wait ( wait for a valid response... )
|
|
||||||
;
|
|
||||||
16
blk/379
16
blk/379
@ -1,16 +0,0 @@
|
|||||||
( 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 * _idle + ( r arg1 )
|
|
||||||
_idle 256 * _idle + ( r arg1 arg2 )
|
|
||||||
_sdcDesel
|
|
||||||
;
|
|
||||||
|
|
||||||
16
blk/380
16
blk/380
@ -1,16 +0,0 @@
|
|||||||
: _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 0x40 0 0 SDCMDR1 ( CMD0 )
|
|
||||||
DUP 0x01 = IF LEAVE THEN
|
|
||||||
LOOP 0x01 = NOT IF _err THEN ( cont. )
|
|
||||||
10
blk/381
10
blk/381
@ -1,10 +0,0 @@
|
|||||||
( Then comes the CMD8. We send it with a 0x01aa argument and
|
|
||||||
expect a 0x01aa argument back, along with a 0x01 R1
|
|
||||||
response. )
|
|
||||||
0x48 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 )
|
|
||||||
|
|
||||||
( cont. )
|
|
||||||
13
blk/382
13
blk/382
@ -1,13 +0,0 @@
|
|||||||
( 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
|
|
||||||
0x77 0 0 SDCMDR1 ( CMD55 )
|
|
||||||
0x01 = NOT IF _err THEN
|
|
||||||
0x69 0x4000 0x0000 SDCMDR1 ( CMD41 )
|
|
||||||
DUP 0x01 > IF _err THEN
|
|
||||||
NOT UNTIL
|
|
||||||
( Out of idle mode! Success! )
|
|
||||||
;
|
|
||||||
|
|
||||||
15
blk/383
15
blk/383
@ -1,15 +0,0 @@
|
|||||||
: _sdc@ ( dstaddr blkno -- )
|
|
||||||
_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 _idle ( crc a a n )
|
|
||||||
DUP ROT C! ( crc a n )
|
|
||||||
ROT SWAP _crc16 ( a crc )
|
|
||||||
SWAP 1+ ( crc a+1 )
|
|
||||||
LOOP
|
|
||||||
DROP ( crc1 )
|
|
||||||
_idle 256 * _idle + ( crc2 )
|
|
||||||
_wait DROP _sdcDesel
|
|
||||||
= NOT IF _err THEN ;
|
|
||||||
7
blk/384
7
blk/384
@ -1,7 +0,0 @@
|
|||||||
: SDC@
|
|
||||||
2 * DUP BLK( SWAP ( b a b )
|
|
||||||
_sdc@
|
|
||||||
1+ BLK( 512 + SWAP
|
|
||||||
_sdc@
|
|
||||||
;
|
|
||||||
|
|
||||||
16
blk/385
16
blk/385
@ -1,16 +0,0 @@
|
|||||||
: _sdc! ( srcaddr blkno -- )
|
|
||||||
_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 _sdcSR DROP
|
|
||||||
_wait DROP _sdcDesel ;
|
|
||||||
7
blk/386
7
blk/386
@ -1,7 +0,0 @@
|
|||||||
: SDC!
|
|
||||||
2 * DUP BLK( SWAP ( b a b )
|
|
||||||
_sdc!
|
|
||||||
1+ BLK( 512 + SWAP
|
|
||||||
_sdc!
|
|
||||||
;
|
|
||||||
|
|
||||||
16
blk/390
16
blk/390
@ -1,16 +0,0 @@
|
|||||||
Inner core
|
|
||||||
|
|
||||||
This unit represents core definitions that happen right after
|
|
||||||
native definitions. Before core.fs.
|
|
||||||
|
|
||||||
Unlike core.fs and its followers, this unit isn't self-
|
|
||||||
sustained. Like native defs it uses the machinery of a full
|
|
||||||
Forth interpreter, notably for flow structures.
|
|
||||||
|
|
||||||
Because of that, it has to obey specific rules:
|
|
||||||
|
|
||||||
1. It cannot compile a word from higher layers. Using
|
|
||||||
immediates is fine though.
|
|
||||||
|
|
||||||
|
|
||||||
(cont.)
|
|
||||||
16
blk/391
16
blk/391
@ -1,16 +0,0 @@
|
|||||||
2. If it references a word from this unit or from native
|
|
||||||
definitions, these need to be properly offsetted because
|
|
||||||
their offset at compile time are not the same as their
|
|
||||||
runtime offsets.
|
|
||||||
3. Anything they refer to in the boot binary has to be properly
|
|
||||||
stabilized.
|
|
||||||
4. Make sure that the words you compile are not overridden by
|
|
||||||
the full interpreter.
|
|
||||||
5. When using words as immediates, make sure that they're not
|
|
||||||
defined in icore or, if they are, make sure that they are
|
|
||||||
*not* offsetted
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(cont.)
|
|
||||||
7
blk/392
7
blk/392
@ -1,7 +0,0 @@
|
|||||||
Those rules are mostly met by the "xcomp" unit, which is
|
|
||||||
expected to have been loaded prior to icore and redefines ":"
|
|
||||||
and other defining words. So, in other words, when compiling
|
|
||||||
icore, ":" doesn't means what you think it means, go look in
|
|
||||||
B260.
|
|
||||||
|
|
||||||
To load, run "393 LOAD".
|
|
||||||
15
blk/393
15
blk/393
@ -1,15 +0,0 @@
|
|||||||
: RAM+ [ RAMSTART LITN ] + ;
|
|
||||||
: FLAGS 0x08 RAM+ ;
|
|
||||||
: (parse*) 0x0a RAM+ ;
|
|
||||||
: HERE 0x04 RAM+ ;
|
|
||||||
: CURRENT* 0x51 RAM+ ;
|
|
||||||
: CURRENT CURRENT* @ ;
|
|
||||||
|
|
||||||
( w -- a f )
|
|
||||||
: (find) CURRENT @ SWAP _find ;
|
|
||||||
|
|
||||||
: QUIT
|
|
||||||
0 FLAGS ! (resRS)
|
|
||||||
LIT< INTERPRET (find) DROP EXECUTE
|
|
||||||
;
|
|
||||||
394 407 LOADR
|
|
||||||
8
blk/394
8
blk/394
@ -1,8 +0,0 @@
|
|||||||
: ABORT (resSP) QUIT ;
|
|
||||||
|
|
||||||
: = CMP NOT ;
|
|
||||||
: < CMP -1 = ;
|
|
||||||
: > CMP 1 = ;
|
|
||||||
: 0< 32767 > ;
|
|
||||||
|
|
||||||
|
|
||||||
15
blk/395
15
blk/395
@ -1,15 +0,0 @@
|
|||||||
( r c -- r f )
|
|
||||||
( Parse digit c and accumulate into result r.
|
|
||||||
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
|
||||||
-1 when c was an invalid digit. )
|
|
||||||
: _pdacc
|
|
||||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
|
||||||
( parse char )
|
|
||||||
'0' -
|
|
||||||
( if bad, return "r -1" )
|
|
||||||
DUP 0< IF DROP -1 EXIT THEN ( bad )
|
|
||||||
DUP 9 > IF DROP -1 EXIT THEN ( bad )
|
|
||||||
( good, add to running result )
|
|
||||||
SWAP 10 * + ( r*10+n )
|
|
||||||
0 ( good )
|
|
||||||
;
|
|
||||||
11
blk/396
11
blk/396
@ -1,11 +0,0 @@
|
|||||||
( parsed is tight, all comments ahead. We read the first char
|
|
||||||
outside of the loop because it *has* to be nonzero, which
|
|
||||||
means _pdacc *has* to return 0.
|
|
||||||
|
|
||||||
Then, we check for '-'. If we get it, we advance by one,
|
|
||||||
recurse and invert result.
|
|
||||||
|
|
||||||
We loop until _pdacc is nonzero, which means either WS or
|
|
||||||
non-digit. 1 means WS, which means parsing was a success.
|
|
||||||
-1 means non-digit, which means we have a non-decimal. )
|
|
||||||
|
|
||||||
16
blk/397
16
blk/397
@ -1,16 +0,0 @@
|
|||||||
: (parsed) ( a -- n f )
|
|
||||||
DUP C@ ( a c )
|
|
||||||
DUP '-' = IF
|
|
||||||
DROP 1+ ( a+1 ) (parsed) 0 ROT ( f 0 n )
|
|
||||||
- SWAP EXIT ( 0-n f )
|
|
||||||
THEN
|
|
||||||
0 SWAP _pdacc ( a r f )
|
|
||||||
DUP IF 2DROP 0 EXIT THEN
|
|
||||||
BEGIN ( a r 0 )
|
|
||||||
DROP SWAP 1+ ( r a+1 )
|
|
||||||
DUP C@ ( r a c )
|
|
||||||
ROT SWAP ( a r c )
|
|
||||||
_pdacc ( a r f )
|
|
||||||
DUP UNTIL
|
|
||||||
1 = ( a r f )
|
|
||||||
ROT DROP ( r f ) ;
|
|
||||||
11
blk/398
11
blk/398
@ -1,11 +0,0 @@
|
|||||||
( This is only the "early parser" in earlier stages. No need
|
|
||||||
for an abort message )
|
|
||||||
: (parse) (parsed) NOT IF ABORT THEN ;
|
|
||||||
|
|
||||||
: C< 0x0c RAM+ @ EXECUTE ( 0c == CINPTR ) ;
|
|
||||||
|
|
||||||
: , HERE @ ! HERE @ 2+ HERE ! ;
|
|
||||||
|
|
||||||
: C, HERE @ C! HERE @ 1+ HERE ! ;
|
|
||||||
|
|
||||||
|
|
||||||
12
blk/399
12
blk/399
@ -1,12 +0,0 @@
|
|||||||
( The NOT is to normalize the negative/positive numbers to 1
|
|
||||||
or 0. Hadn't we wanted to normalize, we'd have written:
|
|
||||||
32 CMP 1 - )
|
|
||||||
: WS? 33 CMP 1+ NOT ;
|
|
||||||
|
|
||||||
: TOWORD
|
|
||||||
BEGIN
|
|
||||||
C< DUP WS? NOT IF EXIT THEN DROP
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
||||||
|
|
||||||
16
blk/400
16
blk/400
@ -1,16 +0,0 @@
|
|||||||
( Read word from C<, copy to WORDBUF, null-terminate, and
|
|
||||||
return, make HL point to WORDBUF. )
|
|
||||||
: WORD
|
|
||||||
0x0e RAM+ ( 0e == WORDBUF )
|
|
||||||
TOWORD ( a c )
|
|
||||||
BEGIN
|
|
||||||
( We take advantage of the fact that char MSB is
|
|
||||||
always zero to pre-write our null-termination )
|
|
||||||
OVER ! 1+ ( a+1 )
|
|
||||||
C< ( a c )
|
|
||||||
DUP WS?
|
|
||||||
UNTIL
|
|
||||||
( a this point, PS is: a WS )
|
|
||||||
( null-termination is already written )
|
|
||||||
2DROP
|
|
||||||
0x0e RAM+ ;
|
|
||||||
10
blk/401
10
blk/401
@ -1,10 +0,0 @@
|
|||||||
: SCPY
|
|
||||||
BEGIN ( a )
|
|
||||||
DUP C@ ( a c )
|
|
||||||
DUP C, ( a c )
|
|
||||||
NOT IF DROP EXIT THEN
|
|
||||||
1+ ( a+1 )
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
||||||
|
|
||||||
15
blk/402
15
blk/402
@ -1,15 +0,0 @@
|
|||||||
: [entry]
|
|
||||||
HERE @ ( w h )
|
|
||||||
SWAP SCPY ( h )
|
|
||||||
( Adjust HERE -1 because SCPY copies the null )
|
|
||||||
HERE @ 1- ( h h' )
|
|
||||||
DUP HERE ! ( h h' )
|
|
||||||
SWAP - ( sz )
|
|
||||||
( write prev value )
|
|
||||||
HERE @ CURRENT @ - ,
|
|
||||||
( write size )
|
|
||||||
C,
|
|
||||||
HERE @ CURRENT !
|
|
||||||
;
|
|
||||||
|
|
||||||
: (entry) WORD [entry] ;
|
|
||||||
14
blk/403
14
blk/403
@ -1,14 +0,0 @@
|
|||||||
: INTERPRET
|
|
||||||
BEGIN
|
|
||||||
WORD
|
|
||||||
(find)
|
|
||||||
IF
|
|
||||||
1 FLAGS !
|
|
||||||
EXECUTE
|
|
||||||
0 FLAGS !
|
|
||||||
ELSE
|
|
||||||
(parse*) @ EXECUTE
|
|
||||||
THEN
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
||||||
11
blk/404
11
blk/404
@ -1,11 +0,0 @@
|
|||||||
( system c< simply reads source from binary, starting at
|
|
||||||
LATEST. Convenient way to bootstrap a new system. )
|
|
||||||
: (boot<)
|
|
||||||
( 2e == BOOT C< PTR )
|
|
||||||
0x2e RAM+ @ ( a )
|
|
||||||
DUP C@ ( a c )
|
|
||||||
SWAP 1 + ( c a+1 )
|
|
||||||
0x2e RAM+ ! ( c )
|
|
||||||
;
|
|
||||||
|
|
||||||
|
|
||||||
12
blk/405
12
blk/405
@ -1,12 +0,0 @@
|
|||||||
: BOOT
|
|
||||||
0x02 RAM+ CURRENT* !
|
|
||||||
LIT< (parse) (find) DROP (parse*) !
|
|
||||||
( 2e == SYSTEM SCRATCHPAD )
|
|
||||||
CURRENT @ 0x2e RAM+ !
|
|
||||||
( 0c == CINPTR )
|
|
||||||
LIT< (boot<) (find) DROP 0x0c RAM+ !
|
|
||||||
LIT< INIT (find)
|
|
||||||
IF EXECUTE
|
|
||||||
ELSE DROP INTERPRET THEN
|
|
||||||
;
|
|
||||||
|
|
||||||
14
blk/406
14
blk/406
@ -1,14 +0,0 @@
|
|||||||
( LITN has to be defined after the last immediate usage of
|
|
||||||
it to avoid bootstrapping issues )
|
|
||||||
: LITN 32 , , ( 32 == NUMBER ) ;
|
|
||||||
|
|
||||||
: IMMED? 1- C@ 0x80 AND ;
|
|
||||||
|
|
||||||
( ';' can't have its name right away because, when created, it
|
|
||||||
is not an IMMEDIATE yet and will not be treated properly by
|
|
||||||
xcomp. )
|
|
||||||
: _
|
|
||||||
['] EXIT ,
|
|
||||||
R> DROP ( exit : )
|
|
||||||
; IMMEDIATE
|
|
||||||
|
|
||||||
16
blk/407
16
blk/407
@ -1,16 +0,0 @@
|
|||||||
XCURRENT @ ( to PSP )
|
|
||||||
: :
|
|
||||||
(entry)
|
|
||||||
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
|
||||||
issues. Same thing for ",".
|
|
||||||
32 == NUMBER 14 == compiledWord )
|
|
||||||
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
|
|
||||||
BEGIN
|
|
||||||
WORD
|
|
||||||
(find)
|
|
||||||
( is word )
|
|
||||||
IF DUP IMMED? IF EXECUTE ELSE , THEN
|
|
||||||
( maybe number )
|
|
||||||
ELSE (parse*) @ EXECUTE LITN THEN
|
|
||||||
AGAIN ;
|
|
||||||
( from PSP ) ';' SWAP 4 - C!
|
|
||||||
60
drv/acia.z80
Normal file
60
drv/acia.z80
Normal file
@ -0,0 +1,60 @@
|
|||||||
|
( Save ACIA conf )
|
||||||
|
ACIA_CTL
|
||||||
|
: ACIA_CTL [ LITN ] ;
|
||||||
|
ACIA_IO
|
||||||
|
: ACIA_IO [ LITN ] ;
|
||||||
|
ACIA_MEM
|
||||||
|
: ACIA_MEM [ LITN ] ;
|
||||||
|
( Memory layout
|
||||||
|
+0 ACIAR>
|
||||||
|
+2 ACIAW>
|
||||||
|
+4 ACIA(
|
||||||
|
+6 ACIA)
|
||||||
|
)
|
||||||
|
|
||||||
|
(xentry) ~ACIA
|
||||||
|
AF PUSHqq,
|
||||||
|
HL PUSHqq,
|
||||||
|
DE PUSHqq,
|
||||||
|
|
||||||
|
( Read our character from ACIA into our BUFIDX )
|
||||||
|
ACIA_CTL INAn,
|
||||||
|
0x01 ANDn, ( is ACIA rcv buf full? )
|
||||||
|
IFNZ,
|
||||||
|
( correct interrupt cause )
|
||||||
|
( +2 == ACIAW> )
|
||||||
|
ACIA_MEM 2+ LDHL(nn),
|
||||||
|
( is it == to ACIAR>? )
|
||||||
|
( +0 == ACIAR> )
|
||||||
|
DE ACIA_MEM LDdd(nn),
|
||||||
|
( carry cleared from ANDn above )
|
||||||
|
DE SBCHLss,
|
||||||
|
IFNZ, ( buffer full? )
|
||||||
|
( no, continue )
|
||||||
|
DE ADDHLss, ( restore ACIAW> )
|
||||||
|
( buffer not full, let's write )
|
||||||
|
ACIA_IO INAn,
|
||||||
|
(HL) A LDrr,
|
||||||
|
|
||||||
|
( advance W> )
|
||||||
|
HL INCss,
|
||||||
|
( +2 == ACIAW> )
|
||||||
|
ACIA_MEM 2+ LD(nn)HL,
|
||||||
|
( +6 == ACIA) )
|
||||||
|
DE ACIA_MEM 6 + LDdd(nn),
|
||||||
|
DE SUBHLss,
|
||||||
|
IFZ, ( end of buffer reached? )
|
||||||
|
( yes )
|
||||||
|
( +4 == ACIA( )
|
||||||
|
ACIA_MEM 4 + LDHL(nn),
|
||||||
|
( +2 == ACIAW> )
|
||||||
|
ACIA_MEM 2+ LD(nn)HL,
|
||||||
|
THEN,
|
||||||
|
THEN,
|
||||||
|
THEN,
|
||||||
|
|
||||||
|
DE POPqq,
|
||||||
|
HL POPqq,
|
||||||
|
AF POPqq,
|
||||||
|
EI,
|
||||||
|
RETI,
|
||||||
@ -1,6 +1,7 @@
|
|||||||
|
( n -- n )
|
||||||
( Initiate SPI exchange with the SD card. n is the data to
|
( Initiate SPI exchange with the SD card. n is the data to
|
||||||
send. )
|
send. )
|
||||||
CODE _sdcSR ( n -- n )
|
CODE _sdcSR
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
chkPS,
|
chkPS,
|
||||||
A L LDrr,
|
A L LDrr,
|
||||||
@ -11,4 +12,10 @@ CODE _sdcSR ( n -- n )
|
|||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
373 LOAD
|
CODE _sdcSel
|
||||||
|
SDC_CSLOW OUTnA,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
CODE _sdcDesel
|
||||||
|
SDC_CSHIGH OUTnA,
|
||||||
|
;CODE
|
||||||
@ -1,5 +1,10 @@
|
|||||||
TARGETS = forth/forth forth/stage2
|
TARGETS = forth/forth
|
||||||
# Those Forth source files are in a particular order
|
# Those Forth source files are in a particular order
|
||||||
|
BOOTSRCS = ./forth/conf.fs \
|
||||||
|
./forth/xcomp.fs \
|
||||||
|
../forth/icore.fs \
|
||||||
|
./forth/xstop.fs
|
||||||
|
|
||||||
FORTHSRCS = core.fs cmp.fs print.fs parse.fs readln.fs fmt.fs blk.fs
|
FORTHSRCS = core.fs cmp.fs print.fs parse.fs readln.fs fmt.fs blk.fs
|
||||||
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
|
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
|
||||||
OBJS = emul.o libz80/libz80.o
|
OBJS = emul.o libz80/libz80.o
|
||||||
@ -71,7 +76,7 @@ emul.o: emul.c
|
|||||||
|
|
||||||
.PHONY: updatebootstrap
|
.PHONY: updatebootstrap
|
||||||
updatebootstrap: forth/stage2
|
updatebootstrap: forth/stage2
|
||||||
cat ./forth/xcomp.fs | ./forth/stage2 > ./forth/z80c.bin
|
cat $(BOOTSRCS) | ./forth/stage2 > ./forth/z80c.bin
|
||||||
|
|
||||||
.PHONY: pack
|
.PHONY: pack
|
||||||
pack:
|
pack:
|
||||||
|
|||||||
3
emul/forth/conf.fs
Normal file
3
emul/forth/conf.fs
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
212 LOAD ( z80 assembler )
|
||||||
|
0xe800 CONSTANT RAMSTART
|
||||||
|
0xf000 CONSTANT RS_ADDR
|
||||||
@ -1,10 +1,6 @@
|
|||||||
0xe800 CONSTANT RAMSTART
|
|
||||||
0xf000 CONSTANT RS_ADDR
|
|
||||||
212 LOAD ( z80 assembler )
|
|
||||||
262 LOAD ( xcomp )
|
262 LOAD ( xcomp )
|
||||||
: CODE XCODE ;
|
: CODE XCODE ;
|
||||||
: IMMEDIATE XIMM ;
|
: IMMEDIATE XIMM ;
|
||||||
: (entry) (xentry) ;
|
|
||||||
: : [ ' X: , ] ;
|
: : [ ' X: , ] ;
|
||||||
|
|
||||||
CURRENT @ XCURRENT !
|
CURRENT @ XCURRENT !
|
||||||
@ -12,6 +8,3 @@ CURRENT @ XCURRENT !
|
|||||||
H@ 256 /MOD 2 PC! 2 PC!
|
H@ 256 /MOD 2 PC! 2 PC!
|
||||||
H@ XOFF !
|
H@ XOFF !
|
||||||
282 LOAD ( boot.z80 )
|
282 LOAD ( boot.z80 )
|
||||||
393 LOAD ( icore )
|
|
||||||
(entry) _
|
|
||||||
H@ 256 /MOD 2 PC! 2 PC!
|
|
||||||
|
|||||||
3
emul/forth/xstop.fs
Normal file
3
emul/forth/xstop.fs
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
(xentry) _
|
||||||
|
H@ 256 /MOD 2 PC! 2 PC!
|
||||||
|
|
||||||
252
forth/icore.fs
Normal file
252
forth/icore.fs
Normal file
@ -0,0 +1,252 @@
|
|||||||
|
( Inner core. This unit represents core definitions that
|
||||||
|
happen right after native definitions. Before core.fs.
|
||||||
|
|
||||||
|
Unlike core.fs and its followers, this unit isn't self-
|
||||||
|
sustained. Like native defs it uses the machinery of a
|
||||||
|
full Forth interpreter, notably for flow structures.
|
||||||
|
|
||||||
|
Because of that, it has to obey specific rules:
|
||||||
|
|
||||||
|
1. It cannot compile a word from higher layers. Using
|
||||||
|
immediates is fine though.
|
||||||
|
2. If it references a word from this unit or from native
|
||||||
|
definitions, these need to be properly offsetted
|
||||||
|
because their offset at compile time are not the same
|
||||||
|
as their runtime offsets.
|
||||||
|
3. Anything they refer to in the boot binary has to be
|
||||||
|
properly stabilized.
|
||||||
|
4. Make sure that the words you compile are not overridden
|
||||||
|
by the full interpreter.
|
||||||
|
5. When using words as immediates, make sure that they're
|
||||||
|
not defined in icore or, if they are, make sure that
|
||||||
|
they are *not* offsetted
|
||||||
|
|
||||||
|
Those rules are mostly met by the "xcomp" unit, which is
|
||||||
|
expected to have been loaded prior to icore and redefines
|
||||||
|
":" and other defining words. So, in other words, when
|
||||||
|
compiling icore, ":" doesn't means what you think it means,
|
||||||
|
go look in B260.
|
||||||
|
)
|
||||||
|
|
||||||
|
: RAM+
|
||||||
|
[ RAMSTART LITN ] +
|
||||||
|
;
|
||||||
|
|
||||||
|
: FLAGS 0x08 RAM+ ;
|
||||||
|
: (parse*) 0x0a RAM+ ;
|
||||||
|
: HERE 0x04 RAM+ ;
|
||||||
|
: CURRENT* 0x51 RAM+ ;
|
||||||
|
: CURRENT CURRENT* @ ;
|
||||||
|
|
||||||
|
( w -- a f )
|
||||||
|
: (find) CURRENT @ SWAP _find ;
|
||||||
|
|
||||||
|
: QUIT
|
||||||
|
0 FLAGS ! (resRS)
|
||||||
|
LIT< INTERPRET (find) DROP EXECUTE
|
||||||
|
;
|
||||||
|
|
||||||
|
: ABORT (resSP) QUIT ;
|
||||||
|
|
||||||
|
: = CMP NOT ;
|
||||||
|
: < CMP -1 = ;
|
||||||
|
: > CMP 1 = ;
|
||||||
|
: 0< 32767 > ;
|
||||||
|
|
||||||
|
( r c -- r f )
|
||||||
|
( Parse digit c and accumulate into result r.
|
||||||
|
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
||||||
|
-1 when c was an invalid digit. )
|
||||||
|
: _pdacc
|
||||||
|
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||||
|
( parse char )
|
||||||
|
'0' -
|
||||||
|
( if bad, return "r -1" )
|
||||||
|
DUP 0< IF DROP -1 EXIT THEN ( bad )
|
||||||
|
DUP 9 > IF DROP -1 EXIT THEN ( bad )
|
||||||
|
( good, add to running result )
|
||||||
|
SWAP 10 * + ( r*10+n )
|
||||||
|
0 ( good )
|
||||||
|
;
|
||||||
|
|
||||||
|
: (parsed) ( a -- n f )
|
||||||
|
( read first char outside of the loop. it *has* to be
|
||||||
|
nonzero. )
|
||||||
|
DUP C@ ( a c )
|
||||||
|
( special case: do we have a negative? )
|
||||||
|
DUP '-' = IF
|
||||||
|
( Oh, a negative, let's recurse and reverse )
|
||||||
|
DROP 1+ ( a+1 )
|
||||||
|
(parsed) ( n f )
|
||||||
|
0 ROT ( f 0 n )
|
||||||
|
- SWAP EXIT ( 0-n f )
|
||||||
|
THEN
|
||||||
|
( running result from first char )
|
||||||
|
0 SWAP ( a r c )
|
||||||
|
_pdacc ( a r f )
|
||||||
|
DUP IF
|
||||||
|
( first char was not a valid digit )
|
||||||
|
2DROP 0 EXIT ( a 0 )
|
||||||
|
THEN
|
||||||
|
BEGIN ( a r 0 )
|
||||||
|
DROP SWAP 1+ ( r a+1 )
|
||||||
|
DUP C@ ( r a c )
|
||||||
|
ROT SWAP ( a r c )
|
||||||
|
_pdacc ( a r f )
|
||||||
|
DUP UNTIL
|
||||||
|
( a r f -- f is 1 on success, -1 on error, normalize
|
||||||
|
to bool. )
|
||||||
|
1 = ( a r f )
|
||||||
|
( we want "r f" )
|
||||||
|
ROT DROP
|
||||||
|
;
|
||||||
|
|
||||||
|
( This is only the "early parser" in earlier stages. No need
|
||||||
|
for an abort message )
|
||||||
|
: (parse)
|
||||||
|
(parsed) NOT IF ABORT THEN
|
||||||
|
;
|
||||||
|
|
||||||
|
: C<
|
||||||
|
( 0c == CINPTR )
|
||||||
|
0x0c RAM+ @ EXECUTE
|
||||||
|
;
|
||||||
|
|
||||||
|
: ,
|
||||||
|
HERE @ !
|
||||||
|
HERE @ 2+ HERE !
|
||||||
|
;
|
||||||
|
|
||||||
|
: C,
|
||||||
|
HERE @ C!
|
||||||
|
HERE @ 1+ HERE !
|
||||||
|
;
|
||||||
|
|
||||||
|
( The NOT is to normalize the negative/positive numbers to 1
|
||||||
|
or 0. Hadn't we wanted to normalize, we'd have written:
|
||||||
|
32 CMP 1 - )
|
||||||
|
: WS? 33 CMP 1+ NOT ;
|
||||||
|
|
||||||
|
: TOWORD
|
||||||
|
BEGIN
|
||||||
|
C< DUP WS? NOT IF EXIT THEN DROP
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
|
( Read word from C<, copy to WORDBUF, null-terminate, and
|
||||||
|
return, make HL point to WORDBUF. )
|
||||||
|
: WORD
|
||||||
|
( 0e == WORDBUF )
|
||||||
|
0x0e RAM+ ( a )
|
||||||
|
TOWORD ( a c )
|
||||||
|
BEGIN
|
||||||
|
( We take advantage of the fact that char MSB is
|
||||||
|
always zero to pre-write our null-termination )
|
||||||
|
OVER ! ( a )
|
||||||
|
1+ ( a+1 )
|
||||||
|
C< ( a c )
|
||||||
|
DUP WS?
|
||||||
|
UNTIL
|
||||||
|
( a this point, PS is: a WS )
|
||||||
|
( null-termination is already written )
|
||||||
|
2DROP
|
||||||
|
0x0e RAM+
|
||||||
|
;
|
||||||
|
|
||||||
|
: SCPY
|
||||||
|
BEGIN ( a )
|
||||||
|
DUP C@ ( a c )
|
||||||
|
DUP C, ( a c )
|
||||||
|
NOT IF DROP EXIT THEN
|
||||||
|
1+ ( a+1 )
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
|
: [entry]
|
||||||
|
HERE @ ( w h )
|
||||||
|
SWAP SCPY ( h )
|
||||||
|
( Adjust HERE -1 because SCPY copies the null )
|
||||||
|
HERE @ 1- ( h h' )
|
||||||
|
DUP HERE ! ( h h' )
|
||||||
|
SWAP - ( sz )
|
||||||
|
( write prev value )
|
||||||
|
HERE @ CURRENT @ - ,
|
||||||
|
( write size )
|
||||||
|
C,
|
||||||
|
HERE @ CURRENT !
|
||||||
|
;
|
||||||
|
|
||||||
|
: (entry) WORD [entry] ;
|
||||||
|
|
||||||
|
: INTERPRET
|
||||||
|
BEGIN
|
||||||
|
WORD
|
||||||
|
(find)
|
||||||
|
IF
|
||||||
|
1 FLAGS !
|
||||||
|
EXECUTE
|
||||||
|
0 FLAGS !
|
||||||
|
ELSE
|
||||||
|
(parse*) @ EXECUTE
|
||||||
|
THEN
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
|
( system c< simply reads source from binary, starting at
|
||||||
|
LATEST. Convenient way to bootstrap a new system. )
|
||||||
|
: (boot<)
|
||||||
|
( 2e == BOOT C< PTR )
|
||||||
|
0x2e RAM+ @ ( a )
|
||||||
|
DUP C@ ( a c )
|
||||||
|
SWAP 1 + ( c a+1 )
|
||||||
|
0x2e RAM+ ! ( c )
|
||||||
|
;
|
||||||
|
|
||||||
|
: BOOT
|
||||||
|
0x02 RAM+ CURRENT* !
|
||||||
|
LIT< (parse) (find) DROP (parse*) !
|
||||||
|
( 2e == SYSTEM SCRATCHPAD )
|
||||||
|
CURRENT @ 0x2e RAM+ !
|
||||||
|
( 0c == CINPTR )
|
||||||
|
LIT< (boot<) (find) DROP 0x0c RAM+ !
|
||||||
|
LIT< INIT (find)
|
||||||
|
IF EXECUTE
|
||||||
|
ELSE DROP INTERPRET THEN
|
||||||
|
;
|
||||||
|
|
||||||
|
( LITN has to be defined after the last immediate usage of
|
||||||
|
it to avoid bootstrapping issues )
|
||||||
|
: LITN
|
||||||
|
( 32 == NUMBER )
|
||||||
|
32 , ,
|
||||||
|
;
|
||||||
|
|
||||||
|
: IMMED? 1- C@ 0x80 AND ;
|
||||||
|
|
||||||
|
( ';' can't have its name right away because, when created, it
|
||||||
|
is not an IMMEDIATE yet and will not be treated properly by
|
||||||
|
xcomp. )
|
||||||
|
: _
|
||||||
|
['] EXIT ,
|
||||||
|
R> DROP ( exit : )
|
||||||
|
; IMMEDIATE
|
||||||
|
|
||||||
|
XCURRENT @ ( to PSP )
|
||||||
|
|
||||||
|
: :
|
||||||
|
(entry)
|
||||||
|
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
||||||
|
issues. Same thing for ",".
|
||||||
|
32 == NUMBER 14 == compiledWord )
|
||||||
|
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
|
||||||
|
BEGIN
|
||||||
|
WORD
|
||||||
|
(find)
|
||||||
|
( is word )
|
||||||
|
IF DUP IMMED? IF EXECUTE ELSE , THEN
|
||||||
|
( maybe number )
|
||||||
|
ELSE (parse*) @ EXECUTE LITN THEN
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
|
( from PSP ) ';' SWAP 4 - C!
|
||||||
@ -4,6 +4,12 @@ FDIR = $(BASEDIR)/forth
|
|||||||
EDIR = $(BASEDIR)/emul/forth
|
EDIR = $(BASEDIR)/emul/forth
|
||||||
STAGE2 = $(EDIR)/stage2
|
STAGE2 = $(EDIR)/stage2
|
||||||
EMUL = $(BASEDIR)/emul/hw/rc2014/classic
|
EMUL = $(BASEDIR)/emul/hw/rc2014/classic
|
||||||
|
BOOTSRCS = conf.fs \
|
||||||
|
$(EDIR)/xcomp.fs \
|
||||||
|
$(BASEDIR)/drv/acia.z80 \
|
||||||
|
$(BASEDIR)/drv/sdc.z80 \
|
||||||
|
$(FDIR)/icore.fs \
|
||||||
|
$(EDIR)/xstop.fs
|
||||||
|
|
||||||
PATHS = \
|
PATHS = \
|
||||||
$(FDIR)/core.fs \
|
$(FDIR)/core.fs \
|
||||||
@ -24,8 +30,8 @@ $(TARGET): z80c.bin $(SLATEST) $(PATHS)
|
|||||||
$(SLATEST) $@
|
$(SLATEST) $@
|
||||||
cat $(PATHS) | $(STRIPFC) >> $@
|
cat $(PATHS) | $(STRIPFC) >> $@
|
||||||
|
|
||||||
z80c.bin: xcomp.fs
|
z80c.bin: conf.fs
|
||||||
cat xcomp.fs | $(STAGE2) > $@
|
cat $(BOOTSRCS) | $(STAGE2) > $@
|
||||||
|
|
||||||
$(SLATEST):
|
$(SLATEST):
|
||||||
$(MAKE) -C $(BASEDIR)/tools
|
$(MAKE) -C $(BASEDIR)/tools
|
||||||
|
|||||||
10
recipes/rc2014/conf.fs
Normal file
10
recipes/rc2014/conf.fs
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
212 LOAD ( z80a )
|
||||||
|
0x8000 CONSTANT RAMSTART
|
||||||
|
0xf000 CONSTANT RS_ADDR
|
||||||
|
0x80 CONSTANT ACIA_CTL
|
||||||
|
0x81 CONSTANT ACIA_IO
|
||||||
|
4 CONSTANT SDC_SPI
|
||||||
|
5 CONSTANT SDC_CSLOW
|
||||||
|
6 CONSTANT SDC_CSHIGH
|
||||||
|
RAMSTART 0x70 + CONSTANT ACIA_MEM
|
||||||
|
|
||||||
@ -1,25 +0,0 @@
|
|||||||
0x8000 CONSTANT RAMSTART
|
|
||||||
0xf000 CONSTANT RS_ADDR
|
|
||||||
0x80 CONSTANT ACIA_CTL
|
|
||||||
0x81 CONSTANT ACIA_IO
|
|
||||||
4 CONSTANT SDC_SPI
|
|
||||||
5 CONSTANT SDC_CSLOW
|
|
||||||
6 CONSTANT SDC_CSHIGH
|
|
||||||
RAMSTART 0x70 + CONSTANT ACIA_MEM
|
|
||||||
212 LOAD ( z80 assembler )
|
|
||||||
262 LOAD ( xcomp )
|
|
||||||
: CODE XCODE ;
|
|
||||||
: IMMEDIATE XIMM ;
|
|
||||||
: (entry) (xentry) ;
|
|
||||||
: : [ ' X: , ] ;
|
|
||||||
|
|
||||||
CURRENT @ XCURRENT !
|
|
||||||
|
|
||||||
H@ 256 /MOD 2 PC! 2 PC!
|
|
||||||
H@ XOFF !
|
|
||||||
282 LOAD ( boot.z80 )
|
|
||||||
352 LOAD ( acia.z80 )
|
|
||||||
372 LOAD ( sdc.z80 )
|
|
||||||
393 LOAD ( icore )
|
|
||||||
(entry) _
|
|
||||||
H@ 256 /MOD 2 PC! 2 PC!
|
|
||||||
Loading…
Reference in New Issue
Block a user