diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index ecf78e0..bbe9626 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ diff --git a/forth/forth.asm b/forth/forth.asm index db20979..01309da 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -131,6 +131,8 @@ LIT: .dw FLAGS ; 46 .dw PARSEPTR + .dw HERE + .dw CURRENT ; *** Code *** forthMain: @@ -161,7 +163,7 @@ forthMain: .bootName: .db "BOOT", 0 -.fill 105 +.fill 101 ; STABLE ABI ; Offset: 00cd @@ -784,36 +786,10 @@ PARSED: jp next -.fill 96 - - .db "JTBL" - .dw $-PARSED - .db 4 -JTBL: - .dw sysvarWord - .dw JUMPTBL - -; STABLE ABI (every sysvars) -; Offset: 05ca -.out $ - .db "HERE" - .dw $-JTBL - .db 4 -HERE_: ; Caution: conflicts with actual variable name - .dw sysvarWord - .dw HERE - - .db "CURRENT" - .dw $-HERE_ - .db 7 -CURRENT_: - .dw sysvarWord - .dw CURRENT - -.fill 92 +.fill 224 .db "_bend" - .dw $-CURRENT_ + .dw $-PARSED .db 5 ; Offset: 0647 .out $ diff --git a/forth/icore.fs b/forth/icore.fs index 1461b4a..1b0b4dd 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -55,6 +55,8 @@ , ( write! ) ; IMMEDIATE +: JTBL 0x08 ; + : FLAGS ( JTBL+44 == FLAGS ) [ JTBL 44 + @ LITN ] @@ -65,6 +67,16 @@ [ JTBL 46 + @ LITN ] ; +: HERE + ( JTBL+48 == HERE ) + [ JTBL 48 + @ LITN ] +; + +: CURRENT + ( JTBL+50 == CURRENT ) + [ JTBL 50 + @ LITN ] +; + : QUIT 0 _c FLAGS _c ! _c (resRS) LIT< INTERPRET (find) _c DROP EXECUTE @@ -100,8 +112,8 @@ ; : C, - HERE _c @ _c C! - HERE _c @ 1 _c + HERE _c ! + _c HERE _c @ _c C! + _c HERE _c @ 1 _c + _c HERE _c ! ; ( The NOT is to normalize the negative/positive numbers to 1 @@ -136,18 +148,18 @@ ; : (entry) - HERE _c @ ( h ) + _c HERE _c @ ( h ) _c WORD ( h s ) SCPY ( h ) ( Adjust HERE -1 because SCPY copies the null ) - HERE _c @ 1 _c - ( h h' ) - _c DUP HERE _c ! ( h h' ) + _c HERE _c @ 1 _c - ( h h' ) + _c DUP _c HERE _c ! ( h h' ) _c SWAP _c - ( sz ) ( write prev value ) - HERE _c @ CURRENT _c @ _c - , + _c HERE _c @ _c CURRENT _c @ _c - , ( write size ) _c C, - HERE _c @ CURRENT _c ! + _c HERE _c @ _c CURRENT _c ! ; : INTERPRET @@ -177,7 +189,7 @@ it to avoid bootstrapping issues ) : LITN ( JTBL+24 == NUMBER ) - JTBL 24 _c + , + _c JTBL 24 _c + , , ;