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

Compare commits

base: izaya:7464c67c804f148ba0203cfdfe907ad9642de862
Branches Tags
izaya:master
izaya:z80asm
izaya:wip
izaya:forth
...
compare: izaya:fcd77f80ab4d3d690fd0d6f21afa17d86e2dbd3b
Branches Tags
izaya:master
izaya:z80asm
izaya:wip
izaya:forth

3 Commits
7464c67c80 ... fcd77f80ab

Author SHA1 Message Date
Virgil Dupras
fcd77f80ab Use blk's boot.z80 2020-04-22 21:49:44 -04:00
Virgil Dupras
503dbe9a2c Copy boot.z80 to blkfs 2020-04-22 21:19:12 -04:00
Virgil Dupras
338769a0a8 z80a: add PUSH0, PUSH1, PUSHZ, macros 2020-04-22 19:03:32 -04:00
70 changed files with 730 additions and 786 deletions
Show Stats Expand all files Collapse all files

3
blk/001
View File

@ -3,8 +3,7 @@ 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

10
blk/064
View File

@ -1,10 +1,10 @@
Disk Disk
BLK> -- a Address of the current block variable. BLK> -- a Address of the current block variable.
LIST n -- Prints the contents of the block n on screen in the LIST n -- Prints the contents of the block n on screen
form of 16 lines of 64 columns. in the form of 16 lines of 64 columns.
LOAD n -- Interprets Forth code from block n LOAD n -- Interprets Forth code from block n
LOADR n1 n2 -- Load block range between n1 and n2, inclusive.

2
blk/075
View File

@ -13,4 +13,4 @@ This return stack contain "Interpreter pointers", that is a
pointer to the address of a word, as seen in a compiled list of pointer to the address of a word, as seen in a compiled list of
words. words.
(cont.)

6
blk/076 Normal file
View File

@ -0,0 +1,6 @@
STACK OVERFLOW PROTECTION: To avoid having to check for stack
underflow after each pop operation (which can end up being
prohibitive in terms of costs), we give ourselves a nice 6
bytes buffer. 6 bytes because we seldom have words requiring
more than 3 items from the stack. Then, at each "exit" call we
check for stack underflow.

8
blk/087
View File

@ -5,10 +5,10 @@ null-terminated string. Upon execution, the address of that
null-terminated string is pushed on the PSP and IP is advanced null-terminated string is pushed on the PSP and IP is advanced
to the address following the null. to the address following the null.
Also note that word routines references in wordrefs are 1b.
This means that all word routine reference must live below
0x100 in boot binary. This is why numberWord and addrWord are
squeezed where they are.

4
blk/102
View File

@ -1,10 +1,10 @@
103 LOAD 104 LOAD 105 LOAD 103 105 LOADR
: BROWSE : BROWSE
100 _LIST 100 _LIST
BEGIN BEGIN
KEY CASE KEY CASE
'Q' OF DROP EXIT ENDOF 'Q' OF EXIT ENDOF
'B' OF B ENDOF 'B' OF B ENDOF
'N' OF N ENDOF 'N' OF N ENDOF
_NUM _NUM

2
blk/200
View File

@ -10,4 +10,4 @@ Z80 Assembler
234 OP2r 236 OP2ss 234 OP2r 236 OP2ss
238 OP3ddnn 240 OP3nn 238 OP3ddnn 240 OP3nn
242 Specials 246 Flow 242 Specials 246 Flow
249 Macros

2
blk/212
View File

@ -5,4 +5,4 @@ H@ 0x59 RAM+ !
213 LOAD 215 LOAD 216 LOAD 217 LOAD 218 LOAD 219 LOAD 213 LOAD 215 LOAD 216 LOAD 217 LOAD 218 LOAD 219 LOAD
220 LOAD 222 LOAD 223 LOAD 224 LOAD 226 LOAD 228 LOAD 220 LOAD 222 LOAD 223 LOAD 224 LOAD 226 LOAD 228 LOAD
230 LOAD 232 LOAD 234 LOAD 236 LOAD 238 LOAD 240 LOAD 230 LOAD 232 LOAD 234 LOAD 236 LOAD 238 LOAD 240 LOAD
242 LOAD 243 LOAD 244 LOAD 246 LOAD 247 LOAD 242 LOAD 243 LOAD 246 LOAD 247 LOAD 249 LOAD

3
blk/244
View File

@ -1,3 +0,0 @@
( Macros )
( clear carry + SBC )
: SUBHLss, A ORr, SBCHLss, ;

6
blk/249 Normal file
View File

@ -0,0 +1,6 @@
( Macros )
( clear carry + SBC )
: SUBHLss, A ORr, SBCHLss, ;
: PUSH0, BC 0 LDddnn, BC PUSHqq, ;
: PUSH1, BC 1 LDddnn, BC PUSHqq, ;
: PUSHZ, BC 0 LDddnn, IFZ, BC INCss, THEN, BC PUSHqq, ;

16
blk/280 Normal file
View File

@ -0,0 +1,16 @@
Z80 boot code
This assembles the boot binary. It requires the Z80 assembler
(B200) and cross compilation setup (B260).
On top of that, it requires RAMSTART to be defined as the
beginning address of RAM. This is where system variables are
placed. HERE is then placed at RAM+80 (ref B80).
We also need RS_ADDR to be set to the bottom address of the
Return Stack.
RESERVED REGISTERS: At all times, IX points to RSP TOS and IY
is IP. SP points to PSP TOS, but you can still use the stack\
in native code. you just have to make sure you've restored it
before "next". (cont.)

7
blk/281 Normal file
View File

@ -0,0 +1,7 @@
(cont.) STABLE ABI: The boot binary starts with a list of
references. The address of these references have to stay to
those addresses. The rest of the Collapse OS code depend on it.
In fact, up until 0x67, the (?br) wordref, pretty much
everything has to stay put.
To assemble, run "282 LOAD".

1
blk/282 Normal file
View File

