1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-20 11:58:05 +11:00

forth: a little housekeeping

This commit is contained in:
Virgil Dupras 2020-03-19 17:39:44 -04:00
parent cf95bbcace
commit 5458a1f7ff

View File

@ -210,7 +210,7 @@ printcrlf:
; This routine also takes care of echoing received characters back to the TTY. ; This routine also takes care of echoing received characters back to the TTY.
; It also manages backspaces properly. ; It also manages backspaces properly.
readline: readline:
push bc call printcrlf
ld hl, INPTBUF ld hl, INPTBUF
ld b, INPT_BUFSIZE-1 ld b, INPT_BUFSIZE-1
.loop: .loop:
@ -240,7 +240,7 @@ readline:
xor a xor a
ld (hl), a ld (hl), a
ld hl, INPTBUF ld hl, INPTBUF
pop bc ld (INPUTPOS), hl
ret ret
.delchr: .delchr:
@ -423,22 +423,6 @@ divide:
ld h, a ld h, a
ret ret
; DE * BC -> DE (high) and HL (low)
multDEBC:
ld hl, 0
ld a, 0x10
.loop:
add hl, hl
rl e
rl d
jr nc, .noinc
add hl, bc
jr nc, .noinc
inc de
.noinc:
dec a
jr nz, .loop
ret
; Parse string at (HL) as a decimal value and return value in DE. ; Parse string at (HL) as a decimal value and return value in DE.
; Reads as many digits as it can and stop when: ; Reads as many digits as it can and stop when:
@ -508,7 +492,7 @@ parseDecimal:
; *** Support routines *** ; *** Support routines ***
; Advance (INPUTPOS) until a non-whitespace is met. If needed, ; Advance (INPUTPOS) until a non-whitespace is met. If needed,
; call fetchline. ; call readline.
; Set HL to newly set (INPUTPOS) ; Set HL to newly set (INPUTPOS)
toword: toword:
ld hl, (INPUTPOS) ld hl, (INPUTPOS)
@ -524,13 +508,13 @@ toword:
jr c, .loop jr c, .loop
ret ret
.empty: .empty:
call fetchline call readline
jr toword jr toword
; Read word from (INPUTPOS) and return, in HL, a null-terminated word. ; Read word from (INPUTPOS) and return, in HL, a null-terminated word.
; Advance (INPUTPOS) to the character following the whitespace ending the ; Advance (INPUTPOS) to the character following the whitespace ending the
; word. ; word.
; When we're at EOL, we call fetchline directly, so this call always returns ; When we're at EOL, we call readline directly, so this call always returns
; a word. ; a word.
readword: readword:
call toword call toword
@ -565,40 +549,6 @@ HLPointsDE:
cp d ; Z has our answer cp d ; Z has our answer
ret 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:
ld de, NUMBER
call HLPointsDE
jr z, .isNum
ld de, FBR
call HLPointsDE
jr z, .isBranch
ld de, BBR
call HLPointsDE
jr z, .isBranch
ld de, LIT
call HLPointsDE
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
; Find the entry corresponding to word where (HL) points to and sets DE to ; Find the entry corresponding to word where (HL) points to and sets DE to
; point to that entry. ; point to that entry.
; Z if found, NZ if not. ; Z if found, NZ if not.
@ -685,12 +635,6 @@ DEinHL:
inc hl inc hl
ret ret
fetchline:
call printcrlf
call readline
ld (INPUTPOS), hl
ret
; *** Stack management *** ; *** Stack management ***
; The Parameter stack (PS) is maintained by SP and the Return stack (RS) is ; The Parameter stack (PS) is maintained by SP and the Return stack (RS) is
; maintained by IX. This allows us to generally use push and pop freely because ; maintained by IX. This allows us to generally use push and pop freely because
@ -724,17 +668,6 @@ popRSIP:
ld (IP), hl ld (IP), hl
ret ret
; Skip the next two bytes in RS' TOS
skipRS:
push hl
ld l, (ix)
ld h, (ix+1)
inc hl \ inc hl
ld (ix), l
ld (ix+1), h
pop hl
ret
; Verifies that SP and RS are within bounds. If it's not, call ABORT ; Verifies that SP and RS are within bounds. If it's not, call ABORT
chkRS: chkRS:
push ix \ pop hl push ix \ pop hl
@ -1652,7 +1585,20 @@ MULT:
pop de pop de
pop bc pop bc
call chkPS call chkPS
call multDEBC ; DE * BC -> DE (high) and HL (low)
ld hl, 0
ld a, 0x10
.loop:
add hl, hl
rl e
rl d
jr nc, .noinc
add hl, bc
jr nc, .noinc
inc de
.noinc:
dec a
jr nz, .loop
push hl push hl
jp next jp next
@ -1702,6 +1648,9 @@ CMP:
push bc push bc
jp next jp next
; 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.
.db "SKIP?" .db "SKIP?"
.fill 2 .fill 2
.dw CMP .dw CMP
@ -1714,7 +1663,35 @@ CSKIP:
or l or l
jp z, next ; False, do nothing. jp z, next ; False, do nothing.
ld hl, (IP) ld hl, (IP)
call compSkip ld de, NUMBER
call HLPointsDE
jr z, .isNum
ld de, FBR
call HLPointsDE
jr z, .isBranch
ld de, BBR
call HLPointsDE
jr z, .isBranch
ld de, LIT
call HLPointsDE
jr nz, .isWord
; We have a literal
inc hl \ inc hl
call strskip
inc hl ; byte after word termination
jr .end
.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
.end:
ld (IP), hl ld (IP), hl
jp next jp next