forth: Check for PS underflow
This commit is contained in:
parent
580214426a
commit
f0cf10ab7c
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user