diff --git a/apps/forth/core.fs b/apps/forth/core.fs index 3b62283..06189d5 100644 --- a/apps/forth/core.fs +++ b/apps/forth/core.fs @@ -20,13 +20,27 @@ a reference to "," so that this word is written to HERE. NOT: a bit convulted because we don't have IF yet ) -: IF COMPILE SKIP? COMPILE (fbr) H 1 ALLOT ; IMMEDIATE -( Subtract TOS from H to get offset to write to IF or ELSE's - br cell ) -: THEN DUP H -^ SWAP C! ; IMMEDIATE -( write (fbr) addr, allot, then same as THEN ) -: ELSE - COMPILE (fbr) 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE + +: IF ( -- a | a: br cell addr ) + COMPILE SKIP? ( if true, don't branch ) + COMPILE (fbr) + H ( push a ) + 1 ALLOT ( br cell allot ) +; IMMEDIATE + +: THEN ( a -- | a: br cell addr ) + DUP H -^ SWAP ( a-H a ) + C! +; IMMEDIATE + +: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) + COMPILE (fbr) + 1 ALLOT + DUP H -^ SWAP ( a-H a ) + C! + H 1 - ( push a. -1 for allot offset ) +; IMMEDIATE + : ? @ . ; : VARIABLE CREATE 2 ALLOT ; : CONSTANT CREATE H ! DOES> @ ; diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index f75e39f..6f72370 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -278,7 +278,7 @@ DEFINE: ld (HERE), hl .loop: ; did we reach ";"? - ld hl, (INPUTPOS) + call toword ld a, (hl) cp ';' jr nz, .compile diff --git a/apps/forth/util.asm b/apps/forth/util.asm index cb7e328..1ab7eac 100644 --- a/apps/forth/util.asm +++ b/apps/forth/util.asm @@ -4,25 +4,35 @@ pad: ld a, PADDING jp addHL +; Advance (INPUTPOS) until a non-whitespace is met. If needed, +; call fetchline. +; Set HL to newly set (INPUTPOS) +toword: + ld hl, (INPUTPOS) + ; skip leading whitespace + dec hl ; offset leading "inc hl" +.loop: + inc hl + ld a, (hl) + or a + ; When at EOL, fetch a new line directly + jr z, .empty + cp ' '+1 + jr c, .loop + ret +.empty: + call fetchline + jr toword + ; Read word from (INPUTPOS) and return, in HL, a null-terminated word. ; Advance (INPUTPOS) to the character following the whitespace ending the ; word. ; When we're at EOL, we call fetchline directly, so this call always returns ; a word. readword: - ld hl, (INPUTPOS) - ; skip leading whitespace - dec hl ; offset leading "inc hl" -.loop1: - inc hl - ld a, (hl) - or a - ; When at EOL, fetch a new line directly - jr z, .empty - cp ' '+1 - jr c, .loop1 + call toword push hl ; --> lvl 1. that's our result -.loop2: +.loop: inc hl ld a, (hl) ; special case: is A null? If yes, we will *not* inc A so that we don't @@ -30,7 +40,7 @@ readword: or a jr z, .noinc cp ' '+1 - jr nc, .loop2 + jr nc, .loop ; we've just read a whitespace, HL is pointing to it. Let's transform ; it into a null-termination, inc HL, then set (INPUTPOS). xor a @@ -40,9 +50,6 @@ readword: ld (INPUTPOS), hl pop hl ; <-- lvl 1. our result ret ; Z set from XOR A -.empty: - call fetchline - jr readword ; Sets Z if (HL) == E and (HL+1) == D HLPointsDE: