Lots of stack monitoring routines

src/toolsrc/plforth.pla

@@ -26,7 +26,7 @@ const hidden_flag   = $80
 //
 predef _drop_(a)#0, _swap_(a,b)#2, _dup_(a)#2, _over_(a,b,c)#4, _rot_(a,b,c)#3
 predef _add_(a,b)#1, _sub_(a,b)#1, _mul_(a,b)#1, _div_(a,b)#1
-predef _neg_(a)#1, _and_(a,b)#1, _or_(a,b)#1, _not_(a)#1
+predef _neg_(a)#1, _and_(a,b)#1, _or_(a,b)#1, _xor_(a,b)#1, _not_(a)#1
 predef _cset_(a,b)#0, _cget_(a)#1, _wset_(a,b)#0, _wget_(a)#1
 predef _cfa_(a)#1, _lfa_(a)#1
 predef _eq_(a,b)#1, _gt_(a,b)#1, _lt_(a,b)#1
@@ -36,7 +36,8 @@ predef _create_#0, _dodoes_(words)#0, _filldoes_#0, _does_#0, _pset_(a)#0, _colo
 predef _tors_(a)#0, _fromrs_#1, _toprs_#1
 predef _var_(a)#0, _const_(a)#0, _lit_#1, _tick_#1, _forget_#0
 predef _prstr_#0, _src_#0
-predef _vlist_#0, _tron_#0, _troff_#0, _show_#0, _bye_#0, _abort_#0
+predef _vlist_#0, _tron_#0, _troff_#0
+predef _show_#0, _showstack_#0, _bye_#0, _abort_#0
 // DROP
 char d_drop = "DROP"
 byte = 0
@@ -85,10 +86,14 @@ word = @d_neg, @_and_, 0
 char d_or = "OR"
 byte = 0
 word = @d_and, @_or_, 0
+// XOR
+char d_xor = "XOR"
+byte = 0
+word = @d_or, @_xor_, 0
 // NOT
 char d_not = "NOT"
 byte = 0
-word = @d_or, @_not_, 0
+word = @d_xor, @_not_, 0
 // EQUALS
 char d_eq = "="
 byte = 0
@@ -261,10 +266,14 @@ word = @d_prsrc, @_bye_, 0
 char d_show = "SHOW"
 byte = 0
 word = @d_bye, @_show_, 0
+// SHOW STACK
+char d_showstack = "SHOWSTACK"
+byte = 0
+word = @d_show, @_showstack_, 0
 // TRACE ON
 char d_tron = "TRON"
 byte = 0
-word = @d_show, @_tron_, 0
+word = @d_showstack, @_tron_, 0
 // TRACE OFF
 char d_troff = "TROFF"
 byte = 0
@@ -295,14 +304,21 @@ const comp_flag  = $02
 byte state   = 0
 byte trace   = 0
 byte aborted = 0
-byte _get_hwstack  = $EA           // TXA
-byte               = $EA           // TSX
-byte               = $EA, $EA, $EA // STX *+2
-byte               = $EA           // TAX
+byte _get_estack   = $8A           // TXA
+byte               = $49, $FF      // EOR #$FF
+byte               = $38           // SEC
+byte               = $69, $10      // ADC #$10
+byte               = $C9, $11      // CMP #$11
+byte               = $90, $02      // BCC +2
+byte               = $A2, $10      // LDX #ESTKSZ/2
+byte               = $CA           // DEX
+byte               = $95           // STA
+byte _estkl        = $D0           // ESTKL,X
+byte               = $A9, $00      // LDA #$00
+byte               = $95           // STA
+byte _estkh        = $C0           // ESTKH,X
 byte               = $60           // RTS
-byte _reset_stacks = $A2, $FE      // LDX #$FE
-byte               = $9A           // TXS
-byte _reset_estack = $A2, $10      // LDX ESTKSZ/2
+byte _reset_estack = $A2, $10      // LDX #ESTKSZ/2
 byte               = $60           // RTS
 //
 // Helper routines
@@ -471,10 +487,14 @@ def execword(dentry)#0
     trace = not trace
   fin
   if trace
-    puts(": "); puts(dentry); putln
+    _showstack_; puts(": "); puts(dentry); putln
   fin
   W = _cfa_(dentry)
   (*W)()#0
+  if (@_get_estack)()#1 > 16
+    puts("Stack over/underflow\n")
+    _abort_
+  fin
 end
 def execwords(wlist)#0
   word prevIP, dentry
@@ -546,6 +566,9 @@ end
 def _or_(a,b)#1
   return a | b
 end
+def _xor_(a,b)#1
+  return a ^ b
+end
 def _not_(a)#1
   return ~a
 end
@@ -583,10 +606,18 @@ def _pfa_(dentry)#1
  return dentry + ^dentry + 6
 end
 def _tors_(a)#0
+  if RSP == 0
+    puts("Return stack overflow\n")
+    _abort_
+  fin
   RSP--
   RSTACK[RSP] = a
 end
 def _fromrs_#1
+  if RSP == RSTK_SIZE
+    puts("Return stack underflow\n")
+    _abort_
+  fin
   RSP++
   return RSTACK[RSP - 1]
 end
@@ -722,6 +753,7 @@ def _forget_#0
 
   dentry = find(toknext)
   if dentry
+    vlist = *_lfa_(dentry)
     heaprelease(dentry)
   fin
 end
@@ -762,7 +794,6 @@ def _src_#0
     inbuf  = 0
   else
     puts("Failed to open "); puts(filename); putln
-    _abort_
   fin
 end
 def _show_#0
@@ -786,6 +817,15 @@ def _show_#0
     loop
   fin
 end
+def _showstack_#0
+  word val
+  byte depth
+
+  for depth = 1 to (@_get_estack)()#1
+    val = ^(_estkl + 16 - depth) | (^(_estkh + 16 - depth) << 8)
+    puti(val); putc(' ')
+  next
+end
 def _tron_#0
   trace = 1
 end
@@ -861,7 +901,6 @@ end
 // Abort
 //
 def _abort_#0
-  (@_reset_stacks)()#0
   _warmstart_
   puts("Abort\n")
   aborted = 1
@@ -870,6 +909,8 @@ end
 
 puts("PLFORTH WIP\n")
 startheap = heapmark
+_estkl = ^(@syscall + 1) // Hack to fill in parameter stack locations
+_estkh = ^(@syscall + 3)
 _warmstart_
 inptr = argNext(argFirst)
 if ^inptr; inptr++; _src_; fin