diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index fb4b5f1..5f84a62 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 fb87e49..2e480e2 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -121,6 +121,7 @@ NUMBER: LIT: .dw litWord .dw INITIAL_SP + .dw WORDBUF ; *** Code *** forthMain: @@ -179,7 +180,7 @@ INTERPRET: .dw DROP .dw EXECUTE -.fill 58 +.fill 56 ; STABLE ABI ; Offset: 00cd @@ -890,65 +891,10 @@ TOWORD: .dw TOWORD .dw EXIT -; Read word from C<, copy to WORDBUF, null-terminate, and return, make -; HL point to WORDBUF. - .db "WORD" - .dw $-TOWORD - .db 4 -; STABLE ABI -; Offset: 04f7 -.out $ -WORD: - .dw compiledWord - .dw NUMBER ; ( a ) - .dw WORDBUF - .dw TOWORD ; ( a c ) - ; branch mark - .dw OVER ; ( a c a ) - .dw STORE ; ( a ) - .dw NUMBER ; ( a 1 ) - .dw 1 - .dw PLUS ; ( a+1 ) - .dw CIN ; ( a c ) - .dw DUP ; ( a c c ) - .dw ISWS ; ( a c f ) - .dw CSKIP ; ( a c ) - ; I'm not sure why, I can't seem to successfully change this into - ; a (br). I'll get rid of the (fbr) and (bbr) words when I'm done - ; Forth-ifying "WORD" - .dw BBR - .db 20 ; here - mark - ; at this point, we have ( a WS ) - .dw DROP - .dw NUMBER - .dw 0 - .dw SWAP ; ( 0 a ) - .dw STORE ; () - .dw NUMBER - .dw WORDBUF - .dw EXIT - -.wcpy: - .dw nativeWord - ld de, WORDBUF - push de ; we already have our result -.loop: - ld a, (hl) - cp ' '+1 - jr c, .loopend - ld (de), a - inc hl - inc de - jr .loop -.loopend: - ; null-terminate the string. - xor a - ld (de), a - jp next - +.fill 73 .db "(parsed)" - .dw $-WORD + .dw $-TOWORD .db 8 PARSED: .dw nativeWord diff --git a/forth/icore.fs b/forth/icore.fs index 63ec285..a7b52da 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -51,25 +51,6 @@ : ABORT _c (resSP) QUIT ; -: INTERPRET - BEGIN - WORD - (find) - IF - 1 FLAGS ! - EXECUTE - 0 FLAGS ! - ELSE - (parse*) @ EXECUTE - THEN - AGAIN -; - -: BOOT - LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN - _c INTERPRET -; - ( This is only the "early parser" in earlier stages. No need for an abort message ) : (parse) @@ -97,6 +78,26 @@ HERE @ 1 + HERE ! ; +( Read word from C<, copy to WORDBUF, null-terminate, and + return, make HL point to WORDBUF. ) +: WORD + ( JTBL+30 == WORDBUF ) + [ JTBL 30 + @ LITN ] ( a ) + TOWORD ( a c ) + BEGIN + ( We take advantage of the fact that char MSB is + always zero to pre-write our null-termination ) + OVER ! ( a ) + 1 + ( a+1 ) + C< ( a c ) + DUP WS? + UNTIL + ( a this point, PS is: a WS ) + ( null-termination is already written ) + DROP DROP + [ JTBL 30 + @ LITN ] +; + : LITN ( JTBL+24 == NUMBER ) JTBL 24 + , @@ -105,7 +106,7 @@ : (entry) HERE @ ( h ) - WORD ( h s ) + _c WORD ( h s ) SCPY ( h ) ( Adjust HERE -1 because SCPY copies the null ) HERE @ 1 _c - ( h h' ) @@ -118,6 +119,25 @@ HERE @ CURRENT ! ; +: INTERPRET + BEGIN + _c WORD + (find) + IF + 1 FLAGS ! + EXECUTE + 0 FLAGS ! + ELSE + (parse*) @ EXECUTE + THEN + AGAIN +; + +: BOOT + LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN + _c INTERPRET +; + ( : and ; have to be defined last because it can't be executed now also, they can't have their real name right away ) @@ -128,7 +148,7 @@ issues. JTBL+24 == NUMBER JTBL+6 == compiledWord ) [ JTBL 24 + , JTBL 6 + , ] , BEGIN - WORD + _c WORD (find) ( is word ) IF DUP _c IMMED? IF EXECUTE ELSE , THEN