forth: add words "(fbr)", "(fbr?)", "'", "[']"

This commit is contained in:
Virgil Dupras 2020-03-12 21:16:20 -04:00
parent fb54fd51af
commit d5a7d5faf8
3 changed files with 110 additions and 52 deletions

View File

@ -11,7 +11,7 @@
; "jp exit". ; "jp exit".
; ;
; That's for "regular" words (words that are part of the dict chain). There are ; That's for "regular" words (words that are part of the dict chain). There are
; also "special words", for example NUMBER, LIT, BRANCH, that have a slightly ; also "special words", for example NUMBER, LIT, FBR, that have a slightly
; different structure. They're also a pointer to an executable, but as for the ; different structure. They're also a pointer to an executable, but as for the
; other fields, the only one they have is the "flags" field. ; other fields, the only one they have is the "flags" field.
@ -56,42 +56,6 @@ doesWord:
push hl \ pop iy push hl \ pop iy
jr compiledWord jr compiledWord
; This word is followed by 1b *relative* offset (to the cell's addr) to where to
; branch to. For example, The branching cell of "IF THEN" would contain 3. Add
; this value to RS.
branchWord:
push de
ld l, (ix)
ld h, (ix+1)
ld a, (hl)
call addHL
ld (ix), l
ld (ix+1), h
pop de
jp exit
.db 0b10 ; Flags
BRANCH:
.dw branchWord
; Conditional branch, only branch if TOS is zero
cbranchWord:
pop hl
ld a, h
or l
jr z, branchWord
; skip next byte in RS
ld l, (ix)
ld h, (ix+1)
inc hl
ld (ix), l
ld (ix+1), h
jp exit
.db 0b10 ; Flags
CBRANCH:
.dw cbranchWord
; This is not a word, but a number literal. This works a bit differently than ; This is not a word, but a number literal. This works a bit differently than
; others: PF means nothing and the actual number is placed next to the ; others: PF means nothing and the actual number is placed next to the
; numberWord reference in the compiled word list. What we need to do to fetch ; numberWord reference in the compiled word list. What we need to do to fetch
@ -338,10 +302,53 @@ LITERAL:
ld (HERE), hl ld (HERE), hl
jp exit jp exit
.db "'"
.fill 6
.dw LITERAL
.db 0
APOS:
.dw nativeWord
call readLITBOS
call find
jr nz, .notfound
push de
jp exit
.notfound:
ld hl, .msg
call printstr
jp abort
.msg:
.db "word not found", 0
.db "[']"
.fill 4
.dw APOS
.db 0b01 ; IMMEDIATE
APOSI:
.dw nativeWord
call readword
call find
jr nz, .notfound
ld hl, (HERE)
push de ; --> lvl 1
ld de, NUMBER
call DEinHL
pop de ; <-- lvl 1
call DEinHL
ld (HERE), hl
jp exit
.notfound:
ld hl, .msg
call printstr
jp abort
.msg:
.db "word not found", 0
; ( -- c ) ; ( -- c )
.db "KEY" .db "KEY"
.fill 4 .fill 4
.dw LITERAL .dw APOSI
.db 0 .db 0
KEY: KEY:
.dw nativeWord .dw nativeWord
@ -630,9 +637,49 @@ CMP:
push bc push bc
jp exit jp exit
; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
; where to branch to. For example, The branching cell of "IF THEN" would
; contain 3. Add this value to RS.
.db "(fbr)"
.fill 2
.dw CMP
.db 0
FBR:
.dw nativeWord
push de
ld l, (ix)
ld h, (ix+1)
ld a, (hl)
call addHL
ld (ix), l
ld (ix+1), h
pop de
jp exit
; Conditional branch, only branch if TOS is zero
.db "(fbr?)"
.fill 1
.dw FBR
.db 0
FBRC:
.dw nativeWord
pop hl
ld a, h
or l
jr z, FBR+2
; skip next byte in RS
ld l, (ix)
ld h, (ix+1)
inc hl
ld (ix), l
ld (ix+1), h
jp exit
; : IF ' (fbr?) , HERE @ 0 C, ; IMMEDIATE
.db "IF" .db "IF"
.fill 5 .fill 5
.dw CMP .dw FBRC
.db 1 ; IMMEDIATE .db 1 ; IMMEDIATE
IF: IF:
.dw nativeWord .dw nativeWord
@ -640,7 +687,7 @@ IF:
; push the address of that cell on the PS. ELSE or THEN will pick ; push the address of that cell on the PS. ELSE or THEN will pick
; them up and set the offset. ; them up and set the offset.
ld hl, (HERE) ld hl, (HERE)
ld de, CBRANCH ld de, FBRC
call DEinHL call DEinHL
push hl ; address of cell to fill push hl ; address of cell to fill
inc hl ; empty 1b cell inc hl ; empty 1b cell
@ -666,7 +713,7 @@ ELSE:
; uncondition branching cell, which will then be picked up by THEN. ; uncondition branching cell, which will then be picked up by THEN.
; First, let's spit our 4 bytes ; First, let's spit our 4 bytes
ld hl, (HERE) ld hl, (HERE)
ld de, BRANCH ld de, FBR
call DEinHL call DEinHL
push hl ; address of cell to fill push hl ; address of cell to fill
inc hl ; empty 1b cell inc hl ; empty 1b cell

View File

@ -1,6 +1,7 @@
Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack
(TOS). For example, in "a b -- c d", b is TOS before, d is TOS after. "R:" means (TOS). For example, in "a b -- c d", b is TOS before, d is TOS after. "R:" means
that the Return Stack is modified. that the Return Stack is modified. "I:" prefix means "IMMEDIATE", that is, that
this stack transformation is made at compile time.
DOES>: Used inside a colon definition that itself uses CREATE, DOES> transforms 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 that newly created word into a "does cell", that is, a regular cell ( when
@ -25,29 +26,39 @@ 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 call "atoms". Those atoms are most of the time word references, but they can
also be references to NUMBER and LIT. also be references to NUMBER and LIT.
Words between "()" are "support words" that aren't really meant to be used
directly, but as part of another word.
"*I*" in description indicates an IMMEDIATE word.
*** Defining words *** *** Defining words ***
: x ... -- Define a new word : x ... -- Define a new word
; R:I -- Exit a colon definition ; R:I -- Exit a colon definition
, n -- Write n in HERE and advance it. , n -- Write n in HERE and advance it.
' x -- a Push addr of word x to a.
['] x -- *I* Like "'", but spits the addr as a number literal.
ALLOT n -- Move HERE by n bytes ALLOT n -- Move HERE by n bytes
C, b -- Write byte b in HERE and advance it. C, b -- Write byte b in HERE and advance it.
CREATE x -- Create cell named x. Doesn't allocate a PF. CREATE x -- Create cell named x. Doesn't allocate a PF.
CONSTANT x n -- Creates cell x that when called pushes its value CONSTANT x n -- Creates cell x that when called pushes its value
DOES> -- See description at top of file DOES> -- See description at top of file
IMMEDIATE -- Flag the latest defined word as immediate. IMMEDIATE -- Flag the latest defined word as immediate.
LITERAL n -- Inserts number from TOS as a literal LITERAL n -- *I* Inserts number from TOS as a literal
VARIABLE c -- Creates cell x with 2 bytes allocation. VARIABLE c -- Creates cell x with 2 bytes allocation.
*** Flow *** *** Flow ***
ELSE -- Branch to THEN (fbr?) f -- Conditionally branches forward by the number
specified in its atom's cell.
(fbr) -- Branches forward by the number specified in its
atom's cell.
ELSE I:a -- *I* Compiles a (fbr) and set branching cell at a.
EXECUTE a -- Execute wordref at addr a EXECUTE a -- Execute wordref at addr a
IF n -- Branch to ELSE or THEN if n is zero IF -- I:a *I* Compiles a (fbr?) and pushes its cell's addr
INTERPRET -- Get a line from stdin, compile it in tmp memory, INTERPRET -- Get a line from stdin, compile it in tmp memory,
then execute the compiled contents. then execute the compiled contents.
QUIT R:drop -- Return to interpreter promp immediately QUIT R:drop -- Return to interpreter promp immediately
RECURSE R:I -- R:I-2 Run the current word again. RECURSE R:I -- R:I-2 Run the current word again.
THEN -- Does nothing. Serves as a branching merker for IF THEN I:a -- *I* Set branching cell at a.
and ELSE.
*** Stack *** *** Stack ***
DUP a -- a a DUP a -- a a

View File

@ -69,12 +69,12 @@ HLPointsLIT:
pop de pop de
ret ret
HLPointsBRANCH: HLPointsBR:
push de push de
ld de, BRANCH ld de, FBR
call HLPointsDE call HLPointsDE
jr z, .end jr z, .end
ld de, CBRANCH ld de, FBRC
call HLPointsDE call HLPointsDE
.end: .end:
pop de pop de
@ -93,7 +93,7 @@ HLPointsEXIT:
compSkip: compSkip:
call HLPointsNUMBER call HLPointsNUMBER
jr z, .isNum jr z, .isNum
call HLPointsBRANCH call HLPointsBR
jr z, .isBranch jr z, .isBranch
call HLPointsLIT call HLPointsLIT
jr nz, .isWord jr nz, .isWord
@ -171,7 +171,7 @@ readLIT:
.notLIT: .notLIT:
; Alright, not a literal, but is it a word? ; Alright, not a literal, but is it a word?
call HLPointsUNWORD call HLPointsUNWORD
jr nz, .notWord jr z, .notWord
; Not a number, then it's a word. Copy word to pad and point to it. ; Not a number, then it's a word. Copy word to pad and point to it.
push hl ; --> lvl 1. we need it to set DE later push hl ; --> lvl 1. we need it to set DE later
call intoHL call intoHL