forth: Forth-ify "ABORT"

forth/forth.asm

@@ -117,10 +117,12 @@ JUMPTBL:
 	jp	nativeWord
 	jp	next
 	jp	chkPS
+; 24
 NUMBER:
 	.dw	numberWord
 LIT:
 	.dw	litWord
+	.dw	INITIAL_SP
 
 ; *** Code ***
 forthMain:
@@ -130,7 +132,7 @@ forthMain:
 	; 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.
-	push	af \ push af \ push af
+	ld	sp, 0xfffa
 	ld	(INITIAL_SP), sp
 	ld	ix, RS_ADDR
 	; LATEST is a label to the latest entry of the dict. This can be
@@ -185,7 +187,7 @@ INTERPRET:
 	.dw	DROP
 	.dw	EXECUTE
 
-.fill 43
+.fill 41
 
 ; *** Collapse OS lib copy ***
 ; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
@@ -650,20 +652,6 @@ QUIT:
 	ld	ix, RS_ADDR
 	jp	next
 
-	.db "ABORT"
-	.dw $-QUIT
-	.db 5
-ABORT:
-	.dw	compiledWord
-	.dw	.private
-	.dw	QUIT
-
-.private:
-	.dw	nativeWord
-	; Reinitialize PS
-	ld	sp, (INITIAL_SP)
-	jp	next
-
 abortUnderflow:
 	ld	hl, .name
 	call	find
@@ -672,10 +660,10 @@ abortUnderflow:
 .name:
 	.db "(uflw)", 0
 
-.fill 18
+.fill 41
 
 	.db "BYE"
-	.dw $-ABORT
+	.dw $-QUIT
 	.db 3
 BYE:
 	.dw nativeWord

forth/icore.fs

@@ -49,6 +49,8 @@
     ,           ( write! )
 ; IMMEDIATE
 
+: ABORT _c (resSP) QUIT ;
+
 : INTERPRET
     BEGIN
     WORD
@@ -71,7 +73,7 @@
 ( This is only the "early parser" in earlier stages. No need
   for an abort message )
 : (parse)
-    (parsed) SKIP? ABORT
+    (parsed) SKIP? _c ABORT
 ;
 
 ( a -- )
@@ -87,7 +89,7 @@
 ;
 
 : (uflw)
-    LIT< stack-underflow _c (print) ABORT
+    LIT< stack-underflow _c (print) _c ABORT
 ;
 
 : C,

forth/z80a.fs

@@ -32,6 +32,9 @@
 : IY+ _iy+- ;
 : IY- 0 -^ _iy+- ;
 
+: <<3 8 * ;
+: <<4 16 * ;
+
 ( -- )
 : OP1 CREATE C, DOES> C@ A, ;
 0x76 OP1 HALT,
@@ -48,7 +51,7 @@
     DOES>
     C@              ( r op )
     SWAP            ( op r )
-    8 *             ( op r<<3 )
+    <<3             ( op r<<3 )
     OR A,
 ;
 0x04 OP1r INCr,
@@ -72,7 +75,7 @@
     DOES>
     C@              ( qq op )
     SWAP            ( op qq )
-    16 *            ( op qq<<4 )
+    <<4             ( op qq<<4 )
     OR A,
 ;
 0xc5 OP1qq PUSHqq,
@@ -84,7 +87,7 @@
 : _1rr
     C@              ( rd rr op )
     ROT             ( rr op rd )
-    8 *             ( rr op rd<<3 )
+    <<3             ( rr op rd<<3 )
     OR OR A,
 ;
 
@@ -125,7 +128,7 @@
     DOES>
     C@              ( r n op )
     ROT             ( n op r )
-    8 *             ( n op r<<3 )
+    <<3             ( n op r<<3 )
     OR A, A,
 ;
 0x06 OP2rn LDrn,
@@ -137,7 +140,7 @@
     0xcb A,
     C@              ( b r op )
     ROT             ( r op b )
-    8 *             ( r op b<<3 )
+    <<3             ( r op b<<3 )
     OR OR A,
 ;
 0xc0 OP2br SETbr,
@@ -167,7 +170,7 @@
     DOES>
     @ SPLITB SWAP   ( r lsb msb )
     A,              ( r lsb )
-    SWAP 8 *        ( lsb r<<3 )
+    SWAP <<3        ( lsb r<<3 )
     OR A,
 ;
 0xed41 OP2r OUT(C)r,
@@ -179,7 +182,7 @@
     DOES>
     0xed A,
     C@ SWAP         ( op ss )
-    16 *            ( op ss<< 4 )
+    <<4             ( op ss<< 4 )
     OR A,
 ;
 0x4a OP2ss ADCHLss,
@@ -191,7 +194,7 @@
     DOES>
     C@              ( dd nn op )
     ROT             ( nn op dd )
-    16 *            ( nn op dd<<4 )
+    <<4             ( nn op dd<<4 )
     OR A,
     SPLITB A, A,
 ;
@@ -222,6 +225,21 @@
 0x10 OPJR DJNZe,
 
 ( Specials )
+
+( dd nn -- )
+: LDdd(nn),
+    0xed A,
+    SWAP <<4 0x4b OR A,
+    SPLITB A, A,
+;
+
+( nn dd -- )
+: LD(nn)dd,
+    0xed A,
+    <<4 0x43 OR A,
+    SPLITB A, A,
+;
+
 ( JTBL+18 == next )
 : JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
 

forth/z80c.fs

@@ -245,3 +245,8 @@ CODE IMMED?
 ( notset )
     DE PUSHqq,
 ;CODE
+
+CODE (resSP)
+    ( INITIAL_SP == JTBL+28 )
+    SP JTBL 28 + @ LDdd(nn),
+;CODE