From 0e8af3cea46061b0a67557f9daa1bfd5ffb032e4 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Mon, 9 Mar 2020 15:12:44 -0400 Subject: [PATCH] forth: clarify the meaning of "wordref" Also, make entry labels in dict.asm be wordref instead of entry ref. --- apps/forth/dict.asm | 125 ++++++++++++++++++-------------------- apps/forth/dictionary.txt | 33 ++++++---- apps/forth/main.asm | 4 +- apps/forth/util.asm | 32 ++++++---- 4 files changed, 102 insertions(+), 92 deletions(-) diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index 2ab87b0..14cf533 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -13,11 +13,8 @@ nativeWord: jp (iy) -; Execute a compiled word containing a list of references to other words, -; usually ended by a reference to EXIT. -; A reference to a word in a compiledWord section is *not* a direct reference, -; but a word+CODELINK_OFFSET reference. Therefore, for a code link "link", -; (link) is the routine to call. +; Execute a list of atoms, which usually ends with EXIT. +; IY points to that list. compiledWord: push iy \ pop hl inc hl @@ -86,7 +83,7 @@ elseWord: inc bc \ inc bc call intoHL or a ; clear carry - ld de, EXIT+CODELINK_OFFSET + ld de, EXIT sbc hl, de jp z, exit ; Not EXIT, let's continue with ELSE. No carry possible because EXIT @@ -152,10 +149,10 @@ LIT: .dw litWord ; ( R:I -- ) -EXIT: .db ";" .fill 7 .dw 0 +EXIT: .dw nativeWord ; When we call the EXIT word, we have to do a "double exit" because our current ; Interpreter pointer is pointing to the word *next* to our EXIT reference when, @@ -171,26 +168,26 @@ exit: jp compiledWord ; ( R:I -- ) -QUIT: .db "QUIT", 0, 0, 0, 0 .dw EXIT +QUIT: .dw nativeWord quit: jp forthRdLine -ABORT: .db "ABORT", 0, 0, 0 .dw QUIT +ABORT: .dw nativeWord abort: ; Reinitialize PS (RS is reinitialized in forthInterpret ld sp, (INITIAL_SP) jp forthRdLine -BYE: .db "BYE" .fill 5 .dw ABORT +BYE: .dw nativeWord ; Goodbye Forth! Before we go, let's restore the stack ld sp, (INITIAL_SP) @@ -201,9 +198,9 @@ BYE: ret ; ( c -- ) -EMIT: .db "EMIT", 0, 0, 0, 0 .dw BYE +EMIT: .dw nativeWord pop hl ld a, l @@ -211,13 +208,11 @@ EMIT: jp exit ; ( addr -- ) -EXECUTE: .db "EXECUTE", 0 .dw EMIT +EXECUTE: .dw nativeWord - pop iy ; Points to word_offset - ld de, CODELINK_OFFSET - add iy, de + pop iy ; is a wordref executeCodeLink: ld l, (iy) ld h, (iy+1) @@ -227,10 +222,10 @@ executeCodeLink: ; IY points to PFA jp (hl) ; go! -DEFINE: .db ":" .fill 7 .dw EXECUTE +DEFINE: .dw nativeWord call entryhead ld de, compiledWord @@ -272,9 +267,9 @@ DEFINE: ld (HERE), de ; update HERE jp exit -DOES: .db "DOES>", 0, 0, 0 .dw DEFINE +DOES: .dw nativeWord ; We run this when we're in an entry creation context. Many things we ; need to do. @@ -285,8 +280,6 @@ DOES: ; 3. exit. Because we've already popped RS, a regular exit will abort ; colon definition, so we're good. ld iy, (CURRENT) - ld de, CODELINK_OFFSET - add iy, de ld hl, doesWord call wrCompHL inc iy \ inc iy ; cell variable space @@ -296,10 +289,10 @@ DOES: jp exit ; ( -- c ) -KEY: .db "KEY" .fill 5 .dw DOES +KEY: .dw nativeWord call stdioGetC ld h, 0 @@ -307,9 +300,9 @@ KEY: push hl jp exit -INTERPRET: .db "INTERPRE" .dw KEY +INTERPRET: .dw nativeWord interpret: ld iy, COMPBUF @@ -319,14 +312,14 @@ interpret: call compile jr .loop .end: - ld hl, QUIT+CODELINK_OFFSET + ld hl, QUIT call wrCompHL ld iy, COMPBUF jp compiledWord -CREATE: .db "CREATE", 0, 0 .dw INTERPRET +CREATE: .dw nativeWord call entryhead jp nz, quit @@ -338,24 +331,24 @@ CREATE: ld (HERE), hl jp exit -HERE_: ; Caution: conflicts with actual variable name .db "HERE" .fill 4 .dw CREATE +HERE_: ; Caution: conflicts with actual variable name .dw sysvarWord .dw HERE -CURRENT_: .db "CURRENT", 0 .dw HERE_ +CURRENT_: .dw sysvarWord .dw CURRENT ; ( n -- ) -DOT: .db "." .fill 7 .dw CURRENT_ +DOT: .dw nativeWord pop de ; We check PS explicitly because it doesn't look nice to spew gibberish @@ -367,10 +360,10 @@ DOT: jp exit ; ( n a -- ) -STORE: .db "!" .fill 7 .dw DOT +STORE: .dw nativeWord pop iy pop hl @@ -379,10 +372,10 @@ STORE: jp exit ; ( a -- n ) -FETCH: .db "@" .fill 7 .dw STORE +FETCH: .dw nativeWord pop hl call intoHL @@ -390,10 +383,10 @@ FETCH: jp exit ; ( a b -- b a ) -SWAP: .db "SWAP" .fill 4 .dw FETCH +SWAP: .dw nativeWord pop hl ex (sp), hl @@ -401,10 +394,10 @@ SWAP: jp exit ; ( a -- a a ) -DUP: .db "DUP" .fill 5 .dw SWAP +DUP: .dw nativeWord pop hl push hl @@ -412,10 +405,10 @@ DUP: jp exit ; ( a b -- a b a ) -OVER: .db "OVER" .fill 4 .dw DUP +OVER: .dw nativeWord pop hl ; B pop de ; A @@ -425,10 +418,10 @@ OVER: jp exit ; ( a b -- c ) A + B -PLUS: .db "+" .fill 7 .dw OVER +PLUS: .dw nativeWord pop hl pop de @@ -437,10 +430,10 @@ PLUS: jp exit ; ( a b -- c ) A - B -MINUS: .db "-" .fill 7 .dw PLUS +MINUS: .dw nativeWord pop de ; B pop hl ; A @@ -450,10 +443,10 @@ MINUS: jp exit ; ( a b -- c ) A * B -MULT: .db "*" .fill 7 .dw MINUS +MULT: .dw nativeWord pop de pop bc @@ -462,10 +455,10 @@ MULT: jp exit ; ( a b -- c ) A / B -DIV: .db "/" .fill 7 .dw MULT +DIV: .dw nativeWord pop de pop hl @@ -473,83 +466,83 @@ DIV: push bc jp exit -IF: .db "IF" .fill 6 .dw DIV +IF: .dw ifWord -ELSE: .db "ELSE" .fill 4 .dw IF +ELSE: .dw elseWord -THEN: .db "THEN" .fill 4 .dw ELSE +THEN: .dw thenWord ; End of native words ; ( a -- ) ; @ . -FETCHDOT: .db "?" .fill 7 .dw THEN +FETCHDOT: .dw compiledWord - .dw FETCH+CODELINK_OFFSET - .dw DOT+CODELINK_OFFSET - .dw EXIT+CODELINK_OFFSET + .dw FETCH + .dw DOT + .dw EXIT ; ( n a -- ) ; SWAP OVER @ + SWAP ! -STOREINC: .db "+!" .fill 6 .dw FETCHDOT +STOREINC: .dw compiledWord - .dw SWAP+CODELINK_OFFSET - .dw OVER+CODELINK_OFFSET - .dw FETCH+CODELINK_OFFSET - .dw PLUS+CODELINK_OFFSET - .dw SWAP+CODELINK_OFFSET - .dw STORE+CODELINK_OFFSET - .dw EXIT+CODELINK_OFFSET + .dw SWAP + .dw OVER + .dw FETCH + .dw PLUS + .dw SWAP + .dw STORE + .dw EXIT ; ( n -- ) ; HERE +! -ALLOT: .db "ALLOT", 0, 0, 0 .dw STOREINC +ALLOT: .dw compiledWord - .dw HERE_+CODELINK_OFFSET - .dw STOREINC+CODELINK_OFFSET - .dw EXIT+CODELINK_OFFSET + .dw HERE_ + .dw STOREINC + .dw EXIT ; CREATE 2 ALLOT -VARIABLE: .db "VARIABLE" .dw ALLOT +VARIABLE: .dw compiledWord - .dw CREATE+CODELINK_OFFSET + .dw CREATE .dw NUMBER .dw 2 - .dw ALLOT+CODELINK_OFFSET - .dw EXIT+CODELINK_OFFSET + .dw ALLOT + .dw EXIT ; ( n -- ) ; CREATE HERE @ ! DOES> @ -CONSTANT: .db "CONSTANT" .dw VARIABLE +CONSTANT: .dw compiledWord - .dw CREATE+CODELINK_OFFSET - .dw HERE_+CODELINK_OFFSET - .dw FETCH+CODELINK_OFFSET - .dw STORE+CODELINK_OFFSET - .dw DOES+CODELINK_OFFSET - .dw FETCH+CODELINK_OFFSET - .dw EXIT+CODELINK_OFFSET + .dw CREATE + .dw HERE_ + .dw FETCH + .dw STORE + .dw DOES + .dw FETCH + .dw EXIT diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt index 01f358f..0efc49e 100644 --- a/apps/forth/dictionary.txt +++ b/apps/forth/dictionary.txt @@ -1,19 +1,29 @@ Stack notation: " -- ". Rightmost is top of stack - (TOS). For example, in "a b -- c d", b is TOS before, d is TOS - after. "R:" means that the Return Stack is modified. +(TOS). For example, in "a b -- c d", b is TOS before, d is TOS after. "R:" means +that the Return Stack is modified. DOES>: Used inside a colon definition that itself uses CREATE, DOES> transforms - that newly created word into a "does cell", that is, a regular cell ( - when called, puts the cell's addr on PS), but right after that, it - executes words that appear after the DOES>. +that newly created word into a "does cell", that is, a regular cell ( when +called, puts the cell's addr on PS), but right after that, it executes words +that appear after the DOES>. - "does cells" always allocate 4 bytes (2 for the cell, 2 for the DOES> - link) and there is no need for ALLOT in colon definition. +"does cells" always allocate 4 bytes (2 for the cell, 2 for the DOES> link) and +there is no need for ALLOT in colon definition. - At compile time, colon definition stops processing words when reaching - the DOES>. +At compile time, colon definition stops processing words when reaching the +DOES>. - Example: ": CONSTANT CREATE HERE @ ! DOES> @ ;" +Example: ": CONSTANT CREATE HERE @ ! DOES> @ ;" + +Word references (wordref): When we say we have a "word reference", it's a +pointer to a words *code link*. For example, the label "PLUS:" in this unit is a +word reference. Why not refer to the beginning of the word struct? Because we +actually seldom refer to the name and prev link, except during compilation, so +defining "word reference" this way makes the code easier to understand. + +Atom: A word of the type compiledWord contains, in its PF, a list of what we +call "atoms". Those atoms are most of the time word references, but they can +also be references to NUMBER and LIT. *** Native Words *** @@ -27,11 +37,12 @@ DOES>: Used inside a colon definition that itself uses CREATE, DOES> transforms * a b -- c a * b -> c / a b -- c a / b -> c CREATE x -- Create cell named x. Doesn't allocate a PF. +CURRENT -- n Set n to wordref of last added entry. DOES> -- See description at top of file DUP a -- a a ELSE -- Branch to THEN EMIT c -- Spit char c to stdout -EXECUTE a -- Execute word at addr a +EXECUTE a -- Execute wordref at addr a HERE -- a Push HERE's address IF n -- Branch to ELSE or THEN if n is zero QUIT R:drop -- Return to interpreter promp immediately diff --git a/apps/forth/main.asm b/apps/forth/main.asm index 6abcb02..cd25199 100644 --- a/apps/forth/main.asm +++ b/apps/forth/main.asm @@ -6,7 +6,7 @@ ; Max length of dict entry names .equ NAMELEN 8 ; Offset of the code link relative to the beginning of the word -.equ CODELINK_OFFSET 10 +.equ CODELINK_OFFSET NAMELEN+2 ; *** Variables *** .equ INITIAL_SP FORTH_RAMSTART @@ -39,7 +39,7 @@ forthRdLine: ld (INPUTPOS), hl forthInterpret: ld ix, RS_ADDR-2 ; -2 because we inc-before-push - ld iy, INTERPRET+CODELINK_OFFSET + ld iy, INTERPRET jp executeCodeLink msgOk: .db " ok", 0 diff --git a/apps/forth/util.asm b/apps/forth/util.asm index d0e8e2e..80f42be 100644 --- a/apps/forth/util.asm +++ b/apps/forth/util.asm @@ -80,7 +80,7 @@ RSIsLIT: ; Z if yes, NZ if no. RSIsEXIT: push de - ld de, EXIT+CODELINK_OFFSET + ld de, EXIT call RSIsDE pop de ret @@ -163,14 +163,10 @@ readCompWord: .msg: .db "word expected", 0 -; For DE pointing to a dict entry, set DE to point to the previous entry. +; For DE being a wordref, move DE to the previous wordref. ; Z is set if DE point to 0 (no entry). NZ if not. prev: - push hl ; --> lvl 1 - ld hl, NAMELEN ; prev field offset - add hl, de - ex de, hl - pop hl ; <-- lvl 1 + dec de \ dec de ; prev field call intoDE ; DE points to prev. Is it zero? xor a @@ -183,15 +179,28 @@ prev: ; point to that entry. ; Z if found, NZ if not. find: + push hl + push bc ld de, (CURRENT) + ld bc, CODELINK_OFFSET .inner: + ; DE is a wordref, let's go to beginning of struct + push de ; --> lvl 1 + or a ; clear carry + ex de, hl + sbc hl, bc + ex de, hl ; We're good, DE points to word name ld a, NAMELEN call strncmp - ret z ; found + pop de ; <-- lvl 1, return to wordref + jr z, .end ; found call prev jr nz, .inner ; Z set? end of dict unset Z inc a +.end: + pop bc + pop hl ret ; Write compiled data from HL into IY, advancing IY at the same time. @@ -207,10 +216,7 @@ wrCompHL: compile: call find jr nz, .maybeNum - ; DE is a word offset, we need a code link - ld hl, CODELINK_OFFSET - add hl, de - xor a ; set Z + ex de, hl jr wrCompHL .maybeNum: push hl ; --> lvl 1. save string addr @@ -250,13 +256,13 @@ entryhead: call strcpy ex de, hl ; (HERE) now in HL ld de, (CURRENT) - ld (CURRENT), hl ld a, NAMELEN call addHL ld (hl), e inc hl ld (hl), d inc hl + ld (CURRENT), hl ld (HERE), hl xor a ; set Z ret