forth: Check for PS underflow

apps/forth/dict.asm

@@ -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

apps/forth/main.asm

@@ -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

apps/forth/stack.asm

@@ -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

apps/forth/util.asm

@@ -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)