mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-26 08:28:04 +11:00
Compare commits
4 Commits
5cadde557c
...
03bd9ee39b
Author | SHA1 | Date | |
---|---|---|---|
|
03bd9ee39b | ||
|
0e8af3cea4 | ||
|
e8a4768304 | ||
|
03e529b762 |
@ -1,5 +1,6 @@
|
|||||||
; A dictionary entry has this structure:
|
; A dictionary entry has this structure:
|
||||||
; - 8b name (zero-padded)
|
; - 7b name (zero-padded)
|
||||||
|
; - 1b flags (bit 0: IMMEDIATE)
|
||||||
; - 2b prev pointer
|
; - 2b prev pointer
|
||||||
; - 2b code pointer
|
; - 2b code pointer
|
||||||
; - Parameter field (PF)
|
; - Parameter field (PF)
|
||||||
@ -13,11 +14,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
|
||||||
@ -53,6 +51,69 @@ doesWord:
|
|||||||
push hl \ pop iy
|
push hl \ pop iy
|
||||||
jr compiledWord
|
jr compiledWord
|
||||||
|
|
||||||
|
; The IF word checks the stack for zero. If it's non-zero, it does nothing and
|
||||||
|
; allow compiledWord to continue.
|
||||||
|
; If it's zero, it tracksback RS, advance it until it finds a ELSE, a THEN, or
|
||||||
|
; an EXIT (not supposed to happen unless the IF is misconstructed). Whether
|
||||||
|
; it's a ELSE or THEN, the same thing happens: we resume execution after the
|
||||||
|
; ELSE/THEN. If it's a EXIT, we simply execute it.
|
||||||
|
ifWord:
|
||||||
|
pop hl
|
||||||
|
ld a, h
|
||||||
|
or l
|
||||||
|
jp nz, exit ; non-zero, continue
|
||||||
|
; Zero, seek ELSE, THEN or EXIT. Continue to elseWord
|
||||||
|
|
||||||
|
; If a ELSE word is executed, it means that the preceding IF had a non-zero
|
||||||
|
; condition and continued execution. This means that upon encountering an ELSE,
|
||||||
|
; we must search for a THEN or an EXIT.
|
||||||
|
; To simplify implementation and share code with ifWord, we also match ELSE,
|
||||||
|
; which is only possible in malformed construct. Therefore "IF ELSE ELSE" is
|
||||||
|
; valid and interpreted as "IF ELSE THEN".
|
||||||
|
elseWord:
|
||||||
|
; to save processing, we test EXIT, ELSE and THEN in the order they
|
||||||
|
; appear, address-wise. This way, we don't need to push/pop HL: we can
|
||||||
|
; SUB the difference between the words and check for zeroes.
|
||||||
|
call popRS
|
||||||
|
; We need to save that IP somewhere. Let it be BC
|
||||||
|
ld b, h
|
||||||
|
ld c, l
|
||||||
|
.loop:
|
||||||
|
; Whether there's a match or not, we will resume the operation at IP+2,
|
||||||
|
; which means that we have to increase BC anyways. Let's do it now.
|
||||||
|
inc bc \ inc bc
|
||||||
|
call intoHL
|
||||||
|
or a ; clear carry
|
||||||
|
ld de, EXIT
|
||||||
|
sbc hl, de
|
||||||
|
jp z, exit
|
||||||
|
; Not EXIT, let's continue with ELSE. No carry possible because EXIT
|
||||||
|
; is first word. No need to clear.
|
||||||
|
ld de, ELSE-EXIT
|
||||||
|
sbc hl, de
|
||||||
|
jr c, .nomatch ; A word between EXIT and ELSE. No match.
|
||||||
|
jr z, .match ; We have a ELSE
|
||||||
|
; Let's try with THEN. Again, no carry possible, C cond was handled.
|
||||||
|
ld de, THEN-ELSE
|
||||||
|
sbc hl, de
|
||||||
|
jr z, .match ; We have a THEN
|
||||||
|
.nomatch:
|
||||||
|
; Nothing matched, which means that we need to continue looking.
|
||||||
|
; BC is already IP+2
|
||||||
|
ld h, b
|
||||||
|
ld l, c
|
||||||
|
jr .loop
|
||||||
|
.match:
|
||||||
|
; Matched a ELSE or a THEN, which means we need to continue executing
|
||||||
|
; word from IP+2, which is already in BC.
|
||||||
|
push bc \ pop iy
|
||||||
|
jp compiledWord
|
||||||
|
|
||||||
|
; This word does nothing. It's never going to be executed unless the wordlist
|
||||||
|
; is misconstructed.
|
||||||
|
thenWord:
|
||||||
|
jp exit
|
||||||
|
|
||||||
; 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
|
||||||
@ -71,11 +132,28 @@ numberWord:
|
|||||||
NUMBER:
|
NUMBER:
|
||||||
.dw numberWord
|
.dw numberWord
|
||||||
|
|
||||||
|
; Similarly to numberWord, this is not a real word, but a string literal.
|
||||||
|
; Instead of being followed by a 2 bytes number, it's followed by a
|
||||||
|
; null-terminated string. This is not expected to be called in a regular
|
||||||
|
; context. Only words expecting those literals will look for them. This is why
|
||||||
|
; the litWord triggers abort.
|
||||||
|
litWord:
|
||||||
|
call popRS
|
||||||
|
call intoHL
|
||||||
|
call printstr ; let's print the word before abort.
|
||||||
|
ld hl, .msg
|
||||||
|
call printstr
|
||||||
|
jp abort
|
||||||
|
.msg:
|
||||||
|
.db "undefined word", 0
|
||||||
|
LIT:
|
||||||
|
.dw litWord
|
||||||
|
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
EXIT:
|
.db ";"
|
||||||
.db "EXIT", 0, 0, 0, 0
|
.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,
|
||||||
@ -88,44 +166,45 @@ exit:
|
|||||||
call popRS
|
call popRS
|
||||||
; We have a pointer to a word
|
; We have a pointer to a word
|
||||||
push hl \ pop iy
|
push hl \ pop iy
|
||||||
jr compiledWord
|
jp compiledWord
|
||||||
|
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
QUIT:
|
.db "QUIT"
|
||||||
.db "QUIT", 0, 0, 0, 0
|
.fill 4
|
||||||
.dw EXIT
|
.dw EXIT
|
||||||
|
QUIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
quit:
|
quit:
|
||||||
ld hl, FLAGS
|
jp forthRdLine
|
||||||
set FLAG_QUITTING, (hl)
|
|
||||||
jr exit
|
|
||||||
|
|
||||||
ABORT:
|
.db "ABORT"
|
||||||
.db "ABORT", 0, 0, 0
|
.fill 3
|
||||||
.dw QUIT
|
.dw QUIT
|
||||||
|
ABORT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
abort:
|
abort:
|
||||||
|
; Reinitialize PS (RS is reinitialized in forthInterpret
|
||||||
ld sp, (INITIAL_SP)
|
ld sp, (INITIAL_SP)
|
||||||
ld hl, .msg
|
jp forthRdLine
|
||||||
call printstr
|
|
||||||
call printcrlf
|
|
||||||
jr quit
|
|
||||||
.msg:
|
|
||||||
.db " err", 0
|
|
||||||
|
|
||||||
BYE:
|
|
||||||
.db "BYE"
|
.db "BYE"
|
||||||
.fill 5
|
.fill 5
|
||||||
.dw ABORT
|
.dw ABORT
|
||||||
|
BYE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
ld hl, FLAGS
|
; Goodbye Forth! Before we go, let's restore the stack
|
||||||
set FLAG_ENDPGM, (hl)
|
ld sp, (INITIAL_SP)
|
||||||
jp exit
|
; unwind stack underflow buffer
|
||||||
|
pop af \ pop af \ pop af
|
||||||
|
; success
|
||||||
|
xor a
|
||||||
|
ret
|
||||||
|
|
||||||
; ( c -- )
|
; ( c -- )
|
||||||
EMIT:
|
.db "EMIT"
|
||||||
.db "EMIT", 0, 0, 0, 0
|
.fill 4
|
||||||
.dw BYE
|
.dw BYE
|
||||||
|
EMIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
ld a, l
|
ld a, l
|
||||||
@ -133,13 +212,12 @@ EMIT:
|
|||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( addr -- )
|
; ( addr -- )
|
||||||
EXECUTE:
|
.db "EXECUTE"
|
||||||
.db "EXECUTE", 0
|
.db 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)
|
||||||
@ -149,46 +227,54 @@ 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
|
||||||
jp nz, quit
|
|
||||||
ld de, compiledWord
|
ld de, compiledWord
|
||||||
ld (hl), e
|
ld (hl), e
|
||||||
inc hl
|
inc hl
|
||||||
ld (hl), d
|
ld (hl), d
|
||||||
inc hl
|
inc hl
|
||||||
push hl \ pop iy
|
; At this point, we've processed the name literal following the ':'.
|
||||||
|
; What's next? We have, in IP, a pointer to words that *have already
|
||||||
|
; been compiled by INTERPRET*. All those bytes will be copied as-is.
|
||||||
|
; All we need to do is to know how many bytes to copy. To do so, we
|
||||||
|
; skip compwords until EXIT is reached.
|
||||||
|
ld (HERE), hl ; where we write compwords.
|
||||||
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
.loop:
|
.loop:
|
||||||
call readword
|
call HLPointsEXIT
|
||||||
jr nz, .end
|
jr z, .loopend
|
||||||
call .issemicol
|
call compSkip
|
||||||
jr z, .end
|
|
||||||
call compile
|
|
||||||
jp nz, quit
|
|
||||||
jr .loop
|
jr .loop
|
||||||
.end:
|
.loopend:
|
||||||
; end chain with EXIT
|
; At this point, HL points to EXIT compword. We'll copy it too.
|
||||||
ld hl, EXIT+CODELINK_OFFSET
|
; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2
|
||||||
call wrCompHL
|
ld e, (ix)
|
||||||
ld (HERE), iy
|
ld d, (ix+1)
|
||||||
|
inc hl \ inc hl ; our +2
|
||||||
|
or a ; clear carry
|
||||||
|
sbc hl, de
|
||||||
|
ld b, h
|
||||||
|
ld c, l
|
||||||
|
; BC has proper count
|
||||||
|
ex de, hl ; HL is our source (old RS' TOS)
|
||||||
|
ld de, (HERE) ; and DE is our dest
|
||||||
|
ldir ; go!
|
||||||
|
; HL has our new RS' TOS
|
||||||
|
ld (ix), l
|
||||||
|
ld (ix+1), h
|
||||||
|
ld (HERE), de ; update HERE
|
||||||
jp exit
|
jp exit
|
||||||
.issemicol:
|
|
||||||
ld a, (hl)
|
|
||||||
cp ';'
|
|
||||||
ret nz
|
|
||||||
inc hl
|
|
||||||
ld a, (hl)
|
|
||||||
dec hl
|
|
||||||
or a
|
|
||||||
ret
|
|
||||||
|
|
||||||
DOES:
|
.db "DOES>"
|
||||||
.db "DOES>", 0, 0, 0
|
.fill 3
|
||||||
.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.
|
||||||
@ -199,8 +285,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
|
||||||
@ -210,10 +294,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
|
||||||
@ -221,31 +305,28 @@ KEY:
|
|||||||
push hl
|
push hl
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
INTERPRET:
|
.db "INTERPR"
|
||||||
.db "INTERPRE"
|
.db 0
|
||||||
.dw KEY
|
.dw KEY
|
||||||
|
INTERPRET:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
interpret:
|
interpret:
|
||||||
call readword
|
|
||||||
jp nz, quit
|
|
||||||
ld iy, COMPBUF
|
ld iy, COMPBUF
|
||||||
|
.loop:
|
||||||
|
call readword
|
||||||
|
jr nz, .end
|
||||||
call compile
|
call compile
|
||||||
jp nz, .notfound
|
jr .loop
|
||||||
ld hl, EXIT+CODELINK_OFFSET
|
.end:
|
||||||
ld (iy), l
|
ld hl, QUIT
|
||||||
ld (iy+1), h
|
call wrCompHL
|
||||||
ld iy, COMPBUF
|
ld iy, COMPBUF
|
||||||
jp compiledWord
|
jp compiledWord
|
||||||
.notfound:
|
|
||||||
ld hl, .msg
|
|
||||||
call printstr
|
|
||||||
jp quit
|
|
||||||
.msg:
|
|
||||||
.db "not found", 0
|
|
||||||
|
|
||||||
CREATE:
|
.db "CREATE"
|
||||||
.db "CREATE", 0, 0
|
.fill 2
|
||||||
.dw INTERPRET
|
.dw INTERPRET
|
||||||
|
CREATE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call entryhead
|
call entryhead
|
||||||
jp nz, quit
|
jp nz, quit
|
||||||
@ -257,24 +338,25 @@ 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"
|
||||||
.db "CURRENT", 0
|
.db 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
|
||||||
@ -286,10 +368,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
|
||||||
@ -298,10 +380,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
|
||||||
@ -309,10 +391,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
|
||||||
@ -320,10 +402,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
|
||||||
@ -331,10 +413,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
|
||||||
@ -344,10 +426,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
|
||||||
@ -356,10 +438,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
|
||||||
@ -369,10 +451,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
|
||||||
@ -381,10 +463,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
|
||||||
@ -392,66 +474,86 @@ DIV:
|
|||||||
push bc
|
push bc
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
|
.db "IF"
|
||||||
|
.fill 6
|
||||||
|
.dw DIV
|
||||||
|
IF:
|
||||||
|
.dw ifWord
|
||||||
|
|
||||||
|
.db "ELSE"
|
||||||
|
.fill 4
|
||||||
|
.dw IF
|
||||||
|
ELSE:
|
||||||
|
.dw elseWord
|
||||||
|
|
||||||
|
.db "THEN"
|
||||||
|
.fill 4
|
||||||
|
.dw ELSE
|
||||||
|
THEN:
|
||||||
|
.dw thenWord
|
||||||
|
|
||||||
; End of native words
|
; End of native words
|
||||||
|
|
||||||
; ( a -- )
|
; ( a -- )
|
||||||
; @ .
|
; @ .
|
||||||
FETCHDOT:
|
|
||||||
.db "?"
|
.db "?"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw DIV
|
.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"
|
||||||
.db "ALLOT", 0, 0, 0
|
.fill 3
|
||||||
.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 "VARIABL"
|
||||||
.db "VARIABLE"
|
.db 0
|
||||||
.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 "CONSTAN"
|
||||||
.db "CONSTANT"
|
.db 0
|
||||||
.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,23 +1,34 @@
|
|||||||
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 ***
|
||||||
|
|
||||||
: x ... ; -- Define a new word
|
: x ... -- Define a new word
|
||||||
|
; R:I -- Exit a colon definition
|
||||||
. n -- Print n in its decimal form
|
. n -- Print n in its decimal form
|
||||||
@ a -- n Set n to value at address a
|
@ a -- n Set n to value at address a
|
||||||
! n a -- Store n in address a
|
! n a -- Store n in address a
|
||||||
@ -26,18 +37,22 @@ 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
|
||||||
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
|
||||||
EXIT R:I -- Exit a colon definition
|
|
||||||
HERE -- a Push HERE's address
|
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
|
QUIT R:drop -- Return to interpreter promp immediately
|
||||||
KEY -- c Get char c from stdin
|
KEY -- c Get char c from stdin
|
||||||
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.
|
||||||
OVER a b -- a b a
|
OVER a b -- a b a
|
||||||
SWAP a b -- b a
|
SWAP a b -- b a
|
||||||
|
THEN -- Does nothing. Serves as a branching merker for IF
|
||||||
|
and ELSE.
|
||||||
|
|
||||||
*** Core-but-Forth Words ***
|
*** Core-but-Forth Words ***
|
||||||
|
|
||||||
|
@ -4,50 +4,20 @@
|
|||||||
; Number of bytes we keep as a padding between HERE and the scratchpad
|
; Number of bytes we keep as a padding between HERE and the scratchpad
|
||||||
.equ PADDING 0x20
|
.equ PADDING 0x20
|
||||||
; Max length of dict entry names
|
; Max length of dict entry names
|
||||||
.equ NAMELEN 8
|
.equ NAMELEN 7
|
||||||
; 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+3
|
||||||
; When set, the interpreter should abort parsing of current line and return to
|
|
||||||
; prompt.
|
|
||||||
.equ FLAG_QUITTING 0
|
|
||||||
; When set, the interpreter should quit
|
|
||||||
.equ FLAG_ENDPGM 1
|
|
||||||
|
|
||||||
; *** Variables ***
|
; *** Variables ***
|
||||||
.equ INITIAL_SP FORTH_RAMSTART
|
.equ INITIAL_SP FORTH_RAMSTART
|
||||||
.equ CURRENT @+2
|
.equ CURRENT @+2
|
||||||
.equ HERE @+2
|
.equ HERE @+2
|
||||||
.equ INPUTPOS @+2
|
.equ INPUTPOS @+2
|
||||||
.equ FLAGS @+2
|
|
||||||
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
|
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
|
||||||
.equ COMPBUF @+1
|
.equ COMPBUF @+2
|
||||||
.equ FORTH_RAMEND @+0x40
|
.equ FORTH_RAMEND @+0x40
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
MAIN:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw INTERPRET+CODELINK_OFFSET
|
|
||||||
.dw CHKEND
|
|
||||||
|
|
||||||
; If FLAG_ENDPGM is set, stop the program, else, tweak the RS so that we loop.
|
|
||||||
CHKEND:
|
|
||||||
.dw nativeWord
|
|
||||||
ld hl, FLAGS
|
|
||||||
bit FLAG_ENDPGM, (hl)
|
|
||||||
jr nz, .endpgm
|
|
||||||
; not quitting program, are we supposed to continue parsing line?
|
|
||||||
ld hl, FLAGS
|
|
||||||
bit FLAG_QUITTING, (hl)
|
|
||||||
jr nz, forthRdLine
|
|
||||||
; Not quitting line either.
|
|
||||||
jr forthInterpret
|
|
||||||
.endpgm:
|
|
||||||
ld sp, (INITIAL_SP)
|
|
||||||
; restore stack
|
|
||||||
pop af \ pop af \ pop af
|
|
||||||
xor a
|
|
||||||
ret
|
|
||||||
|
|
||||||
forthMain:
|
forthMain:
|
||||||
; STACK OVERFLOW PROTECTION:
|
; STACK OVERFLOW PROTECTION:
|
||||||
; To avoid having to check for stack underflow after each pop operation
|
; To avoid having to check for stack underflow after each pop operation
|
||||||
@ -62,16 +32,14 @@ forthMain:
|
|||||||
ld hl, FORTH_RAMEND
|
ld hl, FORTH_RAMEND
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
forthRdLine:
|
forthRdLine:
|
||||||
xor a
|
|
||||||
ld (FLAGS), a
|
|
||||||
ld hl, msgOk
|
ld hl, msgOk
|
||||||
call printstr
|
call printstr
|
||||||
call printcrlf
|
call printcrlf
|
||||||
call stdioReadLine
|
call stdioReadLine
|
||||||
ld (INPUTPOS), hl
|
ld (INPUTPOS), hl
|
||||||
forthInterpret:
|
forthInterpret:
|
||||||
ld ix, RS_ADDR
|
ld ix, RS_ADDR-2 ; -2 because we inc-before-push
|
||||||
ld iy, MAIN
|
ld iy, INTERPRET
|
||||||
jp executeCodeLink
|
jp executeCodeLink
|
||||||
msgOk:
|
msgOk:
|
||||||
.db " ok", 0
|
.db " ok", 0
|
||||||
|
@ -3,25 +3,26 @@
|
|||||||
; PS is the most frequently used. However, this causes a problem with routine
|
; PS is the most frequently used. However, this causes a problem with routine
|
||||||
; calls: because in Forth, the stack isn't balanced within each call, our return
|
; calls: because in Forth, the stack isn't balanced within each call, our return
|
||||||
; offset, when placed by a CALL, messes everything up. This is one of the
|
; offset, when placed by a CALL, messes everything up. This is one of the
|
||||||
; reasons why we need stack management routines below.
|
; reasons why we need stack management routines below. IX always points to RS'
|
||||||
|
; Top Of Stack (TOS)
|
||||||
;
|
;
|
||||||
; This return stack contain "Interpreter pointers", that is a pointer to the
|
; This return stack contain "Interpreter pointers", that is a pointer to the
|
||||||
; address of a word, as seen in a compiled list of words.
|
; address of a word, as seen in a compiled list of words.
|
||||||
|
|
||||||
; Push value HL to RS
|
; Push value HL to RS
|
||||||
pushRS:
|
pushRS:
|
||||||
|
inc ix
|
||||||
|
inc ix
|
||||||
ld (ix), l
|
ld (ix), l
|
||||||
inc ix
|
ld (ix+1), h
|
||||||
ld (ix), h
|
|
||||||
inc ix
|
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Pop RS' TOS to HL
|
; Pop RS' TOS to HL
|
||||||
popRS:
|
popRS:
|
||||||
dec ix
|
|
||||||
ld h, (ix)
|
|
||||||
dec ix
|
|
||||||
ld l, (ix)
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
|
dec ix
|
||||||
|
dec ix
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Verifies that SP is within bounds. If it's not, call ABORT
|
; Verifies that SP is within bounds. If it's not, call ABORT
|
||||||
|
@ -43,14 +43,136 @@ readword:
|
|||||||
inc a ; unset Z
|
inc a ; unset Z
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; For DE pointing to a dict entry, set DE to point to the previous entry.
|
; 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
|
||||||
|
|
||||||
|
|
||||||
|
HLPointsNUMBER:
|
||||||
|
push de
|
||||||
|
ld de, NUMBER
|
||||||
|
call HLPointsDE
|
||||||
|
pop de
|
||||||
|
ret
|
||||||
|
|
||||||
|
HLPointsLIT:
|
||||||
|
push de
|
||||||
|
ld de, LIT
|
||||||
|
call HLPointsDE
|
||||||
|
pop de
|
||||||
|
ret
|
||||||
|
|
||||||
|
HLPointsEXIT:
|
||||||
|
push de
|
||||||
|
ld de, EXIT
|
||||||
|
call HLPointsDE
|
||||||
|
pop de
|
||||||
|
ret
|
||||||
|
|
||||||
|
; 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.
|
||||||
|
compSkip:
|
||||||
|
call HLPointsNUMBER
|
||||||
|
jr z, .isNum
|
||||||
|
call HLPointsLIT
|
||||||
|
jr nz, .isWord
|
||||||
|
; We have a literal
|
||||||
|
inc hl \ inc hl
|
||||||
|
call strskip
|
||||||
|
inc hl ; byte after word termination
|
||||||
|
ret
|
||||||
|
.isNum:
|
||||||
|
; skip by 4
|
||||||
|
inc hl \ inc hl
|
||||||
|
; continue to isWord
|
||||||
|
.isWord:
|
||||||
|
; skip by 2
|
||||||
|
inc hl \ inc hl
|
||||||
|
ret
|
||||||
|
|
||||||
|
; The goal of this routine is to read a string literal following the currently
|
||||||
|
; executed words. For example, CREATE and DEFINE need this. Things are a little
|
||||||
|
; twisted, so bear with me while I explain how it works.
|
||||||
|
;
|
||||||
|
; When we call this routine, everything has been compiled. We're on an atom and
|
||||||
|
; we're executing it. Now, we're looking for a string literal or a word-with-a
|
||||||
|
; name that follows our readCompWord caller. We could think that this word is
|
||||||
|
; right there on RS' TOS, but no! You have to account for words wrapping the
|
||||||
|
; caller. For example, "VARIABLE" calls "CREATE". If you call "VARIABLE foo",
|
||||||
|
; if CREATE looks at what follows in RS' TOS, it will only find the "2" in
|
||||||
|
; "CREATE 2 ALLOT".
|
||||||
|
;
|
||||||
|
; Therefore, we actually need to check in RS' *bottom of stack* for our answer.
|
||||||
|
; If that atom is a LIT, we're good. We make HL point to it and advance IP to
|
||||||
|
; byte following null-termination.
|
||||||
|
;
|
||||||
|
; If it isn't, things get interesting: If it's a word reference, then it's
|
||||||
|
; not an invalid literal. For example, one could want to redefine an existing
|
||||||
|
; word. So in that case, we'll copy the word's name on the pad (it might not be
|
||||||
|
; null-terminated) and set HL to point to it.
|
||||||
|
; How do we know that our reference is a word reference (it could be, for
|
||||||
|
; example, a NUMBER reference)? We check that its address is more than QUIT, the
|
||||||
|
; second word in our dict. We don't accept EXIT because it's the termination
|
||||||
|
; word. Yeah, it means that ";" can't be overridden...
|
||||||
|
; If name can't be read, we abort
|
||||||
|
readCompWord:
|
||||||
|
; In all cases, we want RS' BOS in HL. Let's get it now.
|
||||||
|
ld hl, (RS_ADDR)
|
||||||
|
call HLPointsLIT
|
||||||
|
jr nz, .notLIT
|
||||||
|
; RS BOS is a LIT, make HL point to string, then skip this RS compword.
|
||||||
|
inc hl \ inc hl ; HL now points to string itself
|
||||||
|
push hl ; --> lvl 1, our result
|
||||||
|
call strskip
|
||||||
|
inc hl ; byte after word termination
|
||||||
|
ld (RS_ADDR), hl
|
||||||
|
pop hl ; <-- lvl 1, our result
|
||||||
|
ret
|
||||||
|
.notLIT:
|
||||||
|
; Alright, not a literal, but is it a word? If it's not a number, then
|
||||||
|
; it's a word.
|
||||||
|
call HLPointsNUMBER
|
||||||
|
jr z, .notWord
|
||||||
|
; Not a number, then it's a word. Copy word to pad and point to it.
|
||||||
|
call intoHL
|
||||||
|
or a ; clear carry
|
||||||
|
ld de, CODELINK_OFFSET
|
||||||
|
sbc hl, de
|
||||||
|
; That's our return value
|
||||||
|
push hl ; --> lvl 1
|
||||||
|
; HL now points to word offset, let'd copy it to pad
|
||||||
|
ex de, hl
|
||||||
|
call pad
|
||||||
|
ex de, hl
|
||||||
|
ld bc, NAMELEN
|
||||||
|
ldir
|
||||||
|
; null-terminate
|
||||||
|
xor a
|
||||||
|
ld (de), a
|
||||||
|
; Advance RS' BOS by 2
|
||||||
|
ld hl, RS_ADDR
|
||||||
|
inc (hl) \ inc (hl)
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
|
ret
|
||||||
|
.notWord:
|
||||||
|
ld hl, .msg
|
||||||
|
call printstr
|
||||||
|
jp abort
|
||||||
|
.msg:
|
||||||
|
.db "word expected", 0
|
||||||
|
|
||||||
|
; 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
|
||||||
@ -63,15 +185,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.
|
||||||
@ -84,49 +219,58 @@ wrCompHL:
|
|||||||
|
|
||||||
; Compile word string at (HL) and write down its compiled version in IY,
|
; Compile word string at (HL) and write down its compiled version in IY,
|
||||||
; advancing IY to the byte next to the last written byte.
|
; advancing IY to the byte next to the last written byte.
|
||||||
; Set Z on success, unset on failure.
|
|
||||||
compile:
|
compile:
|
||||||
call find
|
call find
|
||||||
jr nz, .maybeNum
|
jr nz, .maybeNum
|
||||||
ret nz
|
ex de, hl
|
||||||
; DE is a word offset, we need a code link
|
|
||||||
ld hl, CODELINK_OFFSET
|
|
||||||
add hl, de
|
|
||||||
xor a ; set Z
|
|
||||||
jr wrCompHL
|
jr wrCompHL
|
||||||
.maybeNum:
|
.maybeNum:
|
||||||
|
push hl ; --> lvl 1. save string addr
|
||||||
call parseLiteral
|
call parseLiteral
|
||||||
ret nz
|
jr nz, .undef
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
; a valid number!
|
; a valid number!
|
||||||
ld hl, NUMBER
|
ld hl, NUMBER
|
||||||
call wrCompHL
|
call wrCompHL
|
||||||
ex de, hl ; number in HL
|
ex de, hl ; number in HL
|
||||||
jr wrCompHL
|
jr wrCompHL
|
||||||
ret z
|
.undef:
|
||||||
; unknown name
|
; When encountering an undefined word during compilation, we spit a
|
||||||
ld hl, .msg
|
; reference to litWord, followed by the null-terminated word.
|
||||||
call printstr
|
; This way, if a preceding word expect a string literal, it will read it
|
||||||
jp abort
|
; by calling readCompWord, and if it doesn't, the routine will be
|
||||||
.msg:
|
; called, triggering an abort.
|
||||||
.db "unknown name", 0
|
ld hl, LIT
|
||||||
|
call wrCompHL
|
||||||
|
pop hl ; <-- lvl 1. recall string addr
|
||||||
|
.writeLit:
|
||||||
|
ld a, (hl)
|
||||||
|
ld (iy), a
|
||||||
|
inc hl
|
||||||
|
inc iy
|
||||||
|
or a
|
||||||
|
jr nz, .writeLit
|
||||||
|
ret
|
||||||
|
|
||||||
|
|
||||||
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
|
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
|
||||||
; HL points to new (HERE)
|
; HL points to new (HERE)
|
||||||
; Set Z if name could be read, NZ if not
|
|
||||||
entryhead:
|
entryhead:
|
||||||
call readword
|
call readCompWord
|
||||||
ret nz
|
|
||||||
ld de, (HERE)
|
ld de, (HERE)
|
||||||
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
|
||||||
|
xor a ; IMMED
|
||||||
|
ld (hl), a
|
||||||
|
inc hl
|
||||||
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