1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-01 21:30:55 +11:00
collapseos/forth/z80a.fs
Virgil Dupras d0c5d3a741 Forth self-bootstraps!!!
This commit cuts Forth's dependency on zasm. It now self-assembles
its own boot-binary! Things are a bit messy now, I'll clean up
later.
2020-04-01 22:19:37 -04:00

360 lines
6.5 KiB
Forth

( Z80 assembler )
( Splits word into msb/lsb, lsb being on TOS )
: SPLITB
256 /MOD SWAP
;
( H@ offset at which we consider our PC 0. Used to compute
PC. To have a proper PC, call "H@ ORG !" at the beginning
of your assembly process. )
(sysv) ORG
: PC H@ ORG @ - ;
( A, spits an assembled byte, A,, spits an assembled word
Both increase PC. To debug, change C, to .X )
: A, C, ;
: A,, SPLITB A, A, ;
( Labels are a convenient way of managing relative jump
calculations. Backward labels are easy. It is only a matter
or recording "HERE" and do subtractions. Forward labels
record the place where we should write the offset, and then
when we get to that point later on, the label records the
offset there.
To avoid using dict memory in compilation targets, we
pre-declare label variables here, which means we have a
limited number of it. For now, 6 ought to be enough. )
(sysv) L1
(sysv) L2
(sysv) L3
(sysv) L4
(sysv) L5
(sysv) L6
( There are 2 label types: backward and forward. For each
type, there are two actions: set and write. Setting a label
is declaring where it is. It has to be performed at the
label's destination. Writing a label is writing its offset
difference to the binary result. It has to be done right
after a relative jump operation. Yes, labels are only for
relative jumps.
For backward labels, set happens before write. For forward
labels, write happen before set. The write operation writes
a dummy placeholder, and then the set operation writes the
offset at that placeholder's address.
Variable actions are expected to be called with labels in
front of them. Example, "L2 FSET"
About that "1 -": z80 relative jumps record "e-2", that is,
the offset that *counts the 2 bytes of the jump itself*.
Because we set the label *after* the jump OP1 itself, that's
1 byte that is taken care of. We still need to adjust by
another byte before writing the offset.
)
: BSET PC SWAP ! ;
: BWR @ PC - 1 - A, ;
( same as BSET, but we need to write a placeholder )
: FWR BSET 0 A, ;
: FSET
@ DUP PC ( l l pc )
-^ 1 - ( l off )
( warning: l is a PC offset, not a mem addr! )
SWAP ORG @ + ( off addr )
C!
;
( "r" register constants )
7 CONSTANT A
0 CONSTANT B
1 CONSTANT C
2 CONSTANT D
3 CONSTANT E
4 CONSTANT H
5 CONSTANT L
6 CONSTANT (HL)
( "ss" register constants )
0 CONSTANT BC
1 CONSTANT DE
2 CONSTANT HL
3 CONSTANT AF
3 CONSTANT SP
( "cc" condition constants )
0 CONSTANT CNZ
1 CONSTANT CZ
2 CONSTANT CNC
3 CONSTANT CC
4 CONSTANT CPO
5 CONSTANT CPE
6 CONSTANT CP
7 CONSTANT CM
( As a general rule, IX and IY are equivalent to spitting an
extra 0xdd / 0xfd and then spit the equivalent of HL )
: IX 0xdd A, HL ;
: IY 0xfd A, HL ;
: _ix+- 0xff AND 0xdd A, (HL) ;
: _iy+- 0xff AND 0xfd A, (HL) ;
: IX+ _ix+- ;
: IX- 0 -^ _ix+- ;
: IY+ _iy+- ;
: IY- 0 -^ _iy+- ;
: <<3 8 * ;
: <<4 16 * ;
( -- )
: OP1 CREATE C, DOES> C@ A, ;
0xeb OP1 EXDEHL,
0xd9 OP1 EXX,
0x76 OP1 HALT,
0xe9 OP1 JP(HL),
0x12 OP1 LD(DE)A,
0x1a OP1 LDA(DE),
0x00 OP1 NOP,
0xc9 OP1 RET,
0x17 OP1 RLA,
0x07 OP1 RLCA,
0x1f OP1 RRA,
0x0f OP1 RRCA,
0x37 OP1 SCF,
( Relative jumps are a bit special. They're supposed to take
an argument, but they don't take it so they can work with
the label system. Therefore, relative jumps are an OP1 but
when you use them, you're expected to write the offset
afterwards yourself. )
0x18 OP1 JR,
0x38 OP1 JRC,
0x30 OP1 JRNC,
0x28 OP1 JRZ,
0x20 OP1 JRNZ,
0x10 OP1 DJNZ,
( r -- )
: OP1r
CREATE C,
DOES>
C@ ( r op )
SWAP ( op r )
<<3 ( op r<<3 )
OR A,
;
0x04 OP1r INCr,
0x05 OP1r DECr,
( also works for cc )
0xc0 OP1r RETcc,
( r -- )
: OP1r0
CREATE C,
DOES>
C@ ( r op )
OR A,
;
0x80 OP1r0 ADDr,
0x88 OP1r0 ADCr,
0xa0 OP1r0 ANDr,
0xb8 OP1r0 CPr,
0xb0 OP1r0 ORr,
0x90 OP1r0 SUBr,
0x98 OP1r0 SBCr,
0xa8 OP1r0 XORr,
( qq -- also works for ss )
: OP1qq
CREATE C,
DOES>
C@ ( qq op )
SWAP ( op qq )
<<4 ( op qq<<4 )
OR A,
;
0xc5 OP1qq PUSHqq,
0xc1 OP1qq POPqq,
0x03 OP1qq INCss,
0x0b OP1qq DECss,
0x09 OP1qq ADDHLss,
: _1rr
C@ ( rd rr op )
ROT ( rr op rd )
<<3 ( rr op rd<<3 )
OR OR A,
;
( rd rr )
: OP1rr
CREATE C,
DOES>
_1rr
;
0x40 OP1rr LDrr,
( ixy+- HL rd )
: LDIXYr,
( dd/fd has already been spit )
LDrr, ( ixy+- )
A,
;
( rd ixy+- HL )
: LDrIXY,
ROT ( ixy+- HL rd )
SWAP ( ixy+- rd HL )
LDIXYr,
;
: OP2 CREATE , DOES> @ 256 /MOD A, A, ;
0xedb1 OP2 CPIR,
0xed44 OP2 NEG,
( n -- )
: OP2n
CREATE C,
DOES>
C@ A, A,
;
0xd3 OP2n OUTnA,
0xdb OP2n INAn,
0xc6 OP2n ADDn,
0xe6 OP2n ANDn,
0xf6 OP2n Orn,
0xd6 OP2n SUBn,
( r n -- )
: OP2rn
CREATE C,
DOES>
C@ ( r n op )
ROT ( n op r )
<<3 ( n op r<<3 )
OR A, A,
;
0x06 OP2rn LDrn,
( b r -- )
: OP2br
CREATE C,
DOES>
0xcb A,
C@ ( b r op )
ROT ( r op b )
<<3 ( r op b<<3 )
OR OR A,
;
0xc0 OP2br SETbr,
0x80 OP2br RESbr,
0x40 OP2br BITbr,
( bitwise rotation ops have a similar sig )
( r -- )
: OProt
CREATE C,
DOES>
0xcb A,
C@ ( r op )
OR A,
;
0x10 OProt RLr,
0x00 OProt RLCr,
0x18 OProt RRr,
0x08 OProt RRCr,
0x20 OProt SLAr,
0x38 OProt SRLr,
( cell contains both bytes. MSB is spit as-is, LSB is ORed with r )
( r -- )
: OP2r
CREATE ,
DOES>
@ SPLITB SWAP ( r lsb msb )
A, ( r lsb )
SWAP <<3 ( lsb r<<3 )
OR A,
;
0xed41 OP2r OUT(C)r,
0xed40 OP2r INr(C),
( ss -- )
: OP2ss
CREATE C,
DOES>
0xed A,
C@ SWAP ( op ss )
<<4 ( op ss<< 4 )
OR A,
;
0x4a OP2ss ADCHLss,
0x42 OP2ss SBCHLss,
( dd nn -- )
: OP3ddnn
CREATE C,
DOES>
C@ ( dd nn op )
ROT ( nn op dd )
<<4 ( nn op dd<<4 )
OR A,
A,,
;
0x01 OP3ddnn LDddnn,
( nn -- )
: OP3nn
CREATE C,
DOES>
C@ A,
A,,
;
0xcd OP3nn CALLnn,
0xc3 OP3nn JPnn,
0x22 OP3nn LD(nn)HL,
0x2a OP3nn LDHL(nn),
( Specials )
( dd nn -- )
: LDdd(nn),
0xed A,
SWAP <<4 0x4b OR A,
A,,
;
( nn dd -- )
: LD(nn)dd,
0xed A,
<<4 0x43 OR A,
A,,
;
: JP(IX), IX DROP JP(HL), ;
: JP(IY), IY DROP JP(HL), ;
( 26 == next )
: JPNEXT, 26 JPnn, ;
: CODE
( same as CREATE, but with native word )
(entry)
( 23 == nativeWord )
23 ,
;
: ;CODE JPNEXT, ;
( Routines )
( 29 == chkPS )
: chkPS, 29 CALLnn, ;