diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index ca8ccbe..5bfeeed 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ diff --git a/forth/core.fs b/forth/core.fs index 12fe851..104591b 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -53,8 +53,30 @@ 11 ( 11 == cellWord ) , ( write it ) ; + +( We run this when we're in an entry creation context. Many + things we need to do. + 1. Change the code link to doesWord + 2. Leave 2 bytes for regular cell variable. + 3. Write down RS' RTOS to entry. + 4. exit parent definition +) +: DOES> + ( Overwrite cellWord in CURRENT ) + ( 63 == doesWord ) + 63 CURRENT @ ! + ( When we have a DOES>, we forcefully place HERE to 4 + bytes after CURRENT. This allows a DOES word to use "," + and "C," without messing everything up. ) + CURRENT @ 4 + HERE ! + ( HERE points to where we should write R> ) + R> , + ( We're done. Because we've popped RS, we'll exit parent + definition ) +; + : VARIABLE CREATE 2 ALLOT ; -: CONSTANT CREATE H@ ! DOES> @ ; +: CONSTANT CREATE , DOES> @ ; : = CMP NOT ; : < CMP 0 1 - = ; : > CMP 1 = ; diff --git a/forth/forth.asm b/forth/forth.asm index e016a80..0681b69 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -136,6 +136,7 @@ .dw HERE .dw CURRENT jp parseDecimal + jp doesWord ; *** Code *** forthMain: @@ -166,7 +167,7 @@ forthMain: .bootName: .db "BOOT", 0 -.fill 98 +.fill 95 ; STABLE ABI ; Offset: 00cd @@ -687,33 +688,10 @@ EXECUTE: jp (hl) ; go! -.fill 77 - - .db "DOES>" - .dw $-EXECUTE - .db 5 -DOES: - .dw nativeWord - ; We run this when we're in an entry creation context. Many things we - ; need to do. - ; 1. Change the code link to doesWord - ; 2. Leave 2 bytes for regular cell variable. - ; 3. Write down IP+2 to entry. - ; 3. exit. we're done here. - ld hl, (CURRENT) - ld de, doesWord - call DEinHL - inc hl \ inc hl ; cell variable space - ld de, (IP) - call DEinHL - ld (HERE), hl - jp EXIT+2 - - -.fill 566 +.fill 677 .db "_bend" - .dw $-DOES + .dw $-EXECUTE .db 5 ; Offset: 0647 .out $