forth: begin z80 assembler

emul/Makefile

@@ -7,7 +7,7 @@ AVRABIN = zasm/avra
 SHELLAPPS = zasm ed
 SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
 # Those Forth source files are in a particular order
-FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs
+FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs z80a.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o

forth/dictionary.txt

@@ -98,6 +98,7 @@ UNTIL       f --            *I* Jump backwards to BEGIN if f is *false*.
 DROP        a --
 DUP         a -- a a
 OVER        a b -- a b a
+ROT         a b c -- b c a
 SWAP        a b -- b a
 2DUP        a b -- a b a b
 2OVER       a b c d -- a b c d a b

forth/forth.asm

@@ -1456,9 +1456,25 @@ OVER2:
 	push	bc	; B
 	jp	next
 
+; ( a b c -- b c a)
+	.db "ROT"
+	.fill 4
+	.dw OVER2
+	.db 0
+ROT:
+	.dw nativeWord
+	pop	hl	; C
+	pop	de	; B
+	pop	bc	; A
+	call	chkPS
+	push	de	; B
+	push	hl	; C
+	push	bc	; A
+	jp	next
+
 	.db	">R"
 	.fill	5
-	.dw	OVER2
+	.dw	ROT
 	.db	0
 P2R:
 	.dw	nativeWord

forth/high.fs

@@ -0,0 +1,14 @@
+( Higher level stuff that generally requires all core units )
+
+: ."
+    LIT
+    BEGIN
+        C< DUP          ( c c )
+        ( 34 is ASCII for " )
+        DUP 34 = IF DROP DROP 0 0 THEN
+        C,
+    0 = UNTIL
+    COMPILE (print)
+; IMMEDIATE
+
+: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE

forth/z80a.fs

@@ -0,0 +1,124 @@
+( Z80 assembler )
+
+( Splits word into msb/lsb, lsb being on TOS )
+: SPLITB
+    DUP 0x100 /
+    SWAP 0xff AND
+;
+
+: A, .X ;
+7 CONSTANT A
+0 CONSTANT B
+1 CONSTANT C
+2 CONSTANT D
+3 CONSTANT E
+4 CONSTANT H
+5 CONSTANT L
+6 CONSTANT (HL)
+0 CONSTANT BC
+1 CONSTANT DE
+2 CONSTANT HL
+3 CONSTANT AF
+3 CONSTANT SP
+
+( -- )
+: OP1 CREATE C, DOES> C@ A, ;
+0xc9 OP1 RET,
+0x76 OP1 HALT,
+
+( r -- )
+: OP1r
+    CREATE C,
+    DOES>
+    C@              ( r op )
+    SWAP            ( op r )
+    8 *             ( op r<<3 )
+    OR A,
+;
+0x04 OP1r INCr,
+0x46 OP1r LDr(HL),
+0x70 OP1r LD(HL)r,
+
+( qq -- also works for ss )
+: OP1qq
+    CREATE C,
+    DOES>
+    C@              ( qq op )
+    SWAP            ( op qq )
+    16 *            ( op qq<<4 )
+    OR A,
+;
+0xc5 OP1qq PUSHqq,
+0xc1 OP1qq POPqq,
+0x03 OP1qq INCss,
+0x09 OP1qq ADHLss,
+
+( rd rr )
+: OP1rr
+    CREATE C,
+    DOES>
+    C@              ( rd rr op )
+    ROT             ( rr op rd )
+    8 *             ( rr op rd<<3 )
+    OR OR A,
+;
+0x40 OP1rr LDrr,
+
+( n -- )
+: OP2n
+    CREATE C,
+    DOES>
+    C@ A, A,
+;
+0xd3 OP2n OUTAn,
+0xdb OP2n INAn,
+
+( r n -- )
+: OP2rn
+    CREATE C,
+    DOES>
+    C@              ( r n op )
+    ROT             ( n op r )
+    8 *             ( 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 )
+    8 *             ( r op b<<3 )
+    OR OR Z,
+;
+0xc0 OP2br SETbr,
+0x80 OP2br RESbr,
+0x40 OP2br BITbr,
+
+( dd nn -- )
+: OP3ddnn
+    CREATE C,
+    DOES>
+    C@              ( dd nn op )
+    ROT             ( nn op dd )
+    16 *            ( nn op dd<<4 )
+    OR A,
+    SPLITB A, A,
+;
+0x01 OP2ddnn LDddnn,
+
+( nn -- )
+: OP3nn
+    CREATE C,
+    DOES>
+    C@ A,
+    SPLITB A, A,
+;
+0xcd OP3nn CALLnn,
+0xc3 OP3nn JPnn,
+
+( Specials )
+: JRe, 0x18 A, 2 - A, ;