@ -0,0 +1 @@
283 333 LOADR

15
blk/283 Normal file
View File

@ -0,0 +1,15 @@
H@ ORG !
0 JPnn, ( 00, main ) 0 JPnn, ( 03, find )
NOP, NOP, ( 06, unused ) NOP, NOP, ( 08, LATEST )
NOP, ( 0a, unused ) 0 JPnn, ( 0b, cellWord )
0 JPnn, ( 0e, compiledWord ) 0 JPnn, ( 11, pushRS )
0 JPnn, ( 14, popRS )
EXDEHL, JP(HL), NOP, ( 17, nativeWord )
0 JPnn, ( 1a, next ) 0 JPnn, ( 1d, chkPS )
NOP, NOP, ( 20, numberWord ) NOP, NOP, ( 22, litWord )
NOP, NOP, ( 24, addrWord ) NOP, NOP, ( 26, unused )
RAMSTART 0x4e + JPnn, ( 28, RST 28 )
0 JPnn, ( 2b, doesWord ) NOP, NOP, ( 2e, unused )
RAMSTART 0x4e + JPnn, ( RST 30 )
0 JPnn, ( 33, execute ) NOP, NOP, ( unused )
RAMSTART 0x4e + JPnn, ( RST 38 )

12
blk/284 Normal file
View File

@ -0,0 +1,12 @@
( BOOT DICT: There are only 3 words in the boot dict, but
these words' offset need to be stable, so they're part of
the "stable ABI" )
'E' A, 'X' A, 'I' A, 'T' A,
0 A,, ( prev )
4 A,
H@ XCURRENT ! ( set current tip of dict, 0x42 )
0x17 A, ( nativeWord )
0x14 CALLnn, ( popRS )
HL PUSHqq, IY POPqq, ( --> IP )
JPNEXT,

6
blk/285 Normal file
View File

@ -0,0 +1,6 @@
CODE (br) ( 0x53 )
L2 BSET ( used in CBR )
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
DE ADDIYss,
JPNEXT,

13
blk/286 Normal file
View File

@ -0,0 +1,13 @@
CODE (?br) ( 0x67 )
HL POPqq,
chkPS,
A H LDrr,
L ORr,
JRZ, L2 BWR ( BR + 2. False, branch )
( True, skip next 2 bytes and don't branch )
IY INCss,
IY INCss,
JPNEXT,
( END OF STABLE ABI )

14
blk/287 Normal file
View File

@ -0,0 +1,14 @@
( See B85 for word routine impl notes )
PC ORG @ 0x20 + ! ( numberWord )
PC ORG @ 0x24 + ! ( addrWord )
( This is not a word, but a number literal. This works a bit
differently than others: PF means nothing and the actual
number is placed next to the numberWord reference in the
compiled word list. What we need to do to fetch that number
is to play with the IP. )
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
IY INCss,
IY INCss,
DE PUSHqq,
JPNEXT,

16
blk/288 Normal file
View File

@ -0,0 +1,16 @@
PC ORG @ 0x22 + ! ( litWord )
( Like numberWord, but instead of being followed by a 2 bytes
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )
IY PUSHqq, HL POPqq, ( <-- IP )
HL PUSHqq,
( skip to null char )
A XORr, ( look for null )
B A LDrr,
C A LDrr,
CPIR,
( CPIR advances HL regardless of comparison, so goes one
char after NULL. This is good, because that's what we
want... )
HL PUSHqq, IY POPqq, ( --> IP )
JPNEXT,

16
blk/289 Normal file
View File

@ -0,0 +1,16 @@
( Name of BOOT word )
L1 BSET 'B' A, 'O' A, 'O' A, 'T' A, 0 A,
PC ORG @ 1 + ! ( main )
( STACK OVERFLOW PROTECTION: See B76 )
SP 0xfffa LDddnn,
RAMSTART SP LD(nn)dd, ( RAM+00 == INITIAL_SP )
IX RS_ADDR LDddnn,
( HERE begins at RAMEND )
HL RAMSTART 0x80 + LDddnn,
RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
( LATEST is a label to the latest entry of the dict. It is
written at offset 0x08 by the process or person building
Forth. )
0x08 LDHL(nn),
RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT cont. )

4
blk/290 Normal file
View File

@ -0,0 +1,4 @@
EXDEHL,
HL L1 @ LDddnn,
0x03 CALLnn, ( 03 == find )
0x33 JPnn, ( 33 == execute )

16
blk/291 Normal file
View File

@ -0,0 +1,16 @@
PC ORG @ 4 + ! ( find )
( Find the entry corresponding to word name where (HL) points
to in dictionary having its tip at DE and sets DE to point
to that entry. Z if found, NZ if not. )
BC PUSHqq,
HL PUSHqq,
( First, figure out string len )
BC 0 LDddnn,
A XORr,
CPIR,
( C has our length, negative, -1 )
A C LDrr,
NEG,
A DECr,
( special case. zero len? we never find anything. )
JRZ, L1 FWR ( fail-B296 ) ( cont. )

16
blk/292 Normal file
View File

@ -0,0 +1,16 @@
C A LDrr, ( C holds our length )
( Let's do something weird: We'll hold HL by the *tail*.
Because of our dict structure and because we know our
lengths, it's easier to compare starting from the end.
Currently, after CPIR, HL points to char after null. Let's
adjust. Because the compare loop pre-decrements, instead
of DECing HL twice, we DEC it once. )
HL DECss,
BEGIN, ( inner )
( DE is a wordref, first step, do our len correspond? )
HL PUSHqq, ( --> lvl 1 )
DE PUSHqq, ( --> lvl 2 )
DE DECss,
LDA(DE),
0x7f ANDn, ( remove IMMEDIATE flag )
C CPr, ( cont. )

16
blk/293 Normal file
View File

