forth: Check for PS underflow

This commit is contained in:
Virgil Dupras 2020-03-07 20:20:11 -05:00
parent 580214426a
commit f0cf10ab7c
4 changed files with 55 additions and 4 deletions

View File

@ -71,10 +71,13 @@ EXIT:
; in fact, we want to continue processing the one above it.
call popRS
exit:
; Before we continue: is SP within bounds?
call chkPS
; we're good
call popRS
; We have a pointer to a word
push hl \ pop iy
jp compiledWord
jr compiledWord
; ( R:I -- )
QUIT:
@ -84,12 +87,25 @@ QUIT:
quit:
ld hl, FLAGS
set FLAG_QUITTING, (hl)
jp exit
jr exit
ABORT:
.db "ABORT", 0, 0, 0
.dw QUIT
.dw nativeWord
abort:
ld sp, (INITIAL_SP)
ld hl, .msg
call printstr
call printcrlf
jr quit
.msg:
.db " err", 0
BYE:
.db "BYE"
.fill 5
.dw QUIT
.dw ABORT
.dw nativeWord
ld hl, FLAGS
set FLAG_ENDPGM, (hl)
@ -141,7 +157,7 @@ DEFINE:
call .issemicol
jr z, .end
call compile
jr nz, quit
jp nz, quit
jr .loop
.end:
; end chain with EXIT
@ -221,6 +237,9 @@ DOT:
.dw HERE_
.dw nativeWord
pop de
; We check PS explicitly because it doesn't look nice to spew gibberish
; before aborting the stack underflow.
call chkPS
call pad
call fmtDecimalS
call printstr

View File

@ -43,10 +43,19 @@ CHKEND:
jr forthInterpret
.endpgm:
ld sp, (INITIAL_SP)
; restore stack
pop af \ pop af \ pop af
xor a
ret
forthMain:
; STACK OVERFLOW PROTECTION:
; To avoid having to check for stack underflow after each pop operation
; (which can end up being prohibitive in terms of costs), we give
; ourselves a nice 6 bytes buffer. 6 bytes because we seldom have words
; requiring more than 3 items from the stack. Then, at each "exit" call
; we check for stack underflow.
push af \ push af \ push af
ld (INITIAL_SP), sp
ld hl, DIV ; last entry in hardcoded dict
ld (CURRENT), hl

View File

@ -23,3 +23,19 @@ popRS:
dec ix
ld l, (ix)
ret
; Verifies that SP is within bounds. If it's not, call ABORT
chkPS:
ld hl, (INITIAL_SP)
; We have the return address for this very call on the stack. Let's
; compensate
dec hl \ dec hl
or a ; clear carry
sbc hl, sp
ret nc ; (INITIAL_SP) >= SP? good
; underflow
ld hl, .msg
call printstr
jr abort
.msg:
.db "stack underflow", 0

View File

@ -102,6 +102,13 @@ compile:
call wrCompHL
ex de, hl ; number in HL
jr wrCompHL
ret z
; unknown name
ld hl, .msg
call printstr
jp abort
.msg:
.db "unknown name", 0
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
; HL points to new (HERE)