mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-26 04:08:06 +11:00
forth: clarify the meaning of "wordref"
Also, make entry labels in dict.asm be wordref instead of entry ref.
This commit is contained in:
parent
e8a4768304
commit
0e8af3cea4
@ -13,11 +13,8 @@
|
|||||||
nativeWord:
|
nativeWord:
|
||||||
jp (iy)
|
jp (iy)
|
||||||
|
|
||||||
; Execute a compiled word containing a list of references to other words,
|
; Execute a list of atoms, which usually ends with EXIT.
|
||||||
; usually ended by a reference to EXIT.
|
; IY points to that list.
|
||||||
; 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.
|
|
||||||
compiledWord:
|
compiledWord:
|
||||||
push iy \ pop hl
|
push iy \ pop hl
|
||||||
inc hl
|
inc hl
|
||||||
@ -86,7 +83,7 @@ elseWord:
|
|||||||
inc bc \ inc bc
|
inc bc \ inc bc
|
||||||
call intoHL
|
call intoHL
|
||||||
or a ; clear carry
|
or a ; clear carry
|
||||||
ld de, EXIT+CODELINK_OFFSET
|
ld de, EXIT
|
||||||
sbc hl, de
|
sbc hl, de
|
||||||
jp z, exit
|
jp z, exit
|
||||||
; Not EXIT, let's continue with ELSE. No carry possible because EXIT
|
; Not EXIT, let's continue with ELSE. No carry possible because EXIT
|
||||||
@ -152,10 +149,10 @@ LIT:
|
|||||||
.dw litWord
|
.dw litWord
|
||||||
|
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
EXIT:
|
|
||||||
.db ";"
|
.db ";"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw 0
|
.dw 0
|
||||||
|
EXIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
; When we call the EXIT word, we have to do a "double exit" because our current
|
; 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,
|
; Interpreter pointer is pointing to the word *next* to our EXIT reference when,
|
||||||
@ -171,26 +168,26 @@ exit:
|
|||||||
jp compiledWord
|
jp compiledWord
|
||||||
|
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
QUIT:
|
|
||||||
.db "QUIT", 0, 0, 0, 0
|
.db "QUIT", 0, 0, 0, 0
|
||||||
.dw EXIT
|
.dw EXIT
|
||||||
|
QUIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
quit:
|
quit:
|
||||||
jp forthRdLine
|
jp forthRdLine
|
||||||
|
|
||||||
ABORT:
|
|
||||||
.db "ABORT", 0, 0, 0
|
.db "ABORT", 0, 0, 0
|
||||||
.dw QUIT
|
.dw QUIT
|
||||||
|
ABORT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
abort:
|
abort:
|
||||||
; Reinitialize PS (RS is reinitialized in forthInterpret
|
; Reinitialize PS (RS is reinitialized in forthInterpret
|
||||||
ld sp, (INITIAL_SP)
|
ld sp, (INITIAL_SP)
|
||||||
jp forthRdLine
|
jp forthRdLine
|
||||||
|
|
||||||
BYE:
|
|
||||||
.db "BYE"
|
.db "BYE"
|
||||||
.fill 5
|
.fill 5
|
||||||
.dw ABORT
|
.dw ABORT
|
||||||
|
BYE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
; Goodbye Forth! Before we go, let's restore the stack
|
; Goodbye Forth! Before we go, let's restore the stack
|
||||||
ld sp, (INITIAL_SP)
|
ld sp, (INITIAL_SP)
|
||||||
@ -201,9 +198,9 @@ BYE:
|
|||||||
ret
|
ret
|
||||||
|
|
||||||
; ( c -- )
|
; ( c -- )
|
||||||
EMIT:
|
|
||||||
.db "EMIT", 0, 0, 0, 0
|
.db "EMIT", 0, 0, 0, 0
|
||||||
.dw BYE
|
.dw BYE
|
||||||
|
EMIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
ld a, l
|
ld a, l
|
||||||
@ -211,13 +208,11 @@ EMIT:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( addr -- )
|
; ( addr -- )
|
||||||
EXECUTE:
|
|
||||||
.db "EXECUTE", 0
|
.db "EXECUTE", 0
|
||||||
.dw EMIT
|
.dw EMIT
|
||||||
|
EXECUTE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop iy ; Points to word_offset
|
pop iy ; is a wordref
|
||||||
ld de, CODELINK_OFFSET
|
|
||||||
add iy, de
|
|
||||||
executeCodeLink:
|
executeCodeLink:
|
||||||
ld l, (iy)
|
ld l, (iy)
|
||||||
ld h, (iy+1)
|
ld h, (iy+1)
|
||||||
@ -227,10 +222,10 @@ executeCodeLink:
|
|||||||
; IY points to PFA
|
; IY points to PFA
|
||||||
jp (hl) ; go!
|
jp (hl) ; go!
|
||||||
|
|
||||||
DEFINE:
|
|
||||||
.db ":"
|
.db ":"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw EXECUTE
|
.dw EXECUTE
|
||||||
|
DEFINE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call entryhead
|
call entryhead
|
||||||
ld de, compiledWord
|
ld de, compiledWord
|
||||||
@ -272,9 +267,9 @@ DEFINE:
|
|||||||
ld (HERE), de ; update HERE
|
ld (HERE), de ; update HERE
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
DOES:
|
|
||||||
.db "DOES>", 0, 0, 0
|
.db "DOES>", 0, 0, 0
|
||||||
.dw DEFINE
|
.dw DEFINE
|
||||||
|
DOES:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
; We run this when we're in an entry creation context. Many things we
|
; We run this when we're in an entry creation context. Many things we
|
||||||
; need to do.
|
; need to do.
|
||||||
@ -285,8 +280,6 @@ DOES:
|
|||||||
; 3. exit. Because we've already popped RS, a regular exit will abort
|
; 3. exit. Because we've already popped RS, a regular exit will abort
|
||||||
; colon definition, so we're good.
|
; colon definition, so we're good.
|
||||||
ld iy, (CURRENT)
|
ld iy, (CURRENT)
|
||||||
ld de, CODELINK_OFFSET
|
|
||||||
add iy, de
|
|
||||||
ld hl, doesWord
|
ld hl, doesWord
|
||||||
call wrCompHL
|
call wrCompHL
|
||||||
inc iy \ inc iy ; cell variable space
|
inc iy \ inc iy ; cell variable space
|
||||||
@ -296,10 +289,10 @@ DOES:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( -- c )
|
; ( -- c )
|
||||||
KEY:
|
|
||||||
.db "KEY"
|
.db "KEY"
|
||||||
.fill 5
|
.fill 5
|
||||||
.dw DOES
|
.dw DOES
|
||||||
|
KEY:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call stdioGetC
|
call stdioGetC
|
||||||
ld h, 0
|
ld h, 0
|
||||||
@ -307,9 +300,9 @@ KEY:
|
|||||||
push hl
|
push hl
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
INTERPRET:
|
|
||||||
.db "INTERPRE"
|
.db "INTERPRE"
|
||||||
.dw KEY
|
.dw KEY
|
||||||
|
INTERPRET:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
interpret:
|
interpret:
|
||||||
ld iy, COMPBUF
|
ld iy, COMPBUF
|
||||||
@ -319,14 +312,14 @@ interpret:
|
|||||||
call compile
|
call compile
|
||||||
jr .loop
|
jr .loop
|
||||||
.end:
|
.end:
|
||||||
ld hl, QUIT+CODELINK_OFFSET
|
ld hl, QUIT
|
||||||
call wrCompHL
|
call wrCompHL
|
||||||
ld iy, COMPBUF
|
ld iy, COMPBUF
|
||||||
jp compiledWord
|
jp compiledWord
|
||||||
|
|
||||||
CREATE:
|
|
||||||
.db "CREATE", 0, 0
|
.db "CREATE", 0, 0
|
||||||
.dw INTERPRET
|
.dw INTERPRET
|
||||||
|
CREATE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call entryhead
|
call entryhead
|
||||||
jp nz, quit
|
jp nz, quit
|
||||||
@ -338,24 +331,24 @@ CREATE:
|
|||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
HERE_: ; Caution: conflicts with actual variable name
|
|
||||||
.db "HERE"
|
.db "HERE"
|
||||||
.fill 4
|
.fill 4
|
||||||
.dw CREATE
|
.dw CREATE
|
||||||
|
HERE_: ; Caution: conflicts with actual variable name
|
||||||
.dw sysvarWord
|
.dw sysvarWord
|
||||||
.dw HERE
|
.dw HERE
|
||||||
|
|
||||||
CURRENT_:
|
|
||||||
.db "CURRENT", 0
|
.db "CURRENT", 0
|
||||||
.dw HERE_
|
.dw HERE_
|
||||||
|
CURRENT_:
|
||||||
.dw sysvarWord
|
.dw sysvarWord
|
||||||
.dw CURRENT
|
.dw CURRENT
|
||||||
|
|
||||||
; ( n -- )
|
; ( n -- )
|
||||||
DOT:
|
|
||||||
.db "."
|
.db "."
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw CURRENT_
|
.dw CURRENT_
|
||||||
|
DOT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop de
|
pop de
|
||||||
; We check PS explicitly because it doesn't look nice to spew gibberish
|
; We check PS explicitly because it doesn't look nice to spew gibberish
|
||||||
@ -367,10 +360,10 @@ DOT:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( n a -- )
|
; ( n a -- )
|
||||||
STORE:
|
|
||||||
.db "!"
|
.db "!"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw DOT
|
.dw DOT
|
||||||
|
STORE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop iy
|
pop iy
|
||||||
pop hl
|
pop hl
|
||||||
@ -379,10 +372,10 @@ STORE:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a -- n )
|
; ( a -- n )
|
||||||
FETCH:
|
|
||||||
.db "@"
|
.db "@"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw STORE
|
.dw STORE
|
||||||
|
FETCH:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
call intoHL
|
call intoHL
|
||||||
@ -390,10 +383,10 @@ FETCH:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a b -- b a )
|
; ( a b -- b a )
|
||||||
SWAP:
|
|
||||||
.db "SWAP"
|
.db "SWAP"
|
||||||
.fill 4
|
.fill 4
|
||||||
.dw FETCH
|
.dw FETCH
|
||||||
|
SWAP:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
ex (sp), hl
|
ex (sp), hl
|
||||||
@ -401,10 +394,10 @@ SWAP:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a -- a a )
|
; ( a -- a a )
|
||||||
DUP:
|
|
||||||
.db "DUP"
|
.db "DUP"
|
||||||
.fill 5
|
.fill 5
|
||||||
.dw SWAP
|
.dw SWAP
|
||||||
|
DUP:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
push hl
|
push hl
|
||||||
@ -412,10 +405,10 @@ DUP:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a b -- a b a )
|
; ( a b -- a b a )
|
||||||
OVER:
|
|
||||||
.db "OVER"
|
.db "OVER"
|
||||||
.fill 4
|
.fill 4
|
||||||
.dw DUP
|
.dw DUP
|
||||||
|
OVER:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl ; B
|
pop hl ; B
|
||||||
pop de ; A
|
pop de ; A
|
||||||
@ -425,10 +418,10 @@ OVER:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A + B
|
; ( a b -- c ) A + B
|
||||||
PLUS:
|
|
||||||
.db "+"
|
.db "+"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw OVER
|
.dw OVER
|
||||||
|
PLUS:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
pop de
|
pop de
|
||||||
@ -437,10 +430,10 @@ PLUS:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A - B
|
; ( a b -- c ) A - B
|
||||||
MINUS:
|
|
||||||
.db "-"
|
.db "-"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw PLUS
|
.dw PLUS
|
||||||
|
MINUS:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop de ; B
|
pop de ; B
|
||||||
pop hl ; A
|
pop hl ; A
|
||||||
@ -450,10 +443,10 @@ MINUS:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A * B
|
; ( a b -- c ) A * B
|
||||||
MULT:
|
|
||||||
.db "*"
|
.db "*"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw MINUS
|
.dw MINUS
|
||||||
|
MULT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop de
|
pop de
|
||||||
pop bc
|
pop bc
|
||||||
@ -462,10 +455,10 @@ MULT:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A / B
|
; ( a b -- c ) A / B
|
||||||
DIV:
|
|
||||||
.db "/"
|
.db "/"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw MULT
|
.dw MULT
|
||||||
|
DIV:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop de
|
pop de
|
||||||
pop hl
|
pop hl
|
||||||
@ -473,83 +466,83 @@ DIV:
|
|||||||
push bc
|
push bc
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
IF:
|
|
||||||
.db "IF"
|
.db "IF"
|
||||||
.fill 6
|
.fill 6
|
||||||
.dw DIV
|
.dw DIV
|
||||||
|
IF:
|
||||||
.dw ifWord
|
.dw ifWord
|
||||||
|
|
||||||
ELSE:
|
|
||||||
.db "ELSE"
|
.db "ELSE"
|
||||||
.fill 4
|
.fill 4
|
||||||
.dw IF
|
.dw IF
|
||||||
|
ELSE:
|
||||||
.dw elseWord
|
.dw elseWord
|
||||||
|
|
||||||
THEN:
|
|
||||||
.db "THEN"
|
.db "THEN"
|
||||||
.fill 4
|
.fill 4
|
||||||
.dw ELSE
|
.dw ELSE
|
||||||
|
THEN:
|
||||||
.dw thenWord
|
.dw thenWord
|
||||||
|
|
||||||
; End of native words
|
; End of native words
|
||||||
|
|
||||||
; ( a -- )
|
; ( a -- )
|
||||||
; @ .
|
; @ .
|
||||||
FETCHDOT:
|
|
||||||
.db "?"
|
.db "?"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw THEN
|
.dw THEN
|
||||||
|
FETCHDOT:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw FETCH+CODELINK_OFFSET
|
.dw FETCH
|
||||||
.dw DOT+CODELINK_OFFSET
|
.dw DOT
|
||||||
.dw EXIT+CODELINK_OFFSET
|
.dw EXIT
|
||||||
|
|
||||||
; ( n a -- )
|
; ( n a -- )
|
||||||
; SWAP OVER @ + SWAP !
|
; SWAP OVER @ + SWAP !
|
||||||
STOREINC:
|
|
||||||
.db "+!"
|
.db "+!"
|
||||||
.fill 6
|
.fill 6
|
||||||
.dw FETCHDOT
|
.dw FETCHDOT
|
||||||
|
STOREINC:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw SWAP+CODELINK_OFFSET
|
.dw SWAP
|
||||||
.dw OVER+CODELINK_OFFSET
|
.dw OVER
|
||||||
.dw FETCH+CODELINK_OFFSET
|
.dw FETCH
|
||||||
.dw PLUS+CODELINK_OFFSET
|
.dw PLUS
|
||||||
.dw SWAP+CODELINK_OFFSET
|
.dw SWAP
|
||||||
.dw STORE+CODELINK_OFFSET
|
.dw STORE
|
||||||
.dw EXIT+CODELINK_OFFSET
|
.dw EXIT
|
||||||
|
|
||||||
; ( n -- )
|
; ( n -- )
|
||||||
; HERE +!
|
; HERE +!
|
||||||
ALLOT:
|
|
||||||
.db "ALLOT", 0, 0, 0
|
.db "ALLOT", 0, 0, 0
|
||||||
.dw STOREINC
|
.dw STOREINC
|
||||||
|
ALLOT:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw HERE_+CODELINK_OFFSET
|
.dw HERE_
|
||||||
.dw STOREINC+CODELINK_OFFSET
|
.dw STOREINC
|
||||||
.dw EXIT+CODELINK_OFFSET
|
.dw EXIT
|
||||||
|
|
||||||
; CREATE 2 ALLOT
|
; CREATE 2 ALLOT
|
||||||
VARIABLE:
|
|
||||||
.db "VARIABLE"
|
.db "VARIABLE"
|
||||||
.dw ALLOT
|
.dw ALLOT
|
||||||
|
VARIABLE:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw CREATE+CODELINK_OFFSET
|
.dw CREATE
|
||||||
.dw NUMBER
|
.dw NUMBER
|
||||||
.dw 2
|
.dw 2
|
||||||
.dw ALLOT+CODELINK_OFFSET
|
.dw ALLOT
|
||||||
.dw EXIT+CODELINK_OFFSET
|
.dw EXIT
|
||||||
|
|
||||||
; ( n -- )
|
; ( n -- )
|
||||||
; CREATE HERE @ ! DOES> @
|
; CREATE HERE @ ! DOES> @
|
||||||
CONSTANT:
|
|
||||||
.db "CONSTANT"
|
.db "CONSTANT"
|
||||||
.dw VARIABLE
|
.dw VARIABLE
|
||||||
|
CONSTANT:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw CREATE+CODELINK_OFFSET
|
.dw CREATE
|
||||||
.dw HERE_+CODELINK_OFFSET
|
.dw HERE_
|
||||||
.dw FETCH+CODELINK_OFFSET
|
.dw FETCH
|
||||||
.dw STORE+CODELINK_OFFSET
|
.dw STORE
|
||||||
.dw DOES+CODELINK_OFFSET
|
.dw DOES
|
||||||
.dw FETCH+CODELINK_OFFSET
|
.dw FETCH
|
||||||
.dw EXIT+CODELINK_OFFSET
|
.dw EXIT
|
||||||
|
@ -1,19 +1,29 @@
|
|||||||
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
|
(TOS). For example, in "a b -- c d", b is TOS before, d is TOS after. "R:" means
|
||||||
after. "R:" means that the Return Stack is modified.
|
that the Return Stack is modified.
|
||||||
|
|
||||||
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 (
|
that newly created word into a "does cell", that is, a regular cell ( when
|
||||||
when called, puts the cell's addr on PS), but right after that, it
|
called, puts the cell's addr on PS), but right after that, it executes words
|
||||||
executes words that appear after the DOES>.
|
that appear after the DOES>.
|
||||||
|
|
||||||
"does cells" always allocate 4 bytes (2 for the cell, 2 for the DOES>
|
"does cells" always allocate 4 bytes (2 for the cell, 2 for the DOES> link) and
|
||||||
link) and there is no need for ALLOT in colon definition.
|
there is no need for ALLOT in colon definition.
|
||||||
|
|
||||||
At compile time, colon definition stops processing words when reaching
|
At compile time, colon definition stops processing words when reaching the
|
||||||
the DOES>.
|
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 ***
|
*** 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
|
||||||
/ a b -- c a / b -> c
|
/ a b -- c a / b -> c
|
||||||
CREATE x -- Create cell named x. Doesn't allocate a PF.
|
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
|
DOES> -- See description at top of file
|
||||||
DUP a -- a a
|
DUP a -- a a
|
||||||
ELSE -- Branch to THEN
|
ELSE -- Branch to THEN
|
||||||
EMIT c -- Spit char c to stdout
|
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
|
HERE -- a Push HERE's address
|
||||||
IF n -- Branch to ELSE or THEN if n is zero
|
IF n -- Branch to ELSE or THEN if n is zero
|
||||||
QUIT R:drop -- Return to interpreter promp immediately
|
QUIT R:drop -- Return to interpreter promp immediately
|
||||||
|
@ -6,7 +6,7 @@
|
|||||||
; Max length of dict entry names
|
; Max length of dict entry names
|
||||||
.equ NAMELEN 8
|
.equ NAMELEN 8
|
||||||
; Offset of the code link relative to the beginning of the word
|
; Offset of the code link relative to the beginning of the word
|
||||||
.equ CODELINK_OFFSET 10
|
.equ CODELINK_OFFSET NAMELEN+2
|
||||||
|
|
||||||
; *** Variables ***
|
; *** Variables ***
|
||||||
.equ INITIAL_SP FORTH_RAMSTART
|
.equ INITIAL_SP FORTH_RAMSTART
|
||||||
@ -39,7 +39,7 @@ forthRdLine:
|
|||||||
ld (INPUTPOS), hl
|
ld (INPUTPOS), hl
|
||||||
forthInterpret:
|
forthInterpret:
|
||||||
ld ix, RS_ADDR-2 ; -2 because we inc-before-push
|
ld ix, RS_ADDR-2 ; -2 because we inc-before-push
|
||||||
ld iy, INTERPRET+CODELINK_OFFSET
|
ld iy, INTERPRET
|
||||||
jp executeCodeLink
|
jp executeCodeLink
|
||||||
msgOk:
|
msgOk:
|
||||||
.db " ok", 0
|
.db " ok", 0
|
||||||
|
@ -80,7 +80,7 @@ RSIsLIT:
|
|||||||
; Z if yes, NZ if no.
|
; Z if yes, NZ if no.
|
||||||
RSIsEXIT:
|
RSIsEXIT:
|
||||||
push de
|
push de
|
||||||
ld de, EXIT+CODELINK_OFFSET
|
ld de, EXIT
|
||||||
call RSIsDE
|
call RSIsDE
|
||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
@ -163,14 +163,10 @@ readCompWord:
|
|||||||
.msg:
|
.msg:
|
||||||
.db "word expected", 0
|
.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.
|
; Z is set if DE point to 0 (no entry). NZ if not.
|
||||||
prev:
|
prev:
|
||||||
push hl ; --> lvl 1
|
dec de \ dec de ; prev field
|
||||||
ld hl, NAMELEN ; prev field offset
|
|
||||||
add hl, de
|
|
||||||
ex de, hl
|
|
||||||
pop hl ; <-- lvl 1
|
|
||||||
call intoDE
|
call intoDE
|
||||||
; DE points to prev. Is it zero?
|
; DE points to prev. Is it zero?
|
||||||
xor a
|
xor a
|
||||||
@ -183,15 +179,28 @@ prev:
|
|||||||
; point to that entry.
|
; point to that entry.
|
||||||
; Z if found, NZ if not.
|
; Z if found, NZ if not.
|
||||||
find:
|
find:
|
||||||
|
push hl
|
||||||
|
push bc
|
||||||
ld de, (CURRENT)
|
ld de, (CURRENT)
|
||||||
|
ld bc, CODELINK_OFFSET
|
||||||
.inner:
|
.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
|
ld a, NAMELEN
|
||||||
call strncmp
|
call strncmp
|
||||||
ret z ; found
|
pop de ; <-- lvl 1, return to wordref
|
||||||
|
jr z, .end ; found
|
||||||
call prev
|
call prev
|
||||||
jr nz, .inner
|
jr nz, .inner
|
||||||
; Z set? end of dict unset Z
|
; Z set? end of dict unset Z
|
||||||
inc a
|
inc a
|
||||||
|
.end:
|
||||||
|
pop bc
|
||||||
|
pop hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Write compiled data from HL into IY, advancing IY at the same time.
|
; Write compiled data from HL into IY, advancing IY at the same time.
|
||||||
@ -207,10 +216,7 @@ wrCompHL:
|
|||||||
compile:
|
compile:
|
||||||
call find
|
call find
|
||||||
jr nz, .maybeNum
|
jr nz, .maybeNum
|
||||||
; DE is a word offset, we need a code link
|
ex de, hl
|
||||||
ld hl, CODELINK_OFFSET
|
|
||||||
add hl, de
|
|
||||||
xor a ; set Z
|
|
||||||
jr wrCompHL
|
jr wrCompHL
|
||||||
.maybeNum:
|
.maybeNum:
|
||||||
push hl ; --> lvl 1. save string addr
|
push hl ; --> lvl 1. save string addr
|
||||||
@ -250,13 +256,13 @@ entryhead:
|
|||||||
call strcpy
|
call strcpy
|
||||||
ex de, hl ; (HERE) now in HL
|
ex de, hl ; (HERE) now in HL
|
||||||
ld de, (CURRENT)
|
ld de, (CURRENT)
|
||||||
ld (CURRENT), hl
|
|
||||||
ld a, NAMELEN
|
ld a, NAMELEN
|
||||||
call addHL
|
call addHL
|
||||||
ld (hl), e
|
ld (hl), e
|
||||||
inc hl
|
inc hl
|
||||||
ld (hl), d
|
ld (hl), d
|
||||||
inc hl
|
inc hl
|
||||||
|
ld (CURRENT), hl
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
xor a ; set Z
|
xor a ; set Z
|
||||||
ret
|
ret
|
||||||
|
Loading…
Reference in New Issue
Block a user