@ -0,0 +1,16 @@
JRNZ, L2 FWR ( loopend )
( match, let's compare the string then )
DE DECss, ( Skip prev field. One less because we )
DE DECss, ( pre-decrement )
B C LDrr, ( loop C times )
BEGIN, ( loop )
( pre-decrement for easier Z matching )
DE DECss,
HL DECss,
LDA(DE),
(HL) CPr,
JRNZ, L3 FWR ( loopend )
DJNZ, AGAIN, ( loop )
L2 FSET L3 FSET ( loopend )
( cont. )

16
blk/294 Normal file
View File

@ -0,0 +1,16 @@
( At this point, Z is set if we have a match. In all cases,
we want to pop HL and DE )
DE POPqq, ( <-- lvl 2 )
HL POPqq, ( <-- lvl 1 )
JRZ, L2 FWR ( end-B296, match? we're done! )
( no match, go to prev and continue )
HL PUSHqq, ( --> lvl 1 )
DE DECss,
DE DECss,
DE DECss, ( prev field )
DE PUSHqq, ( --> lvl 2 )
EXDEHL,
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
( cont. )

16
blk/295 Normal file
View File

@ -0,0 +1,16 @@
( DE contains prev offset )
HL POPqq, ( <-- lvl 2 )
( HL is prev field's addr. Is offset zero? )
A D LDrr,
E ORr,
IFNZ,
( get absolute addr from offset )
( carry cleared from "or e" )
DE SBCHLss,
EXDEHL, ( result in DE )
THEN,
HL POPqq, ( <-- lvl 1 )
JRNZ, AGAIN, ( inner-B292, try to match again )
( Z set? end of dict, unset Z )
( cont. )

7
blk/296 Normal file
View File

@ -0,0 +1,7 @@
L1 FSET ( fail )
A XORr,
A INCr,
L2 FSET ( end )
HL POPqq,
BC POPqq,
RET,

13
blk/297 Normal file
View File

@ -0,0 +1,13 @@
PC ORG @ 0x12 + ! ( pushRS )
IX INCss,
IX INCss,
0 IX+ L LDIXYr,
1 IX+ H LDIXYr,
RET,
PC ORG @ 0x15 + ! ( popRS )
L 0 IX+ LDrIXY,
H 1 IX+ LDrIXY,
IX DECss,
IX DECss,
RET,

7
blk/298 Normal file
View File

@ -0,0 +1,7 @@
'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A,
L2 BSET ( abortUnderflow )
HL PC 7 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
0x03 CALLnn, ( find )
0x33 JPnn, ( 33 == execute )

14
blk/299 Normal file
View File

@ -0,0 +1,14 @@
PC ORG @ 0x1e + ! ( chkPS )
HL PUSHqq,
RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
( We have the return address for this very call on the stack
and protected registers. Let's compensate )
HL DECss,
HL DECss,
HL DECss,
HL DECss,
SP SUBHLss,
HL POPqq,
CNC RETcc, ( INITIAL_SP >= SP? good )
JR, L2 BWR ( abortUnderflow-B298 )

16
blk/300 Normal file
View File

@ -0,0 +1,16 @@
PC ORG @ 0x1b + ! ( next )
( This routine is jumped to at the end of every word. In it,
we jump to current IP, but we also take care of increasing
it by 2 before jumping. )
( Before we continue: are stacks within bounds? )
0x1d CALLnn, ( chkPS )
( check RS )
IX PUSHqq, HL POPqq,
DE RS_ADDR LDddnn,
DE SUBHLss,
JRC, L2 BWR ( IX < RS_ADDR? abortUnderflow-B298 )
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
IY INCss,
IY INCss,
( continue to execute )

12
blk/301 Normal file
View File

@ -0,0 +1,12 @@
L3 BSET
PC ORG @ 0x34 + ! ( execute )
( DE points to wordref )
EXDEHL,
E (HL) LDrr,
D 0 LDrn,
EXDEHL,
( HL points to code pointer )
DE INCss,
( DE points to PFA )
JP(HL),

16
blk/302 Normal file
View File

@ -0,0 +1,16 @@
L1 BSET
PC ORG @ 0x0f + ! ( compiledWord )
( 1. Push current IP to RS
2. Set new IP to the second atom of the list
3. Execute the first atom of the list. )
IY PUSHqq, HL POPqq, ( <-- IP )
0x11 CALLnn, ( 11 == pushRS )
EXDEHL, ( HL points to PFA )
( While we increase, dereference into DE for execute call
later. )
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
HL INCss,
HL PUSHqq, IY POPqq, ( --> IP )
JR, L3 BWR ( execute-B301 )

5
blk/303 Normal file
View File

@ -0,0 +1,5 @@
PC ORG @ 0x0c + ! ( cellWord )
( Pushes PFA directly )
DE PUSHqq,
JPNEXT,

16
blk/304 Normal file
View File

@ -0,0 +1,16 @@
PC ORG @ 0x2c + ! ( doesWord )
( The word was spawned from a definition word that has a
DOES>. PFA+2 (right after the actual cell) is a link to the
slot right after that DOES>. Therefore, what we need to do
push the cell addr like a regular cell, then follow the
linkfrom the PFA, and then continue as a regular
compiledWord. )
DE PUSHqq, ( like a regular cell )
EXDEHL,
HL INCss,
HL INCss,
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
JR, L1 BWR ( compiledWord-B302 )

9
blk/305 Normal file
View File

@ -0,0 +1,9 @@
( Core words )
( KEY and EMIT are not defined here. There're
expected to be defined in platform-specific code. )
CODE EXECUTE
DE POPqq,
chkPS,
JR, L3 BWR ( execute-B301 )

11
blk/306 Normal file
View File

@ -0,0 +1,11 @@
( a b c -- b c a )
CODE ROT
HL POPqq, ( C )
DE POPqq, ( B )
BC POPqq, ( A )
chkPS,
DE PUSHqq, ( B )
HL PUSHqq, ( C )
BC PUSHqq, ( A )
;CODE

13
blk/307 Normal file
View File

@ -0,0 +1,13 @@
( a -- a a )
CODE DUP
HL POPqq, ( A )
chkPS,
HL PUSHqq, ( A )
HL PUSHqq, ( A )
;CODE
( a -- )
CODE DROP
HL POPqq,
;CODE

10
blk/308 Normal file
View File

@ -0,0 +1,10 @@
( a b -- b a )
CODE SWAP
HL POPqq, ( B )
DE POPqq, ( A )
chkPS,
HL PUSHqq, ( B )
DE PUSHqq, ( A )
;CODE

11
blk/309 Normal file
View File

@ -0,0 +1,11 @@
( a b -- a b a )
CODE OVER
HL POPqq, ( B )
DE POPqq, ( A )
chkPS,
DE PUSHqq, ( A )
HL PUSHqq, ( B )
DE PUSHqq, ( A )
;CODE

16
blk/310 Normal file
View File

@ -0,0 +1,16 @@
CODE PICK
HL POPqq,
chkPS,
( x2 )
L SLAr, H RLr,
SP ADDHLss,
C (HL) LDrr,
HL INCss,
B (HL) LDrr,
( check PS range before returning )
EXDEHL,
RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
DE SUBHLss,
CC L2 @ JPccnn, ( abortUnderflow-B298 )
BC PUSHqq,
;CODE

15
blk/311 Normal file
View File

@ -0,0 +1,15 @@
( Low-level part of ROLL. Example:
"1 2 3 4 4 (roll)" --> "1 3 4 4". No sanity checks, never
call with 0. )
CODE (roll)
HL POPqq,
B H LDrr,
C L LDrr,
SP ADDHLss,
HL INCss,
D H LDrr,
E L LDrr,
HL DECss,
HL DECss,
LDDR,
;CODE

8
blk/312 Normal file
View File

@ -0,0 +1,8 @@
( a b -- )
CODE 2DROP
HL POPqq,
HL POPqq,
chkPS,
;CODE

11
blk/313 Normal file
View File

@ -0,0 +1,11 @@
CODE S0
RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
HL PUSHqq,
;CODE
CODE 'S
HL 0 LDddnn,
SP ADDHLss,
HL PUSHqq,
;CODE

14
blk/314 Normal file
View File

@ -0,0 +1,14 @@
CODE AND
HL POPqq,
DE POPqq,
chkPS,
A E LDrr,
L ANDr,
L A LDrr,
A D LDrr,
H ANDr,
H A LDrr,
HL PUSHqq,
;CODE

12
blk/315 Normal file
View File

@ -0,0 +1,12 @@
CODE OR
HL POPqq,
DE POPqq,
chkPS,
A E LDrr,
L ORr,
L A LDrr,
A D LDrr,
H ORr,
H A LDrr,
HL PUSHqq,
;CODE

12
blk/316 Normal file
View File

@ -0,0 +1,12 @@
CODE XOR
HL POPqq,
DE POPqq,
chkPS,
A E LDrr,
L XORr,
L A LDrr,
A D LDrr,
H XORr,
H A LDrr,
HL PUSHqq,
;CODE

8
blk/317 Normal file
View File

@ -0,0 +1,8 @@
CODE NOT
HL POPqq,
chkPS,
A L LDrr,
H ORr,
PUSHZ,
;CODE

15
blk/318 Normal file
View File

@ -0,0 +1,15 @@
CODE +
HL POPqq,
DE POPqq,
chkPS,
DE ADDHLss,
HL PUSHqq,
;CODE
CODE -
DE POPqq,
HL POPqq,
chkPS,
DE SUBHLss,
HL PUSHqq,
;CODE

16
blk/319 Normal file
View File

@ -0,0 +1,16 @@
CODE * ( DE * BC -> DE (high) and HL (low) )
DE POPqq, BC POPqq, chkPS,
HL 0 LDddnn,
A 0x10 LDrn,
( loop )
HL ADDHLss,
E RLr, D RLr,
JRNC, 4 A, ( noinc )
BC ADDHLss,
JRNC, 1 A, ( noinc )
DE INCss,
( noinc )
A DECr,
JRNZ, -14 A, ( loop )
HL PUSHqq,
;CODE

16
blk/320 Normal file
View File

@ -0,0 +1,16 @@
( Borrowed from http://wikiti.brandonw.net/ )
( Divides AC by DE and places the quotient in AC and the
remainder in HL )
CODE /MOD
DE POPqq,
BC POPqq,
chkPS,
A B LDrr,
B 16 LDrn,
HL 0 LDddnn,
( cont. )

15
blk/321 Normal file
View File

@ -0,0 +1,15 @@
BEGIN, ( loop )
SCF,
C RLr,
RLA,
HL ADCHLss,
DE SBCHLss,
IFC,
DE ADDHLss,
C DECr,
THEN,
DJNZ, AGAIN, ( loop )
B A LDrr,
HL PUSHqq,
BC PUSHqq,
;CODE

16
blk/322 Normal file
View File

@ -0,0 +1,16 @@
CODE !
HL POPqq,
DE POPqq,
chkPS,
(HL) E LDrr,
HL INCss,
(HL) D LDrr,
;CODE
CODE @
HL POPqq,
chkPS,
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
DE PUSHqq,
;CODE

14
blk/323 Normal file
View File

@ -0,0 +1,14 @@
CODE C!
HL POPqq,
DE POPqq,
chkPS,
(HL) E LDrr,
;CODE
CODE C@
HL POPqq,
chkPS,
L (HL) LDrr,
H 0 LDrn,
HL PUSHqq,
;CODE

15
blk/324 Normal file
View File

@ -0,0 +1,15 @@
CODE PC!
BC POPqq,
HL POPqq,
chkPS,
L OUT(C)r,
;CODE
CODE PC@
BC POPqq,
chkPS,
H 0 LDrn,
L INr(C),
HL PUSHqq,
;CODE

16
blk/325 Normal file
View File

@ -0,0 +1,16 @@
CODE I
L 0 IX+ LDrIXY,
H 1 IX+ LDrIXY,
HL PUSHqq,
;CODE
CODE I'
L 2 IX- LDrIXY,
H 1 IX- LDrIXY,
HL PUSHqq,
;CODE
CODE J
L 4 IX- LDrIXY,
H 3 IX- LDrIXY,
HL PUSHqq,
;CODE

13
blk/326 Normal file
View File

@ -0,0 +1,13 @@
CODE >R
HL POPqq,
chkPS,
( 17 == pushRS )
17 CALLnn,
;CODE
CODE R>
( 20 == popRS )
20 CALLnn,
HL PUSHqq,
;CODE

14
blk/327 Normal file
View File

@ -0,0 +1,14 @@
CODE BYE
HALT,
;CODE
CODE (resSP)
( INITIAL_SP == RAM+0 )
SP RAMSTART LDdd(nn),
;CODE
CODE (resRS)
IX RS_ADDR LDddnn,
;CODE

16
blk/328 Normal file
View File

@ -0,0 +1,16 @@
CODE S=
DE POPqq,
HL POPqq,
chkPS,
BEGIN, ( loop )
LDA(DE),
(HL) CPr,
JRNZ, L1 FWR ( not equal? break early to "end".
NZ is set. )
A ORr, ( if our char is null, stop )
HL INCss,
DE INCss,
JRNZ, AGAIN, ( loop )
L1 FSET ( end )
PUSHZ,
;CODE

16
blk/329 Normal file
View File

@ -0,0 +1,16 @@
CODE CMP
HL POPqq,
DE POPqq,
chkPS,
DE SUBHLss,
BC 0 LDddnn,
IFNZ, ( < or > )
BC INCss,
IFNC, ( < )
BC DECss,
BC DECss,
THEN,
THEN,
BC PUSHqq,
;CODE

16
blk/330 Normal file
View File

@ -0,0 +1,16 @@
CODE _find ( cur w -- a f )
HL POPqq, ( w )
DE POPqq, ( cur )
chkPS,
( 3 == find )
3 CALLnn,
IFNZ,
( not found )
HL PUSHqq,
PUSH0,
JPNEXT,
THEN,
( found )
DE PUSHqq,
PUSH1,
;CODE

14
blk/331 Normal file
View File

@ -0,0 +1,14 @@
CODE (im1)
IM1,
EI,
;CODE
CODE 0 PUSH0, ;CODE
CODE 1 PUSH1, ;CODE
CODE -1
HL -1 LDddnn,
HL PUSHqq,
;CODE

14
blk/332 Normal file
View File

@ -0,0 +1,14 @@
CODE 1+
HL POPqq,
chkPS,
HL INCss,
HL PUSHqq,
;CODE
CODE 1-
HL POPqq,
chkPS,
HL DECss,
HL PUSHqq,
;CODE

16
blk/333 Normal file
View File

@ -0,0 +1,16 @@
CODE 2+
HL POPqq,
chkPS,
HL INCss,
HL INCss,
HL PUSHqq,
;CODE
CODE 2-
HL POPqq,
chkPS,
HL DECss,
HL DECss,
HL PUSHqq,
;CODE

1
emul/Makefile
View File

@ -2,7 +2,6 @@ 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 \ BOOTSRCS = ./forth/conf.fs \
./forth/xcomp.fs \ ./forth/xcomp.fs \
../forth/boot.z80 \
../forth/icore.fs \ ../forth/icore.fs \
./forth/xstop.fs ./forth/xstop.fs

3
emul/forth/xcomp.fs
View File

@ -1,4 +1,4 @@
262 LOAD 262 LOAD ( xcomp )
: CODE XCODE ; : CODE XCODE ;
: IMMEDIATE XIMM ; : IMMEDIATE XIMM ;
: : [ ' X: , ] ; : : [ ' X: , ] ;
@ -7,3 +7,4 @@ CURRENT @ XCURRENT !
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!
H@ XOFF ! H@ XOFF !
282 LOAD ( boot.z80 )

BIN
emul/forth/z80c.bin
View File

Binary file not shown.

3
forth/blk.fs
View File

@ -86,3 +86,6 @@
R> DROP ( BLK> ) R> DROP ( BLK> )
THEN THEN
; ;
( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;

764
forth/boot.z80
View File

@ -1,764 +0,0 @@
( Configuration words: RAMSTART, RS_ADDR )
H@ 256 /MOD 2 PC! 2 PC!
( RESERVED REGISTERS
At all times, IX points to RSP TOS and IY is IP. SP points
to PSP TOS, but you can still use the stack in native code.
you just have to make sure you've restored it before "next".
STABLE ABI
Those jumps below are supposed to stay at these offsets,
always. If they change bootstrap binaries have to be
adjusted because they rely on them. Those entries are
referenced directly by their offset in Forth code with a
comment indicating what that number refers to.
)
H@ ORG !
0 JPnn, ( 00, main )
0 JPnn, ( 03, find )
NOP, NOP, ( 06, unused )
NOP, NOP, ( 08, LATEST )
NOP, ( 0a, unused )
0 JPnn, ( 0b, cellWord )
0 JPnn, ( 0e, compiledWord )
0 JPnn, ( 11, pushRS )
0 JPnn, ( 14, popRS )
EXDEHL, JP(HL), NOP, ( 17, nativeWord )
0 JPnn, ( 1a, next )
0 JPnn, ( 1d, chkPS )
NOP, NOP, ( 20, numberWord )
NOP, NOP, ( 22, litWord )
NOP, NOP, ( 24, addrWord )
NOP, NOP, ( 26, unused )
RAMSTART 0x4e + JPnn, ( 28, RST 28 )
0 JPnn, ( 2b, doesWord )
NOP, NOP, ( 2e, unused )
RAMSTART 0x4e + JPnn, ( RST 30 )
0 JPnn, ( 33, execute )
NOP, NOP, ( unused )
RAMSTART 0x4e + JPnn, ( RST 38 )
( BOOT DICT
There are only 3 words in the boot dict, but these words'
offset need to be stable, so they're part of the "stable
ABI"
)
'E' A, 'X' A, 'I' A, 'T' A,
0 A,, ( prev )
4 A,
H@ XCURRENT ! ( set current tip of dict, 0x42 )
0x17 A, ( nativeWord )
0x14 CALLnn, ( popRS )
HL PUSHqq, IY POPqq, ( --> IP )
JPNEXT,
CODE (br) ( 0x53 )
L2 BSET ( used in CBR )
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
DE ADDIYss,
JPNEXT,
CODE (?br) ( 0x67 )
HL POPqq,
chkPS,
A H LDrr,
L ORr,
JRZ, L2 BWR ( BR + 2. False, branch )
( True, skip next 2 bytes and don't branch )
IY INCss,
IY INCss,
JPNEXT,
( END OF STABLE ABI )
( We want numberWord and litWord routine to be below the 0x100
offset so that we can reduce the size of the routine field
in words to 1 byte. )
( addrWord is the exact same thing as a numberWord except that
it is treated differently by meta-tools. See notes.txt )
PC ORG @ 0x20 + ! ( numberWord )
PC ORG @ 0x24 + ! ( addrWord )
( This is not a word, but a number literal. This works a bit
differently than others: PF means nothing and the actual
number is placed next to the numberWord reference in the
compiled word list. What we need to do to fetch that number
is to play with the IP.
)
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
IY INCss,
IY INCss,
DE PUSHqq,
JPNEXT,
PC ORG @ 0x22 + ! ( litWord )
( Similarly to numberWord, this is not a real word, but a
string literal. Instead of being followed by a 2 bytes
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )
IY PUSHqq, HL POPqq, ( <-- IP )
HL PUSHqq,
( skip to null char )
A XORr, ( look for null )
B A LDrr,
C A LDrr,
CPIR,
( CPIR advances HL regardless of comparison, so goes one
char after NULL. This is good, because that's what we
want... )
HL PUSHqq, IY POPqq, ( --> IP )
JPNEXT,
( Name of BOOT word )
L1 BSET
'B' A, 'O' A, 'O' A, 'T' A, 0 A,
PC ORG @ 1 + ! ( main )
( STACK OVERFLOW PROTECTION:
To avoid having to check for stack underflow after each pop
operation (which can end up being prohibitive in terms of
costs), we give ourselves a nice 6 bytes buffer. 6 bytes
because we seldom have words requiring more than 3 items
from the stack. Then, at each "exit" call we check for
stack underflow.
)
SP 0xfffa LDddnn,
RAMSTART SP LD(nn)dd, ( RAM+00 == INITIAL_SP )
IX RS_ADDR LDddnn,
( HERE begins at RAMEND )
HL RAMSTART 0x80 + LDddnn,
RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
( LATEST is a label to the latest entry of the dict. It is
written at offset 0x08 by the process or person building
Forth. )
0x08 LDHL(nn),
RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT )
EXDEHL,
HL L1 @ LDddnn,
0x03 CALLnn, ( 03 == find )
0x33 JPnn, ( 33 == execute )
PC ORG @ 4 + ! ( find )
( Find the entry corresponding to word name where (HL) points
to in dictionary having its tip at DE and sets DE to point
to that entry. Z if found, NZ if not.
)
BC PUSHqq,
HL PUSHqq,
( First, figure out string len )
BC 0 LDddnn,
A XORr,
CPIR,
( C has our length, negative, -1 )
A C LDrr,
NEG,
A DECr,
( special case. zero len? we never find anything. )
JRZ, L1 FWR ( fail )
C A LDrr, ( C holds our length )
( Let's do something weird: We'll hold HL by the *tail*.
Because of our dict structure and because we know our
lengths, it's easier to compare starting from the end.
Currently, after CPIR, HL points to char after null. Let's
adjust. Because the compare loop pre-decrements, instead
of DECing HL twice, we DEC it once. )
HL DECss,
BEGIN, ( inner )
( DE is a wordref, first step, do our len correspond? )
HL PUSHqq, ( --> lvl 1 )
DE PUSHqq, ( --> lvl 2 )
DE DECss,
LDA(DE),
0x7f ANDn, ( remove IMMEDIATE flag )
C CPr,
JRNZ, L2 FWR ( loopend )
( match, let's compare the string then )
DE DECss, ( Skip prev field. One less because we )
DE DECss, ( pre-decrement )
B C LDrr, ( loop C times )
BEGIN, ( loop )
( pre-decrement for easier Z matching )
DE DECss,
HL DECss,
LDA(DE),
(HL) CPr,
JRNZ, L3 FWR ( loopend )
DJNZ, AGAIN, ( loop )
L2 FSET L3 FSET ( loopend )
( At this point, Z is set if we have a match. In all cases,
we want to pop HL and DE )
DE POPqq, ( <-- lvl 2 )
HL POPqq, ( <-- lvl 1 )
JRZ, L2 FWR ( end, match? we're done! )
( no match, go to prev and continue )
HL PUSHqq, ( --> lvl 1 )
DE DECss,
DE DECss,
DE DECss, ( prev field )
DE PUSHqq, ( --> lvl 2 )
EXDEHL,
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
( DE conains prev offset )
HL POPqq, ( <-- lvl 2 )
( HL is prev field's addr. Is offset zero? )
A D LDrr,
E ORr,
IFNZ, ( noprev )
( get absolute addr from offset )
( carry cleared from "or e" )
DE SBCHLss,
EXDEHL, ( result in DE )
THEN, ( noprev )
HL POPqq, ( <-- lvl 1 )
JRNZ, AGAIN, ( inner, try to match again )
( Z set? end of dict, unset Z )
L1 FSET ( fail )
A XORr,
A INCr,
L2 FSET ( end )
HL POPqq,
BC POPqq,
RET,
PC ORG @ 0x12 + ! ( pushRS )
IX INCss,
IX INCss,
0 IX+ L LDIXYr,
1 IX+ H LDIXYr,
RET,
PC ORG @ 0x15 + ! ( popRS )
L 0 IX+ LDrIXY,
H 1 IX+ LDrIXY,
IX DECss,
IX DECss,
RET,
'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A,
L2 BSET ( abortUnderflow )
HL PC 7 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
0x03 CALLnn, ( find )
0x33 JPnn, ( 33 == execute )
PC ORG @ 0x1e + ! ( chkPS )
HL PUSHqq,
RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
( We have the return address for this very call on the stack
and protected registers. Let's compensate )
HL DECss,
HL DECss,
HL DECss,
HL DECss,
SP SUBHLss,
HL POPqq,
CNC RETcc, ( INITIAL_SP >= SP? good )
JR, L2 BWR ( abortUnderflow )
PC ORG @ 0x1b + ! ( next )
( This routine is jumped to at the end of every word. In it,
we jump to current IP, but we also take care of increasing
it by 2 before jumping. )
( Before we continue: are stacks within bounds? )
0x1d CALLnn, ( chkPS )
( check RS )
IX PUSHqq, HL POPqq,
DE RS_ADDR LDddnn,
DE SUBHLss,
JRC, L2 BWR ( IX < RS_ADDR? abortUnderflow )
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
IY INCss,
IY INCss,
( continue to execute )
L3 BSET
PC ORG @ 0x34 + ! ( execute )
( DE points to wordref )
EXDEHL,
E (HL) LDrr,
D 0 LDrn,
EXDEHL,
( HL points to code pointer )
DE INCss,
( DE points to PFA )
JP(HL),
L1 BSET
PC ORG @ 0x0f + ! ( compiledWord )
( Execute a list of atoms, which always end with EXIT.
DE points to that list. What do we do:
1. Push current IP to RS
2. Set new IP to the second atom of the list
3. Execute the first atom of the list. )
IY PUSHqq, HL POPqq, ( <-- IP )
0x11 CALLnn, ( 11 == pushRS )
EXDEHL, ( HL points to PFA )
( While we increase, dereference into DE for execute call
later. )
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
HL INCss,
HL PUSHqq, IY POPqq, ( --> IP )
JR, L3 BWR ( execute )
PC ORG @ 0x0c + ! ( cellWord )
( Pushes PFA directly )
DE PUSHqq,
JPNEXT,
PC ORG @ 0x2c + ! ( doesWord )
( The word was spawned from a definition word that has a
DOES>. PFA+2 (right after the actual cell) is a link to the
slot right after that DOES>. Therefore, what we need to do
push the cell addr like a regular cell, then follow the
linkfrom the PFA, and then continue as a regular
compiledWord.
)
DE PUSHqq, ( like a regular cell )
EXDEHL,
HL INCss,
HL INCss,
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
JR, L1 BWR ( compiledWord )
( Core words )
KEY and EMIT are not defined here. There're
expected to be defined in platform-specific code. )
CODE EXECUTE
DE POPqq,
chkPS,
JR, L3 BWR ( execute )
( a b c -- b c a )
CODE ROT
HL POPqq, ( C )
DE POPqq, ( B )
BC POPqq, ( A )
chkPS,
DE PUSHqq, ( B )
HL PUSHqq, ( C )
BC PUSHqq, ( A )
;CODE
( a -- a a )
CODE DUP
HL POPqq, ( A )
chkPS,
HL PUSHqq, ( A )
HL PUSHqq, ( A )
;CODE
( a -- )
CODE DROP
HL POPqq,
;CODE
( a b -- b a )
CODE SWAP
HL POPqq, ( B )
DE POPqq, ( A )
chkPS,
HL PUSHqq, ( B )
DE PUSHqq, ( A )
;CODE
( a b -- a b a )
CODE OVER
HL POPqq, ( B )
DE POPqq, ( A )
chkPS,
DE PUSHqq, ( A )
HL PUSHqq, ( B )
DE PUSHqq, ( A )
;CODE
CODE PICK
HL POPqq,
chkPS,
( x2 )
L SLAr,
H RLr,
SP ADDHLss,
C (HL) LDrr,
HL INCss,
B (HL) LDrr,
( check PS range before returning )
EXDEHL,
RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
DE SUBHLss,
CC L2 @ JPccnn, ( abortUnderflow )
BC PUSHqq,
;CODE
( this is only a part of ROLL, the other part is performed in
high level Forth. This receives from PSP the number of bytes
to copy and then performs A move-by-2 operation from SP.
This copies SP's TOS and overwrites the last item involved.
For example, if stack is "1 2 3 4", calling with "4" would
result in the stack "1 3 4 4". Never call with 0, there is
no sanity check.
)
CODE (roll)
HL POPqq,
B H LDrr,
C L LDrr,
SP ADDHLss,
HL INCss,
D H LDrr,
E L LDrr,
HL DECss,
HL DECss,
LDDR,
;CODE
( a b -- )
CODE 2DROP
HL POPqq,
HL POPqq,
chkPS,
;CODE
CODE S0
RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
HL PUSHqq,
;CODE
CODE 'S
HL 0 LDddnn,
SP ADDHLss,
HL PUSHqq,
;CODE
CODE AND
HL POPqq,
DE POPqq,
chkPS,
A E LDrr,
L ANDr,
L A LDrr,
A D LDrr,
H ANDr,
H A LDrr,
HL PUSHqq,
;CODE
CODE OR
HL POPqq,
DE POPqq,
chkPS,
A E LDrr,
L ORr,
L A LDrr,
A D LDrr,
H ORr,
H A LDrr,
HL PUSHqq,
;CODE
CODE XOR
HL POPqq,
DE POPqq,
chkPS,
A E LDrr,
L XORr,
L A LDrr,
A D LDrr,
H XORr,
H A LDrr,
HL PUSHqq,
;CODE
CODE NOT
HL POPqq,
chkPS,
A L LDrr,
H ORr,
HL 0 LDddnn,
IFZ,
( false, make 1 )
HL INCss,
THEN,
HL PUSHqq,
;CODE
CODE +
HL POPqq,
DE POPqq,
chkPS,
DE ADDHLss,
HL PUSHqq,
;CODE
CODE -
DE POPqq,
HL POPqq,
chkPS,
DE SUBHLss,
HL PUSHqq,
;CODE
CODE *
DE POPqq,
BC POPqq,
chkPS,
( DE * BC -> DE (high) and HL (low) )
HL 0 LDddnn,
A 0x10 LDrn,
( loop )
HL ADDHLss,
E RLr,
D RLr,
JRNC, 4 A, ( noinc )
BC ADDHLss,
JRNC, 1 A, ( noinc )
DE INCss,
( noinc )
A DECr,
JRNZ, -14 A, ( loop )
HL PUSHqq,
;CODE
( Borrowed from http://wikiti.brandonw.net/ )
( Divides AC by DE and places the quotient in AC and the
remainder in HL )
CODE /MOD
DE POPqq,
BC POPqq,
chkPS,
A B LDrr,
B 16 LDrn,
HL 0 LDddnn,
BEGIN, ( loop )
SCF,
C RLr,
RLA,
HL ADCHLss,
DE SBCHLss,
IFC,
DE ADDHLss,
C DECr,
THEN,
DJNZ, AGAIN, ( loop )
B A LDrr,
HL PUSHqq,
BC PUSHqq,
;CODE
CODE !
HL POPqq,
DE POPqq,
chkPS,
(HL) E LDrr,
HL INCss,
(HL) D LDrr,
;CODE
CODE @
HL POPqq,
chkPS,
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
DE PUSHqq,
;CODE
CODE C!
HL POPqq,
DE POPqq,
chkPS,
(HL) E LDrr,
;CODE
CODE C@
HL POPqq,
chkPS,
L (HL) LDrr,
H 0 LDrn,
HL PUSHqq,
;CODE
CODE PC!
BC POPqq,
HL POPqq,
chkPS,
L OUT(C)r,
;CODE
CODE PC@
BC POPqq,
chkPS,
H 0 LDrn,
L INr(C),
HL PUSHqq,
;CODE
CODE I
L 0 IX+ LDrIXY,
H 1 IX+ LDrIXY,
HL PUSHqq,
;CODE
CODE I'
L 2 IX- LDrIXY,
H 1 IX- LDrIXY,
HL PUSHqq,
;CODE
CODE J
L 4 IX- LDrIXY,
H 3 IX- LDrIXY,
HL PUSHqq,
;CODE
CODE >R
HL POPqq,
chkPS,
( 17 == pushRS )
17 CALLnn,
;CODE
CODE R>
( 20 == popRS )
20 CALLnn,
HL PUSHqq,
;CODE
CODE BYE
HALT,
;CODE
CODE (resSP)
( INITIAL_SP == RAM+0 )
SP RAMSTART LDdd(nn),
;CODE
CODE (resRS)
IX RS_ADDR LDddnn,
;CODE
CODE S=
DE POPqq,
HL POPqq,
chkPS,
( pre-push false )
BC 0 LDddnn,
BC PUSHqq,
BEGIN, ( loop )
LDA(DE),
(HL) CPr,
JRNZ, L1 FWR ( not equal? break early to "end".
NZ is set. )
A ORr, ( if our char is null, stop )
HL INCss,
DE INCss,
JRNZ, AGAIN, ( loop )
( success, change false to true )
HL POPqq,
HL INCss,
HL PUSHqq,
L1 FSET ( end )
;CODE
CODE CMP
HL POPqq,
DE POPqq,
chkPS,
DE SUBHLss,
BC 0 LDddnn,
IFNZ,
( not equal )
BC INCss,
IFNC,
( < )
BC DECss,
BC DECss,
THEN,
THEN,
BC PUSHqq,
;CODE
( cur w -- a f )
CODE _find
HL POPqq, ( w )
DE POPqq, ( cur )
chkPS,
( 3 == find )
3 CALLnn,
IFNZ,
( not found )
HL PUSHqq,
DE 0 LDddnn,
DE PUSHqq,
JPNEXT,
THEN,
( found )
DE PUSHqq,
DE 1 LDddnn,
DE PUSHqq,
;CODE
CODE (im1)
IM1,
EI,
;CODE
CODE 0
HL 0 LDddnn,
HL PUSHqq,
;CODE
CODE 1
HL 1 LDddnn,
HL PUSHqq,
;CODE
CODE -1
HL -1 LDddnn,
HL PUSHqq,
;CODE
CODE 1+
HL POPqq,
chkPS,
HL INCss,
HL PUSHqq,
;CODE
CODE 1-
HL POPqq,
chkPS,
HL DECss,
HL PUSHqq,
;CODE
CODE 2+
HL POPqq,
chkPS,
HL INCss,
HL INCss,
HL PUSHqq,
;CODE
CODE 2-
HL POPqq,
chkPS,
HL DECss,
HL DECss,
HL PUSHqq,
;CODE

1
recipes/rc2014/Makefile
View File

@ -6,7 +6,6 @@ STAGE2 = $(EDIR)/stage2
EMUL = $(BASEDIR)/emul/hw/rc2014/classic EMUL = $(BASEDIR)/emul/hw/rc2014/classic
BOOTSRCS = conf.fs \ BOOTSRCS = conf.fs \
$(EDIR)/xcomp.fs \ $(EDIR)/xcomp.fs \
$(FDIR)/boot.z80 \
$(BASEDIR)/drv/acia.z80 \ $(BASEDIR)/drv/acia.z80 \
$(BASEDIR)/drv/sdc.z80 \ $(BASEDIR)/drv/sdc.z80 \
$(FDIR)/icore.fs \ $(FDIR)/icore.fs \