We refer to stable offset as direct numbers instead of offset to JTBL. Simpler that way.pull/95/head
@@ -2,7 +2,7 @@ | |||||
: -^ SWAP - ; | : -^ SWAP - ; | ||||
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE | : [ INTERPRET 1 FLAGS ! ; IMMEDIATE | ||||
: ] R> DROP ; | : ] R> DROP ; | ||||
: LIT JTBL 26 + , ; | |||||
: LIT 34 , ; | |||||
: LITS LIT SCPY ; | : LITS LIT SCPY ; | ||||
: LIT< WORD LITS ; IMMEDIATE | : LIT< WORD LITS ; IMMEDIATE | ||||
: _err LIT< word-not-found (print) ABORT ; | : _err LIT< word-not-found (print) ABORT ; | ||||
@@ -22,6 +22,7 @@ | |||||
"_": words starting with "_" are meant to be "private", | "_": words starting with "_" are meant to be "private", | ||||
that is, only used by their immediate surrondings. | that is, only used by their immediate surrondings. | ||||
LIT: 34 == LIT | |||||
COMPILE: Tough one. Get addr of caller word (example above | COMPILE: Tough one. Get addr of caller word (example above | ||||
(br)) and then call LITN on it. ) | (br)) and then call LITN on it. ) | ||||
@@ -49,7 +50,7 @@ | |||||
: CREATE | : CREATE | ||||
(entry) ( empty header with name ) | (entry) ( empty header with name ) | ||||
[ JTBL 3 + LITN ] ( push cellWord addr ) | |||||
11 ( 11 == cellWord ) | |||||
, ( write it ) | , ( write it ) | ||||
; | ; | ||||
: VARIABLE CREATE 2 ALLOT ; | : VARIABLE CREATE 2 ALLOT ; | ||||
@@ -86,10 +87,10 @@ | |||||
: (sysv) | : (sysv) | ||||
(entry) | (entry) | ||||
( JTBL+0 == sysvarWord ) | |||||
[ JTBL LITN ] , | |||||
( JTBL+42 == SYSVNXT ) | |||||
[ JTBL 42 + @ LITN ] DUP ( a a ) | |||||
( 8 == sysvarWord ) | |||||
8 , | |||||
( 50 == SYSVNXT ) | |||||
[ 50 @ LITN ] DUP ( a a ) | |||||
( Get new sysv addr ) | ( Get new sysv addr ) | ||||
@ , ( a ) | @ , ( a ) | ||||
( increase current sysv counter ) | ( increase current sysv counter ) | ||||
@@ -103,10 +103,11 @@ | |||||
; *** Stable ABI *** | ; *** Stable ABI *** | ||||
; Those jumps below are supposed to stay at these offsets, always. If they | ; 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. | ; change bootstrap binaries have to be adjusted because they rely on them. | ||||
; Those entries are referenced directly by their offset in Forth code with a | |||||
; comment indicating what that number refers to. | |||||
; We're at 0 here | ; We're at 0 here | ||||
jp forthMain | jp forthMain | ||||
.fill 0x08-$ | .fill 0x08-$ | ||||
JUMPTBL: | |||||
jp sysvarWord | jp sysvarWord | ||||
jp cellWord | jp cellWord | ||||
jp compiledWord | jp compiledWord | ||||
@@ -116,9 +117,7 @@ JUMPTBL: | |||||
jp next | jp next | ||||
jp chkPS | jp chkPS | ||||
; 24 | ; 24 | ||||
NUMBER: | |||||
.dw numberWord | .dw numberWord | ||||
LIT: | |||||
.dw litWord | .dw litWord | ||||
.dw INITIAL_SP | .dw INITIAL_SP | ||||
.dw WORDBUF | .dw WORDBUF | ||||
@@ -55,26 +55,24 @@ | |||||
, ( write! ) | , ( write! ) | ||||
; IMMEDIATE | ; IMMEDIATE | ||||
: JTBL 0x08 ; | |||||
: FLAGS | : FLAGS | ||||
( JTBL+44 == FLAGS ) | |||||
[ JTBL 44 + @ LITN ] | |||||
( 52 == FLAGS ) | |||||
[ 52 @ LITN ] | |||||
; | ; | ||||
: (parse*) | : (parse*) | ||||
( JTBL+46 == PARSEPTR ) | |||||
[ JTBL 46 + @ LITN ] | |||||
( 54 == PARSEPTR ) | |||||
[ 54 @ LITN ] | |||||
; | ; | ||||
: HERE | : HERE | ||||
( JTBL+48 == HERE ) | |||||
[ JTBL 48 + @ LITN ] | |||||
( 56 == HERE ) | |||||
[ 56 @ LITN ] | |||||
; | ; | ||||
: CURRENT | : CURRENT | ||||
( JTBL+50 == CURRENT ) | |||||
[ JTBL 50 + @ LITN ] | |||||
( 58 == CURRENT ) | |||||
[ 58 @ LITN ] | |||||
; | ; | ||||
: QUIT | : QUIT | ||||
@@ -107,8 +105,8 @@ | |||||
; | ; | ||||
: C< | : C< | ||||
( JTBL+40 == CINPTR ) | |||||
[ JTBL 40 + @ LITN ] _c @ EXECUTE | |||||
( 48 == CINPTR ) | |||||
[ 48 @ LITN ] _c @ EXECUTE | |||||
; | ; | ||||
: C, | : C, | ||||
@@ -130,8 +128,8 @@ | |||||
( Read word from C<, copy to WORDBUF, null-terminate, and | ( Read word from C<, copy to WORDBUF, null-terminate, and | ||||
return, make HL point to WORDBUF. ) | return, make HL point to WORDBUF. ) | ||||
: WORD | : WORD | ||||
( JTBL+30 == WORDBUF ) | |||||
[ JTBL 30 + @ LITN ] ( a ) | |||||
( 38 == WORDBUF ) | |||||
[ 38 @ LITN ] ( a ) | |||||
_c TOWORD ( a c ) | _c TOWORD ( a c ) | ||||
BEGIN | BEGIN | ||||
( We take advantage of the fact that char MSB is | ( We take advantage of the fact that char MSB is | ||||
@@ -144,7 +142,7 @@ | |||||
( a this point, PS is: a WS ) | ( a this point, PS is: a WS ) | ||||
( null-termination is already written ) | ( null-termination is already written ) | ||||
_c 2DROP | _c 2DROP | ||||
[ JTBL 30 + @ LITN ] | |||||
[ 38 @ LITN ] | |||||
; | ; | ||||
: (entry) | : (entry) | ||||
@@ -179,8 +177,8 @@ | |||||
: BOOT | : BOOT | ||||
LIT< (parse) (find) _c DROP _c (parse*) _c ! | LIT< (parse) (find) _c DROP _c (parse*) _c ! | ||||
LIT< (c<) (find) NOT IF LIT< KEY (find) _c DROP THEN | LIT< (c<) (find) NOT IF LIT< KEY (find) _c DROP THEN | ||||
( JTBL+40 == CINPTR ) | |||||
[ JTBL 40 + @ LITN ] _c ! | |||||
( 48 == CINPTR ) | |||||
[ 48 @ LITN ] _c ! | |||||
LIT< (c<$) (find) IF EXECUTE ELSE _c DROP THEN | LIT< (c<$) (find) IF EXECUTE ELSE _c DROP THEN | ||||
_c INTERPRET | _c INTERPRET | ||||
; | ; | ||||
@@ -188,9 +186,8 @@ | |||||
( LITN has to be defined after the last immediate usage of | ( LITN has to be defined after the last immediate usage of | ||||
it to avoid bootstrapping issues ) | it to avoid bootstrapping issues ) | ||||
: LITN | : LITN | ||||
( JTBL+24 == NUMBER ) | |||||
_c JTBL 24 _c + , | |||||
, | |||||
( 32 == NUMBER ) | |||||
32 , , | |||||
; | ; | ||||
( : and ; have to be defined last because it can't be | ( : and ; have to be defined last because it can't be | ||||
@@ -200,8 +197,8 @@ | |||||
: X | : X | ||||
_c (entry) | _c (entry) | ||||
( We cannot use LITN as IMMEDIATE because of bootstrapping | ( We cannot use LITN as IMMEDIATE because of bootstrapping | ||||
issues. JTBL+24 == NUMBER JTBL+6 == compiledWord ) | |||||
[ JTBL 24 + , JTBL 6 + , ] , | |||||
issues. 32 == NUMBER 14 == compiledWord ) | |||||
[ 32 , 14 , ] , | |||||
BEGIN | BEGIN | ||||
_c WORD | _c WORD | ||||
(find) | (find) | ||||
@@ -241,19 +241,19 @@ | |||||
SPLITB A, A, | SPLITB A, A, | ||||
; | ; | ||||
( JTBL+18 == next ) | |||||
: JPNEXT, [ JTBL 18 + LITN ] JPnn, ; | |||||
( 26 == next ) | |||||
: JPNEXT, 26 JPnn, ; | |||||
: CODE | : CODE | ||||
( same as CREATE, but with native word ) | ( same as CREATE, but with native word ) | ||||
(entry) | (entry) | ||||
( JTBL+15 == next ) | |||||
[ JTBL 15 + LITN ] , | |||||
( 23 == nativeWord ) | |||||
23 , | |||||
; | ; | ||||
: ;CODE JPNEXT, ; | : ;CODE JPNEXT, ; | ||||
( Routines ) | ( Routines ) | ||||
( JTBL+21 == next ) | |||||
: chkPS, [ JTBL 21 + LITN ] CALLnn, ; | |||||
( 29 == chkPS ) | |||||
: chkPS, 29 CALLnn, ; |
@@ -283,13 +283,13 @@ CODE J | |||||
CODE >R | CODE >R | ||||
HL POPqq, | HL POPqq, | ||||
chkPS, | chkPS, | ||||
( JTBL+9 == pushRS ) | |||||
JTBL 9 + CALLnn, | |||||
( 17 == pushRS ) | |||||
17 CALLnn, | |||||
;CODE | ;CODE | ||||
CODE R> | CODE R> | ||||
( JTBL+12 == popRS ) | |||||
JTBL 12 + CALLnn, | |||||
( 20 == popRS ) | |||||
20 CALLnn, | |||||
HL PUSHqq, | HL PUSHqq, | ||||
;CODE | ;CODE | ||||
@@ -316,23 +316,23 @@ CODE BYE | |||||
;CODE | ;CODE | ||||
CODE (resSP) | CODE (resSP) | ||||
( INITIAL_SP == JTBL+28 ) | |||||
SP JTBL 28 + @ LDdd(nn), | |||||
( INITIAL_SP == 36 ) | |||||
SP 36 @ LDdd(nn), | |||||
;CODE | ;CODE | ||||
CODE (resRS) | CODE (resRS) | ||||
( RS_ADDR == JTBL+38 ) | |||||
IX JTBL 38 + @ LDddnn, | |||||
( RS_ADDR == 46 ) | |||||
IX 46 @ LDddnn, | |||||
;CODE | ;CODE | ||||
CODE SCMP | CODE SCMP | ||||
DE POPqq, | DE POPqq, | ||||
HL POPqq, | HL POPqq, | ||||
chkPS, | chkPS, | ||||
( JTBL+35 == strcmp ) | |||||
JTBL 35 + CALLnn, | |||||
( JTBL+32 == flagsToBC ) | |||||
JTBL 32 + CALLnn, | |||||
( 43 == strcmp ) | |||||
43 CALLnn, | |||||
( 40 == flagsToBC ) | |||||
40 CALLnn, | |||||
BC PUSHqq, | BC PUSHqq, | ||||
;CODE | ;CODE | ||||
@@ -342,8 +342,8 @@ CODE CMP | |||||
chkPS, | chkPS, | ||||
A ORr, ( clear carry ) | A ORr, ( clear carry ) | ||||
DE SBCHLss, | DE SBCHLss, | ||||
( JTBL+32 == flagsToBC ) | |||||
JTBL 32 + CALLnn, | |||||
( 40 == flagsToBC ) | |||||
40 CALLnn, | |||||
BC PUSHqq, | BC PUSHqq, | ||||
;CODE | ;CODE | ||||