diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index accf951..532dc5a 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ diff --git a/forth/dictionary.txt b/forth/dictionary.txt index 74db846..f94ae58 100644 --- a/forth/dictionary.txt +++ b/forth/dictionary.txt @@ -54,7 +54,7 @@ IMMEDIATE -- Flag the latest defined word as immediate. LITN n -- Write number n as a literal. [LITN] n -- *I* Immediate version of LITN. ROUTINE x -- a Push the addr of the specified core routine - C=cellWord L=compiledWord V=nativeWord N=next S=LIT + C=cellWord J=JUMPTBL V=nativeWord N=next S=LIT M=NUMBER Y=sysvarWord D=doesWord VARIABLE c -- Creates cell x with 2 bytes allocation. diff --git a/forth/forth.asm b/forth/forth.asm index 873880c..0b4ef89 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -113,8 +113,10 @@ ; change bootstrap binaries have to be adjusted because they rely on them. ; We're at 0 here jp forthMain -.fill 0x17-$ +.fill 0x11-$ JUMPTBL: + jp pushRS + jp popRS jp nativeWord jp next jp chkPS @@ -782,13 +784,13 @@ ROUTINE: ld de, cellWord cp 'C' jr z, .end - ld de, compiledWord - cp 'L' - jr z, .end ld de, JUMPTBL + cp 'J' + jr z, .end + ld de, JUMPTBL+6 cp 'V' jr z, .end - ld de, JUMPTBL+3 + ld de, JUMPTBL+9 cp 'N' jr z, .end ld de, sysvarWord @@ -803,7 +805,7 @@ ROUTINE: ld de, NUMBER cp 'M' jr z, .end - ld de, JUMPTBL+6 + ld de, JUMPTBL+12 cp 'P' jr nz, .notgood ; continue to end on match @@ -1300,28 +1302,12 @@ OVER: push de jp next - .db ">R" - .dw $-OVER - .db 2 -P2R: - .dw nativeWord - pop hl - call chkPS - call pushRS - jp next - .db "R>" - .dw $-P2R - .db 2 -R2P: - .dw nativeWord - call popRS - push hl - jp next +.fill 31 ; ( a b -- c ) A + B .db "+" - .dw $-R2P + .dw $-OVER .db 1 PLUS: .dw nativeWord diff --git a/forth/icore.fs b/forth/icore.fs index f2f8882..d7ab7ba 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -41,15 +41,6 @@ , ( write! ) ; IMMEDIATE -: X ( can't have its real name now ) - ['] EXIT , - R> DROP ( exit COMPILE ) - R> DROP ( exit : ) -; IMMEDIATE - -( Give ";" its real name ) -';' CURRENT @ 4 - C! - : INTERPRET BEGIN WORD @@ -63,3 +54,14 @@ THEN AGAIN ; + +( ; has to be defined last because it can't be executed now ) +: X ( can't have its real name now ) + ['] EXIT , + _c R> DROP ( exit COMPILE ) + _c R> DROP ( exit : ) +; IMMEDIATE + +( Give ";" its real name ) +';' CURRENT @ 4 - C! + diff --git a/forth/z80c.fs b/forth/z80c.fs index 183d848..e55364d 100644 --- a/forth/z80c.fs +++ b/forth/z80c.fs @@ -207,3 +207,16 @@ CODE J H 3 IX- LDrIXY, HL PUSHqq, ;CODE + +CODE >R + HL POPqq, + chkPS, + ( JUMPTBL+0 == pushRS ) + ROUTINE J CALLnn, +;CODE + +CODE R> + ( JUMPTBL+3 == popRS ) + ROUTINE J 3 + CALLnn, + HL PUSHqq, +;CODE