Compare commits

..

9 Commits

Author SHA1 Message Date
Virgil Dupras
ae14c55feb boot: a little dereferencing to make things a bit faster 2020-04-20 23:30:08 -04:00
Virgil Dupras
e569e40665 Forth-ify 2DUP 2OVER 2SWAP
2DROP was left in boot.z80 because it's used in icore.
2020-04-20 23:18:57 -04:00
Virgil Dupras
0438cb92fe Add word "ROLL" 2020-04-20 23:06:39 -04:00
Virgil Dupras
2de1eabaa6 z80a: add LDIR, LDDR, and friends 2020-04-20 21:36:29 -04:00
Virgil Dupras
4967c2add2 Merge z80c.fs and boot.fs into boot.z80 2020-04-20 21:27:34 -04:00
Virgil Dupras
41ed70f8cb z80c: Add word "PICK" 2020-04-20 21:22:07 -04:00
Virgil Dupras
58c017448f z80a: add JPccnn, 2020-04-20 21:18:33 -04:00
Virgil Dupras
353d12c27d boot: inline chkRS, make next a bit faster 2020-04-20 20:28:25 -04:00
Virgil Dupras
bf49ca2ed2 recipes/rc2014: fix Makefile
It didn't have z80a anymore.
2020-04-20 19:22:43 -04:00
10 changed files with 455 additions and 456 deletions

View File

@ -9,8 +9,8 @@ SWAP a b -- b a
2DUP a b -- a b a b
2OVER a b c d -- a b c d a b
2SWAP a b c d -- c d a b
PICK Pick nth item from stack. "0 PICK" = DUP,
"1 PICK" = OVER.
ROLL Rotate PSP over n items. "1 ROLL" = SWAP,
"2 ROLL" = ROT. 0 is noop.

11
blk/224
View File

@ -1,7 +1,8 @@
: OP2 CREATE , DOES> @ 256 /MOD A, A, ;
0xedb1 OP2 CPIR,
0xed46 OP2 IM0,
0xed56 OP2 IM1,
0xeda1 OP2 CPI, 0xedb1 OP2 CPIR,
0xeda9 OP2 CPD, 0xedb9 OP2 CPDR,
0xed46 OP2 IM0, 0xed56 OP2 IM1,
0xed5e OP2 IM2,
0xed44 OP2 NEG,
0xed4d OP2 RETI,
0xeda0 OP2 LDI, 0xedb0 OP2 LDIR,
0xeda8 OP2 LDD, 0xedb8 OP2 LDDR,
0xed44 OP2 NEG, 0xed4d OP2 RETI,

View File

@ -1,3 +1,5 @@
: JPccnn, SWAP <<3 0xc2 OR A, A,, ;
( 26 == next )
: JPNEXT, 26 JPnn, ;
( 29 == chkPS )

View File

@ -3,8 +3,7 @@ TARGETS = forth/forth
BOOTSRCS = ./forth/conf.fs \
../forth/xcomp.fs \
./forth/xcomp.fs \
../forth/boot.fs \
../forth/z80c.fs \
../forth/boot.z80 \
../forth/icore.fs \
./forth/xstop.fs

Binary file not shown.

View File

@ -6,9 +6,8 @@ H@ 256 /MOD 2 PC! 2 PC!
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
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
@ -244,7 +243,7 @@ PC ORG @ 0x15 + ! ( popRS )
RET,
'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A,
L1 BSET ( abortUnderflow )
L2 BSET ( abortUnderflow )
HL PC 7 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
0x03 CALLnn, ( find )
@ -263,15 +262,7 @@ PC ORG @ 0x1e + ! ( chkPS )
SP SUBHLss,
HL POPqq,
CNC RETcc, ( INITIAL_SP >= SP? good )
JR, L1 BWR ( abortUnderflow )
L2 BSET ( chkRS )
IX PUSHqq, HL POPqq,
DE RS_ADDR LDddnn,
DE SUBHLss,
CNC RETcc, ( IX >= RS_ADDR? good )
JR, L1 BWR ( abortUnderflow )
JR, L2 BWR ( abortUnderflow )
PC ORG @ 0x1b + ! ( next )
( This routine is jumped to at the end of every word. In it,
@ -279,13 +270,18 @@ PC ORG @ 0x1b + ! ( next )
it by 2 before jumping. )
( Before we continue: are stacks within bounds? )
0x1d CALLnn, ( chkPS )
L2 @ CALLnn, ( chkRS )
( 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,
@ -297,6 +293,7 @@ PC ORG @ 0x34 + ! ( execute )
( 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:
@ -313,7 +310,7 @@ PC ORG @ 0x0f + ! ( compiledWord )
D (HL) LDrr,
HL INCss,
HL PUSHqq, IY POPqq, ( --> IP )
0x33 JPnn, ( 33 == execute )
JR, L3 BWR ( execute )
PC ORG @ 0x0c + ! ( cellWord )
( Pushes PFA directly )
@ -335,4 +332,421 @@ PC ORG @ 0x2c + ! ( doesWord )
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
0x0e JPnn, ( 0e == compiledWord )
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,
D H LDrr,
E L LDrr,
HL DECss,
HL DECss,
LDDR,
;CODE
( a b -- )
CODE 2DROP
HL POPqq,
HL POPqq,
chkPS,
;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

View File

@ -136,6 +136,17 @@
: 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

View File

@ -1,428 +0,0 @@
( Core words in z80. This requires a full Forth interpreter
to run, but is also necessary for core.fs. This means that
it needs to be compiled from a prior bootstrapped binary.
This stage is tricky due to the fact that references in
Forth are all absolute, except for prev word refs. This
means that there are severe limitations to the kind of code
you can put here. Those limitations are the same as those
described in icore.fs.
Oh, also: KEY and EMIT are not defined here. There're
expected to be defined in platform-specific code.
This unit expects the same conf as boot.fs.
)
CODE EXECUTE
DE POPqq,
chkPS,
0x33 JPnn, ( 33 == 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
( a b -- a b a b )
CODE 2DUP
HL POPqq, ( B )
DE POPqq, ( A )
chkPS,
DE PUSHqq, ( A )
HL PUSHqq, ( B )
DE PUSHqq, ( A )
HL PUSHqq, ( B )
;CODE
( a b -- )
CODE 2DROP
HL POPqq,
HL POPqq,
;CODE
( a b c d -- a b c d a b )
CODE 2OVER
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
EXX, HL POPqq, EXX, ( A )
chkPS,
EXX, HL PUSHqq, EXX, ( A )
BC PUSHqq, ( B )
DE PUSHqq, ( C )
HL PUSHqq, ( D )
EXX, HL PUSHqq, EXX, ( A )
BC PUSHqq, ( B )
;CODE
( a b c d -- c d a b )
CODE 2SWAP
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
EXX, HL POPqq, EXX, ( A )
chkPS,
DE PUSHqq, ( C )
HL PUSHqq, ( D )
EXX, HL PUSHqq, EXX, ( A )
BC PUSHqq, ( B )
;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

View File

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

View File

@ -1,3 +1,4 @@
212 LOAD ( z80a )
0x8000 CONSTANT RAMSTART
0xf000 CONSTANT RS_ADDR
0x80 CONSTANT ACIA_CTL