From 80985460d423e929ee2589affdd2eb1784356639 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Mon, 30 Mar 2020 17:05:00 -0400 Subject: [PATCH] forth: remove JTBL We refer to stable offset as direct numbers instead of offset to JTBL. Simpler that way. --- emul/forth/z80c.bin | Bin 1436 -> 1417 bytes forth/core.fs | 13 +++++++------ forth/forth.asm | 5 ++--- forth/icore.fs | 41 +++++++++++++++++++---------------------- forth/z80a.fs | 12 ++++++------ forth/z80c.fs | 28 ++++++++++++++-------------- 6 files changed, 48 insertions(+), 51 deletions(-) diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index bbe9626267d5b3343b1a3af5d28b2e80f9347ee4..ec98338f40a310070404e43f2f5886c9b26366df 100644 GIT binary patch delta 293 zcmbQk-O0V-0h7Q!ktm)=+#Jk~Om04o?!m&7|1)_rT2A(6R%NW2T*xfWxMXrCvzPuk z&Ly0VOwKkk3`~3s3Jg3i4zPCs^*HPBfdryC53pZm2ayU4j111~(UX~2G+4#B64_iQ z>$AuSCU8w=TMw0kh{mxb>smKM& zI5K(qg}4R<1i6OTGjQ@T)N|Fa+-H&iI*5_M5-8untiZqkX4NxsF!)Tq!J@?IGx;}* zh1z>AMQK0*vEd<+T<91M<3Za$9g!Mu|{FnKe2OtxWG zmF(tpWYQ=|EGkab#V{l{>-ews>+qf7BX3ZMNTlEYckt8QlaHZ~s|M&s z37~@*89adU9n1<03}9A069+@|} lpn$OwWN74L*u$m3z{kMB+&9^aRhm5-XkiC)>*O3(SpXVRNiYBa diff --git a/forth/core.fs b/forth/core.fs index c9900e7..12fe851 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -2,7 +2,7 @@ : -^ SWAP - ; : [ INTERPRET 1 FLAGS ! ; IMMEDIATE : ] R> DROP ; -: LIT JTBL 26 + , ; +: LIT 34 , ; : LITS LIT SCPY ; : LIT< WORD LITS ; IMMEDIATE : _err LIT< word-not-found (print) ABORT ; @@ -22,6 +22,7 @@ "_": words starting with "_" are meant to be "private", that is, only used by their immediate surrondings. + LIT: 34 == LIT COMPILE: Tough one. Get addr of caller word (example above (br)) and then call LITN on it. ) @@ -49,7 +50,7 @@ : CREATE (entry) ( empty header with name ) - [ JTBL 3 + LITN ] ( push cellWord addr ) + 11 ( 11 == cellWord ) , ( write it ) ; : VARIABLE CREATE 2 ALLOT ; @@ -86,10 +87,10 @@ : (sysv) (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 ) @ , ( a ) ( increase current sysv counter ) diff --git a/forth/forth.asm b/forth/forth.asm index 01309da..5f07e45 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -103,10 +103,11 @@ ; *** 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 referenced directly by their offset in Forth code with a +; comment indicating what that number refers to. ; We're at 0 here jp forthMain .fill 0x08-$ -JUMPTBL: jp sysvarWord jp cellWord jp compiledWord @@ -116,9 +117,7 @@ JUMPTBL: jp next jp chkPS ; 24 -NUMBER: .dw numberWord -LIT: .dw litWord .dw INITIAL_SP .dw WORDBUF diff --git a/forth/icore.fs b/forth/icore.fs index 1b0b4dd..cb1eb57 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -55,26 +55,24 @@ , ( write! ) ; IMMEDIATE -: JTBL 0x08 ; - : FLAGS - ( JTBL+44 == FLAGS ) - [ JTBL 44 + @ LITN ] + ( 52 == FLAGS ) + [ 52 @ LITN ] ; : (parse*) - ( JTBL+46 == PARSEPTR ) - [ JTBL 46 + @ LITN ] + ( 54 == PARSEPTR ) + [ 54 @ LITN ] ; : HERE - ( JTBL+48 == HERE ) - [ JTBL 48 + @ LITN ] + ( 56 == HERE ) + [ 56 @ LITN ] ; : CURRENT - ( JTBL+50 == CURRENT ) - [ JTBL 50 + @ LITN ] + ( 58 == CURRENT ) + [ 58 @ LITN ] ; : QUIT @@ -107,8 +105,8 @@ ; : C< - ( JTBL+40 == CINPTR ) - [ JTBL 40 + @ LITN ] _c @ EXECUTE + ( 48 == CINPTR ) + [ 48 @ LITN ] _c @ EXECUTE ; : C, @@ -130,8 +128,8 @@ ( Read word from C<, copy to WORDBUF, null-terminate, and return, make HL point to WORDBUF. ) : WORD - ( JTBL+30 == WORDBUF ) - [ JTBL 30 + @ LITN ] ( a ) + ( 38 == WORDBUF ) + [ 38 @ LITN ] ( a ) _c TOWORD ( a c ) BEGIN ( We take advantage of the fact that char MSB is @@ -144,7 +142,7 @@ ( a this point, PS is: a WS ) ( null-termination is already written ) _c 2DROP - [ JTBL 30 + @ LITN ] + [ 38 @ LITN ] ; : (entry) @@ -179,8 +177,8 @@ : BOOT LIT< (parse) (find) _c DROP _c (parse*) _c ! 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 _c INTERPRET ; @@ -188,9 +186,8 @@ ( LITN has to be defined after the last immediate usage of it to avoid bootstrapping issues ) : LITN - ( JTBL+24 == NUMBER ) - _c JTBL 24 _c + , - , + ( 32 == NUMBER ) + 32 , , ; ( : and ; have to be defined last because it can't be @@ -200,8 +197,8 @@ : X _c (entry) ( 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 _c WORD (find) diff --git a/forth/z80a.fs b/forth/z80a.fs index 2c69b7c..bb1ee5a 100644 --- a/forth/z80a.fs +++ b/forth/z80a.fs @@ -241,19 +241,19 @@ SPLITB A, A, ; -( JTBL+18 == next ) -: JPNEXT, [ JTBL 18 + LITN ] JPnn, ; +( 26 == next ) +: JPNEXT, 26 JPnn, ; : CODE ( same as CREATE, but with native word ) (entry) - ( JTBL+15 == next ) - [ JTBL 15 + LITN ] , + ( 23 == nativeWord ) + 23 , ; : ;CODE JPNEXT, ; ( Routines ) -( JTBL+21 == next ) -: chkPS, [ JTBL 21 + LITN ] CALLnn, ; +( 29 == chkPS ) +: chkPS, 29 CALLnn, ; diff --git a/forth/z80c.fs b/forth/z80c.fs index ed16604..0ea8c10 100644 --- a/forth/z80c.fs +++ b/forth/z80c.fs @@ -283,13 +283,13 @@ CODE J CODE >R HL POPqq, chkPS, - ( JTBL+9 == pushRS ) - JTBL 9 + CALLnn, + ( 17 == pushRS ) + 17 CALLnn, ;CODE CODE R> - ( JTBL+12 == popRS ) - JTBL 12 + CALLnn, + ( 20 == popRS ) + 20 CALLnn, HL PUSHqq, ;CODE @@ -316,23 +316,23 @@ CODE BYE ;CODE CODE (resSP) - ( INITIAL_SP == JTBL+28 ) - SP JTBL 28 + @ LDdd(nn), + ( INITIAL_SP == 36 ) + SP 36 @ LDdd(nn), ;CODE CODE (resRS) - ( RS_ADDR == JTBL+38 ) - IX JTBL 38 + @ LDddnn, + ( RS_ADDR == 46 ) + IX 46 @ LDddnn, ;CODE CODE SCMP DE POPqq, HL POPqq, chkPS, - ( JTBL+35 == strcmp ) - JTBL 35 + CALLnn, - ( JTBL+32 == flagsToBC ) - JTBL 32 + CALLnn, + ( 43 == strcmp ) + 43 CALLnn, + ( 40 == flagsToBC ) + 40 CALLnn, BC PUSHqq, ;CODE @@ -342,8 +342,8 @@ CODE CMP chkPS, A ORr, ( clear carry ) DE SBCHLss, - ( JTBL+32 == flagsToBC ) - JTBL 32 + CALLnn, + ( 40 == flagsToBC ) + 40 CALLnn, BC PUSHqq, ;CODE