From e1f815baeb7f99bc1beba82d8336296b1d233434 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Sat, 14 Mar 2020 17:48:24 -0400 Subject: [PATCH] forth: Forth-ify main loop a bit Add words "COMPILE" and "DROP". The goal is to soon make "DEFINE" immediate and have it compile from input directly. This whole "main loop compiles everything and DEFINE picks up compiled atoms" is a bit messy. --- apps/forth/dict.asm | 75 +++++++++++++++++++++++++++-- apps/forth/dictionary.txt | 2 + apps/forth/main.asm | 99 ++++++++++++++------------------------- 3 files changed, 109 insertions(+), 67 deletions(-) diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index 9d66136..0eabf72 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -206,7 +206,6 @@ PFETCH: EXECUTE: .dw nativeWord pop iy ; is a wordref -executeCodeLink: ld l, (iy) ld h, (iy+1) ; HL points to code pointer @@ -216,9 +215,68 @@ executeCodeLink: jp (hl) ; go! + .db "COMPILE" + .dw EXECUTE + .db 1 ; IMMEDIATE +COMPILE: + .dw nativeWord + pop hl ; word addr + call find + jr nz, .maybeNum + ex de, hl + call HLisIMMED + jr z, .immed + ex de, hl + call .writeDE + jp next +.maybeNum: + push hl ; --> lvl 1. save string addr + call parseLiteral + pop hl ; <-- lvl 1 + jr nz, .undef + ; a valid number in DE! + ex de, hl + ld de, NUMBER + call .writeDE + ex de, hl ; number in DE + call .writeDE + jp next +.undef: + ; When encountering an undefined word during compilation, we spit a + ; reference to litWord, followed by the null-terminated word. + ; This way, if a preceding word expect a string literal, it will read it + ; by calling readLIT, and if it doesn't, the routine will be + ; called, triggering an abort. + ld de, LIT + call .writeDE + ld de, (HERE) + call strcpyM + ld (HERE), de + jp next +.immed: + ; For this IMMEDIATE word to be compatible with regular execution model, + ; it needs to be compiled as an atom somewhere in memory. + ; For example, RECURSE backtracks in RS and steps back 2 bytes. This + ; can only work with our compiled atom being next to an EXIT atom. + ex de, hl ; atom to write in DE + ld hl, (OLDHERE) + push hl \ pop iy + call DEinHL + ld de, EXIT + call DEinHL + jp compiledWord +.writeDE: + push hl + ld hl, (HERE) + call DEinHL + ld (HERE), hl + pop hl + ret + + .db ";" .fill 6 - .dw EXECUTE + .dw COMPILE .db 0 ENDDEF: .dw nativeWord @@ -377,7 +435,6 @@ KEY: WORD: .dw nativeWord call readword - jp nz, abort push hl jp next @@ -487,10 +544,20 @@ LITFETCH: push hl jp next +; ( a -- ) + .db "DROP" + .fill 3 + .dw LITFETCH + .db 0 +DROP: + .dw nativeWord + pop hl + jp next + ; ( a b -- b a ) .db "SWAP" .fill 3 - .dw LITFETCH + .dw DROP .db 0 SWAP: .dw nativeWord diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt index ecf236e..6213fd0 100644 --- a/apps/forth/dictionary.txt +++ b/apps/forth/dictionary.txt @@ -51,6 +51,7 @@ VARIABLE c -- Creates cell x with 2 bytes allocation. *** Flow *** (fbr) -- Branches forward by the number specified in its atom's cell. +COMPILE a -- Compile string word at addr a and spit it to HERE. ELSE I:a -- *I* Compiles a (fbr) and set branching cell at a. EXECUTE a -- Execute wordref at addr a IF -- I:a *I* Compiles a (fbr?) and pushes its cell's addr @@ -64,6 +65,7 @@ SKIP? f -- If f is true, skip the execution of the next atom. THEN I:a -- *I* Set branching cell at a. *** Parameter Stack *** +DROP a -- DUP a -- a a OVER a b -- a b a SWAP a b -- b a diff --git a/apps/forth/main.asm b/apps/forth/main.asm index ac24513..468c42f 100644 --- a/apps/forth/main.asm +++ b/apps/forth/main.asm @@ -69,7 +69,7 @@ ; EXECUTING A WORD ; ; At it's core, executing a word is having the wordref in IY and call -; executeCodeLink. Then, we let the word do its things. Some words are special, +; EXECUTE. Then, we let the word do its things. Some words are special, ; but most of them are of the compiledWord type, and that's their execution that ; we describe here. ; @@ -109,9 +109,7 @@ forthRdLineNoOk: call printcrlf call stdioReadLine ld (INPUTPOS), hl - ; Setup return stack. As a safety net, we set its bottom to ABORTREF. - ld hl, ABORTREF - ld (RS_ADDR), hl + ; Setup return stack. After INTERPRET, we run forthExecLine ld ix, RS_ADDR ; We're about to compile the line and possibly execute IMMEDIATE words. ; Let's save current (HERE) and temporarily set it to COMPBUF. @@ -119,61 +117,24 @@ forthRdLineNoOk: ld (OLDHERE), hl ld hl, COMPBUF ld (HERE), hl -forthInterpret: - call readword - jr nz, .execute - call find - jr nz, .maybeNum - ex de, hl - call HLisIMMED - jr z, .immed - ex de, hl - call .writeDE - jr forthInterpret -.maybeNum: - push hl ; --> lvl 1. save string addr - call parseLiteral - pop hl ; <-- lvl 1 - jr nz, .undef - ; a valid number in DE! - ex de, hl - ld de, NUMBER - call .writeDE - ex de, hl ; number in DE - call .writeDE - jr forthInterpret -.undef: - ; When encountering an undefined word during compilation, we spit a - ; reference to litWord, followed by the null-terminated word. - ; This way, if a preceding word expect a string literal, it will read it - ; by calling readLIT, and if it doesn't, the routine will be - ; called, triggering an abort. - ld de, LIT - call .writeDE - ld de, (HERE) - call strcpyM - ld (HERE), de - jr forthInterpret -.immed: - ; For this IMMEDIATE word to be compatible with regular execution model, - ; it needs to be compiled as an atom list. We need a temporary space for - ; this, let's use (OLDHERE) while it isn't used. - ex de, hl ; atom to write in DE - ld hl, (OLDHERE) - call DEinHL - ; Now, let's write the .retRef - ld de, .retRef - call DEinHL - ld iy, (OLDHERE) - jr .execIY -.execute: + ld hl, .retRef + ld (IP), hl + ld hl, INTERPRET + push hl + jp EXECUTE+2 +.retRef: + .dw $+2 + .dw forthExecLine + +forthExecLine: ld de, QUIT - call .writeDE + ld hl, (HERE) + call DEinHL + ld (HERE), hl ; Compilation done, let's restore (HERE) and execute! ld hl, (OLDHERE) ld (HERE), hl ld iy, COMPBUF -.execIY: ; before we execute, let's play with our RS a bit: compiledWord is ; going to push (IP) on the RS, but we don't expect our compiled words ; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and @@ -182,16 +143,28 @@ forthInterpret: ld (IP), hl ld ix, RS_ADDR-2 jp compiledWord -.writeDE: - push hl - ld hl, (HERE) - call DEinHL - ld (HERE), hl - pop hl - ret -.retRef: - .dw forthInterpret +; (we don't have RECURSE here. Calling interpret makes us needlessly use our +; RS stack, but it can take it, can't it? ) +; WORD DUP C@ (to check if null) SKIP? (skip if not null) EXIT COMPILE INTERPRET + .db 0b10 ; UNWORD +INTERPRET: + .dw compiledWord + .dw WORD + .dw DUP + .dw CFETCH + .dw CSKIP + .dw .stop + .dw COMPILE + .dw INTERPRET + .dw EXIT + +.stop: + .dw compiledWord + .dw DROP + .dw R2P + .dw DROP + .dw EXIT msgOk: .db " ok", 0