# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1462831249 0
# Node ID b02a1a9684c2ce68a16428aa032f1ade3d535276
# Parent  4050f38d971597c22b93177a155a44244f0550a1
Privilege heap address 0 as a magic unset sentinal value

diff -r 4050f38d9715 -r b02a1a9684c2 src/wam/vm.lisp
--- a/src/wam/vm.lisp	Mon May 09 21:41:38 2016 +0000
+++ b/src/wam/vm.lisp	Mon May 09 22:00:49 2016 +0000
@@ -467,9 +467,9 @@
           ;; pointing this out.
           ;;
           ;; ... well, almost.  The errata is also wrong here.  If we're popping
-          ;; the FIRST choice point, then just using the "previous choice
-          ;; point"'s HB is going to give us garbage, so we should check for that
-          ;; edge case too.  Please kill me.
+          ;; the FIRST choice point, then just using the HB from the "previous
+          ;; choice point" is going to give us garbage, so we should check for
+          ;; that edge case too.  Please kill me.
           (wam-heap-backtrack-pointer wam)
           (if (wam-backtrack-pointer-unset-p wam old-b)
             +heap-start+
diff -r 4050f38d9715 -r b02a1a9684c2 src/wam/wam.lisp
--- a/src/wam/wam.lisp	Mon May 09 21:41:38 2016 +0000
+++ b/src/wam/wam.lisp	Mon May 09 22:00:49 2016 +0000
@@ -39,7 +39,7 @@
     (make-array (+ +register-count+ ; TODO: make all these configurable per-WAM
                    +stack-limit+
                    4096)
-      :fill-pointer +stack-end+
+      :fill-pointer (1+ +stack-end+)
       :adjustable t
       :initial-element (make-cell-null)
       :element-type 'cell)
@@ -85,7 +85,7 @@
 
   ;; Unique registers
   (number-of-arguments    0             :type arity)                ; NARGS
-  (subterm                nil           :type (or null heap-index)) ; S
+  (subterm                +heap-start+  :type heap-index)           ; S
   (program-counter        0             :type code-index)           ; P
   (stack-pointer          +stack-start+ :type stack-index)          ; SP
   (continuation-pointer   0             :type code-index)           ; CP
@@ -100,8 +100,18 @@
 
 
 ;;;; Heap
-;;; TODO: Should we privilege heap address 0 to mean "unset" so we have a good
-;;; sentinal value for HB, S, etc?
+;;; The WAM heap is all the memory left in the store after the local registers
+;;; and stack have been accounted for.  Because the store is adjustable and the
+;;; heap lives at the end of it, the heap can grow if necessary.
+;;;
+;;; We reserve the first address in the heap as a sentinal, as an "unset" value
+;;; for various pointers into the heap.
+
+(defun* wam-heap-pointer-unset-p ((wam wam) (address heap-index))
+  (:returns boolean)
+  (declare (ignore wam))
+  (= address +heap-start+))
+
 
 (defun* wam-heap-push! ((wam wam) (cell cell))
   (:returns (values cell heap-index))
@@ -127,9 +137,13 @@
 (defun* wam-heap-cell ((wam wam) (address heap-index))
   (:returns cell)
   "Return the heap cell at the given address."
+  (assert (not (wam-heap-pointer-unset-p wam address)) ()
+    "Cannot read from heap address zero.")
   (aref (wam-store wam) address))
 
 (defun (setf wam-heap-cell) (new-value wam address)
+  (assert (not (wam-heap-pointer-unset-p wam address)) ()
+    "Cannot write to heap address zero.")
   (setf (aref (wam-store wam) address) new-value))
 
 
@@ -409,7 +423,7 @@
         (b (wam-backtrack-pointer wam)))
     (cond
       ((and (wam-backtrack-pointer-unset-p wam b)
-            (wam-environment-pointer-unset-p wam e)) ; first allocation 
+            (wam-environment-pointer-unset-p wam e)) ; first allocation
        (1+ +stack-start+))
       ((> e b) ; the last thing on the stack is a frame
        (+ e (wam-stack-frame-size wam e)))
@@ -419,7 +433,8 @@
 
 ;;;; Resetting
 (defun* wam-truncate-heap! ((wam wam))
-  (setf (fill-pointer (wam-store wam)) +heap-start+))
+  (setf (fill-pointer (wam-store wam))
+        (1+ +heap-start+)))
 
 (defun* wam-truncate-trail! ((wam wam))
   (setf (fill-pointer (wam-trail wam)) 0))
@@ -429,8 +444,7 @@
 
 (defun* wam-reset-local-registers! ((wam wam))
   (loop :for i :from 0 :below +register-count+ :do
-        (setf (wam-local-register wam i) (make-cell-null)))
-  (setf (wam-subterm wam) nil))
+        (setf (wam-local-register wam i) (make-cell-null))))
 
 (defun* wam-reset! ((wam wam))
   (wam-truncate-heap! wam)
@@ -444,7 +458,7 @@
         (wam-heap-backtrack-pointer wam) +heap-start+
         (wam-backtracked wam) nil
         (wam-fail wam) nil
-        (wam-subterm wam) nil
+        (wam-subterm wam) +heap-start+
         (wam-mode wam) nil))
 
 
@@ -567,7 +581,7 @@
 
   "
   (let ((s (wam-subterm wam)))
-    (if (null s)
+    (if (wam-heap-pointer-unset-p wam s)
       (error "Cannot dereference unbound S register.")
       (wam-heap-cell wam s))))