@@ -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 | |||
@@ -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, | |||
@@ -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, ; | |||
@@ -245,3 +245,8 @@ CODE IMMED? | |||
( notset ) | |||
DE PUSHqq, | |||
;CODE | |||
CODE (resSP) | |||
( INITIAL_SP == JTBL+28 ) | |||
SP JTBL 28 + @ LDdd(nn), | |||
;CODE |