From 48078d9c9c4e37ee4d0d17189464f8bcf92f4b98 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Sun, 29 Mar 2020 09:10:23 -0400 Subject: [PATCH] forth: Replace "SKIP?" with "(?br)" There is an alternate git history where I continued the Forth-ification of words, including "SKIP?", but that was a bad idea: because that word was written by flow control immediates, I stepped into quicksands where stability became necessary in z80c.fs and I couldn't gracefully get out of it. I'm stepping back and take this opportunity to replace the shoddy SKIP? algo with a more straightforward (?br) implementation. (br) and (?br) will always stay in boot code where it's easier manage a stable ABI. --- emul/forth/z80c.bin | Bin 1061 -> 1051 bytes forth/core.fs | 13 ++++++----- forth/dictionary.txt | 10 +++------ forth/forth.asm | 57 +++++++++++-------------------------------------- forth/icore.fs | 2 +- forth/parse.fs | 8 +++---- tests/forth/harness.fs | 2 +- 7 files changed, 28 insertions(+), 64 deletions(-) diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index 6c75407551dc9c9d0f53d2d34f40eb141075e192..1a1bd6236aa4178cffebfffe7f482018af915db7 100644 GIT binary patch delta 293 zcmZ3=F`Hw9I1{Ub@N{nJ$udmJA%|J+GqEs;b2>6<6clCVm1v4Gu=6p5voUjovw`F| z7%bT=*&Lbfb0{z{GR$PFXL|A|$tJ)CF>@wMINM6j`#?n?yFjvz zOg^3=ep-{2nB5q=CucItGTxuu$*h=o3uug!zki4U$QUICjbs}YO@4?$FN0M&Cbykk{m>tGh(s%HWjZEZSP HkVOOl|360^ delta 319 zcmbQuv6N$jI1}qK;kn$ZlVzBcgQhcyb2>6<6clCVm1qhwu=6p5voUjovmIuc&Q#CD z!C=W|$>zv(pF@FxkzpoVJ=3HAK-HybIpvyK3~YQ1N({v%iOJczrFki-MQJ(t DROP ; -: LIT [ JTBL 26 + LITN ] , ; +: LIT JTBL 26 + , ; : LITS LIT SCPY ; : LIT< WORD LITS ; IMMEDIATE : _err LIT< word-not-found (print) ABORT ; -: ' WORD (find) SKIP? _err ; -: ['] WORD (find) SKIP? _err LITN ; IMMEDIATE +: ' WORD (find) NOT (?br) [ 4 , ] _err ; +: ['] ' LITN ; IMMEDIATE : COMPILE ' LITN ['] , , ; IMMEDIATE : [COMPILE] ' , ; IMMEDIATE : BEGIN H@ ; IMMEDIATE : AGAIN COMPILE (br) H@ - , ; IMMEDIATE -: UNTIL COMPILE SKIP? COMPILE (br) H@ - , ; IMMEDIATE +: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE : ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE ( Hello, hello, krkrkrkr... do you hear me? Ah, voice at last! Some lines above need comments @@ -29,8 +29,7 @@ : ALLOT HERE +! ; : IF ( -- a | a: br cell addr ) - COMPILE SKIP? ( if true, don't branch ) - COMPILE (br) + COMPILE (?br) H@ ( push a ) 2 ALLOT ( br cell allot ) ; IMMEDIATE @@ -73,7 +72,7 @@ the RS ) : LOOP COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R - COMPILE I' COMPILE = COMPILE SKIP? COMPILE (br) + COMPILE I' COMPILE = COMPILE (?br) H@ - , COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP ; IMMEDIATE diff --git a/forth/dictionary.txt b/forth/dictionary.txt index 7d5181b..b6953d4 100644 --- a/forth/dictionary.txt +++ b/forth/dictionary.txt @@ -73,10 +73,9 @@ Note about flow words: flow words can only be used in definitions. In the INTERPRET loop, they don't have the desired effect because each word from the input stream is executed immediately. In this context, branching doesn't work. -(fbr) -- Branches forward by the number specified in its - atom's cell. -(bbr) -- Branches backward by the number specified in its - atom's cell. +(br) -- Branches by the number specified in the 2 following + bytes. Can be negative. +(?br) f -- Branch if f is false. [ -- Begin interetative mode. In a definition, words between here and "]" will be executed instead of compiled. @@ -92,9 +91,6 @@ INTERPRET -- Get a line from stdin, compile it in tmp memory, then execute the compiled contents. QUIT R:drop -- Return to interpreter prompt immediately RECURSE R:I -- R:I-2 Run the current word again. -SKIP? f -- If f is true, skip the execution of the next atom. - Use this right before ";" and you're gonna have a - bad time. THEN I:a -- *I* Set branching cell at a. UNTIL f -- *I* Jump backwards to BEGIN if f is *false*. diff --git a/forth/forth.asm b/forth/forth.asm index 4feaf28..80833b1 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -670,61 +670,28 @@ BR: ld (IP), hl jp next -; Skip the compword where HL is currently pointing. If it's a regular word, -; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip -; to after null-termination. - .db "SKIP?" +.fill 72 + + .db "(?br)" .dw $-BR .db 5 -CSKIP: +CBR: .dw nativeWord pop hl call chkPS ld a, h or l - jp z, next ; False, do nothing. - ld hl, (IP) - ld de, NUMBER - call .HLPointsDE - jr z, .isNum - ld de, BR - call .HLPointsDE - jr z, .isNum - ld de, LIT - call .HLPointsDE - jr nz, .isWord - ; We have a literal - inc hl \ inc hl - call strskip - inc hl ; byte after word termination - jr .end -.isNum: - ; skip by 4 - inc hl - inc hl - ; continue to isWord -.isWord: - ; skip by 2 - inc hl \ inc hl -.end: - ld (IP), hl + jp z, BR+2 ; False, branch + ; True, skip next 2 bytes and don't branch + ld hl, IP + inc (hl) + inc (hl) jp next -; Sets Z if (HL) == E and (HL+1) == D -.HLPointsDE: - ld a, (hl) - cp e - ret nz ; no - inc hl - ld a, (hl) - dec hl - cp d ; Z has our answer - ret - -.fill 45 +.fill 18 .db "," - .dw $-CSKIP + .dw $-CBR .db 1 WR: .dw nativeWord @@ -1046,3 +1013,5 @@ CMP: .db "_bend" .dw $-CMP .db 5 +; Offset: 06ee +.out $ diff --git a/forth/icore.fs b/forth/icore.fs index ea4ef4b..ad6d542 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -54,7 +54,7 @@ ( This is only the "early parser" in earlier stages. No need for an abort message ) : (parse) - (parsed) SKIP? _c ABORT + (parsed) NOT IF _c ABORT THEN ; ( a -- ) diff --git a/forth/parse.fs b/forth/parse.fs index 7a30342..b40d352 100644 --- a/forth/parse.fs +++ b/forth/parse.fs @@ -75,10 +75,10 @@ ; : (parse) ( a -- n ) - (parsec) NOT SKIP? EXIT - (parseh) NOT SKIP? EXIT - (parseb) NOT SKIP? EXIT - (parsed) NOT SKIP? EXIT + (parsec) IF EXIT THEN + (parseh) IF EXIT THEN + (parseb) IF EXIT THEN + (parsed) IF EXIT THEN ( nothing works ) ABORT" unknown word! " ; diff --git a/tests/forth/harness.fs b/tests/forth/harness.fs index f6dc940..f94bc16 100644 --- a/tests/forth/harness.fs +++ b/tests/forth/harness.fs @@ -4,6 +4,6 @@ : fail SPC ." failed" LF 1 1 PC! BYE ; -: # SKIP? fail SPC ." pass" LF ; +: # IF SPC ." pass" LF ELSE fail THEN ; : #eq 2DUP SWAP . SPC '=' EMIT SPC . '?' EMIT = # ;