764b2222c7
This will allow us to support backward branching with just one new (bbr) word.
Also, this allow us to have "(" word sooned in core.fth and thus allow for
earlier commenting.
339 lines
7.5 KiB
NASM
339 lines
7.5 KiB
NASM
; Return address of scratchpad in HL
|
|
pad:
|
|
ld hl, (HERE)
|
|
ld a, PADDING
|
|
jp addHL
|
|
|
|
; Read word from (INPUTPOS) and return, in HL, a null-terminated word.
|
|
; Advance (INPUTPOS) to the character following the whitespace ending the
|
|
; word.
|
|
; Z set of word was read, unset if end of line.
|
|
readword:
|
|
ld hl, (INPUTPOS)
|
|
; skip leading whitespace
|
|
dec hl ; offset leading "inc hl"
|
|
.loop1:
|
|
inc hl
|
|
ld a, (hl)
|
|
or a
|
|
jr z, .empty
|
|
cp ' '+1
|
|
jr c, .loop1
|
|
push hl ; --> lvl 1. that's our result
|
|
.loop2:
|
|
inc hl
|
|
ld a, (hl)
|
|
; special case: is A null? If yes, we will *not* inc A so that we don't
|
|
; go over the bounds of our input string.
|
|
or a
|
|
jr z, .noinc
|
|
cp ' '+1
|
|
jr nc, .loop2
|
|
; we've just read a whitespace, HL is pointing to it. Let's transform
|
|
; it into a null-termination, inc HL, then set (INPUTPOS).
|
|
xor a
|
|
ld (hl), a
|
|
inc hl
|
|
.noinc:
|
|
ld (INPUTPOS), hl
|
|
pop hl ; <-- lvl 1. our result
|
|
ret ; Z set from XOR A
|
|
.empty:
|
|
ld (hl), a
|
|
inc a ; unset Z
|
|
ret
|
|
|
|
; 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
|
|
|
|
HLPointsBR:
|
|
push de
|
|
ld de, FBR
|
|
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 HLPointsBR
|
|
jr z, .isBranch
|
|
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
|
|
; continue to isBranch
|
|
.isBranch:
|
|
; skip by 3
|
|
inc hl
|
|
; continue to isWord
|
|
.isWord:
|
|
; skip by 2
|
|
inc hl \ inc hl
|
|
ret
|
|
|
|
; ***readLIT***
|
|
; 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 readLIT caller. We could think that this word is
|
|
; right there on RS' TOS, but not always! 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".
|
|
;
|
|
; In this case, 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
|
|
;
|
|
; BOS vs TOS: What we cover so far is the "CREATE" and friends cases, where we
|
|
; want to read BOS. There are, however, cases where we want to read TOS, that is
|
|
; that we want to read the LIT right next to our atom. Example: "(". When
|
|
; processing comments, we are at compile time and want to read words from BOS,
|
|
; yes), however, in "("'s definition, there's "LIT@ )", which means "fetch LIT
|
|
; next to me and push this to stack". This LIT we want to fetch is *not* from
|
|
; BOS, it's from TOS.
|
|
;
|
|
; This is why we have readLITBOS and readLITTOS. readLIT uses HL and DE and is
|
|
; not used directly.
|
|
|
|
; Given a RS stack pointer HL, read LIT next to it (or abort) and set HL to
|
|
; point to its associated string. Set DE to there the RS stack pointer should
|
|
; point next.
|
|
readLIT:
|
|
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
|
|
; HL has our its final value
|
|
ld d, h
|
|
ld e, l
|
|
call strskip
|
|
inc hl ; byte after word termination
|
|
ex de, hl
|
|
ret
|
|
.notLIT:
|
|
; Alright, not a literal, but is it a word?
|
|
call HLPointsUNWORD
|
|
jr z, .notWord
|
|
; 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
|
|
call intoHL
|
|
or a ; clear carry
|
|
ld de, CODELINK_OFFSET
|
|
sbc hl, de
|
|
; That's our return value
|
|
push hl ; --> lvl 2
|
|
; 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
|
|
pop hl ; <-- lvl 2
|
|
pop de ; <-- lvl 1
|
|
; Advance IP by 2
|
|
inc de \ inc de
|
|
ret
|
|
.notWord:
|
|
ld hl, .msg
|
|
call printstr
|
|
jp abort
|
|
.msg:
|
|
.db "word expected", 0
|
|
|
|
readLITBOS:
|
|
; Before we start: is our RS empty? If IX == RS_ADDR, it is (it only has
|
|
; its safety net). When that happens, we actually want to run readLITTOS
|
|
push hl
|
|
push de
|
|
push ix \ pop hl
|
|
ld de, RS_ADDR
|
|
or a ; clear carry
|
|
sbc hl, de
|
|
pop de
|
|
pop hl
|
|
jr z, readLITTOS
|
|
push de
|
|
; Our bottom-of-stack is RS_ADDR+2 because RS_ADDR is occupied by our
|
|
; ABORTREF safety net.
|
|
ld hl, (RS_ADDR+2)
|
|
call readLIT
|
|
ld (RS_ADDR+2), de
|
|
pop de
|
|
ret
|
|
|
|
readLITTOS:
|
|
push de
|
|
ld hl, (IP)
|
|
call readLIT
|
|
ld (IP), de
|
|
pop de
|
|
ret
|
|
|
|
; Find the entry corresponding to word where (HL) points to and sets DE to
|
|
; 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
|
|
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
|
|
|
|
; 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:
|
|
dec de \ dec de \ dec de ; prev field
|
|
call intoDE
|
|
; DE points to prev. Is it zero?
|
|
xor a
|
|
or d
|
|
or e
|
|
; Z will be set if DE is zero
|
|
ret
|
|
|
|
; Write compiled data from HL into IY, advancing IY at the same time.
|
|
wrCompHL:
|
|
ld (iy), l
|
|
inc iy
|
|
ld (iy), h
|
|
inc iy
|
|
ret
|
|
|
|
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
|
|
; HL points to new (HERE)
|
|
entryhead:
|
|
call readLITBOS
|
|
ld de, (HERE)
|
|
call strcpy
|
|
ex de, hl ; (HERE) now in HL
|
|
ld de, (CURRENT)
|
|
ld a, NAMELEN
|
|
call addHL
|
|
call DEinHL
|
|
; Set word flags: not IMMED, not UNWORD, so it's 0
|
|
xor a
|
|
ld (hl), a
|
|
inc hl
|
|
ld (CURRENT), hl
|
|
ld (HERE), hl
|
|
ret
|
|
|
|
; Sets Z if wordref at HL is of the IMMEDIATE type
|
|
HLisIMMED:
|
|
dec hl
|
|
bit FLAG_IMMED, (hl)
|
|
inc hl
|
|
; We need an invert flag. We want to Z to be set when flag is non-zero.
|
|
jp toggleZ
|
|
|
|
; Sets Z if wordref at (HL) is of the IMMEDIATE type
|
|
HLPointsIMMED:
|
|
push hl
|
|
call intoHL
|
|
call HLisIMMED
|
|
pop hl
|
|
ret
|
|
|
|
; Sets Z if wordref at HL is of the UNWORD type
|
|
HLisUNWORD:
|
|
dec hl
|
|
bit FLAG_UNWORD, (hl)
|
|
inc hl
|
|
; We need an invert flag. We want to Z to be set when flag is non-zero.
|
|
jp toggleZ
|
|
|
|
; Sets Z if wordref at (HL) is of the IMMEDIATE type
|
|
HLPointsUNWORD:
|
|
push hl
|
|
call intoHL
|
|
call HLisUNWORD
|
|
pop hl
|
|
ret
|
|
|
|
; Checks flags Z and C and sets BC to 0 if Z, 1 if C and -1 otherwise
|
|
flagsToBC:
|
|
ld bc, 0
|
|
ret z ; equal
|
|
inc bc
|
|
ret c ; >
|
|
; <
|
|
dec bc
|
|
dec bc
|
|
ret
|
|
|
|
; Write DE in (HL), advancing HL by 2.
|
|
DEinHL:
|
|
ld (hl), e
|
|
inc hl
|
|
ld (hl), d
|
|
inc hl
|
|
ret
|