894cac6a43fa

--- a/src/wam/cells.lisp	Tue Mar 29 23:09:51 2016 +0000
+++ b/src/wam/cells.lisp	Wed Mar 30 00:30:33 2016 +0000
@@ -38,7 +38,7 @@
 
 
 (deftype heap-index ()
-  `(integer 0 ,(1- array-total-size-limit)))
+  `(integer 0 ,(1- +heap-limit+)))
 
 (deftype register-index ()
   `(integer 0 ,(1- +register-count+)))

--- a/src/wam/constants.lisp	Tue Mar 29 23:09:51 2016 +0000
+++ b/src/wam/constants.lisp	Wed Mar 30 00:30:33 2016 +0000
@@ -13,6 +13,13 @@
   :documentation "Bitmask for masking the cell type tags.")
 
 
+(define-constant +addressable-values+ (expt 2 +cell-value-width+)
+  :documentation "Number of addressable values, based on cell width.")
+
+(define-constant +heap-limit+ +addressable-values+
+  :documentation "Maximum size of the WAM heap.")
+
+
 (define-constant +tag-null+      #b00
   :documentation "An empty cell.")
 

--- a/src/wam/dump.lisp	Tue Mar 29 23:09:51 2016 +0000
+++ b/src/wam/dump.lisp	Wed Mar 30 00:30:33 2016 +0000
@@ -1,28 +1,38 @@
 (in-package #:bones.wam)
 
+(defun registers-pointing-to (wam addr)
+  (loop :for reg :across (wam-registers wam)
+        :for i :from 0
+        :when (= reg addr)
+        :collect i))
+
 (defun heap-debug (wam addr cell)
-  (switch ((cell-type cell))
-    (+tag-reference+
-      (if (= addr (cell-value cell))
-        "unbound variable"
-        (format nil "var pointer to ~D" (cell-value cell))))
-    (+tag-functor+
-      (format nil "~A/~D"
-              (wam-functor-lookup wam (cell-functor-index cell))
-              (cell-functor-arity cell)))
-    (t "")))
+  (format
+    nil "~A~{(X~A) ~}"
+    (switch ((cell-type cell))
+      (+tag-reference+
+        (if (= addr (cell-value cell))
+          "unbound variable "
+          (format nil "var pointer to ~D " (cell-value cell))))
+      (+tag-functor+
+        (format nil "~A/~D "
+                (wam-functor-lookup wam (cell-functor-index cell))
+                (cell-functor-arity cell)))
+      (t ""))
+    (registers-pointing-to wam addr)))
+
 
 (defun dump-heap (wam from to highlight)
   ;; This code is awful, sorry.
   (let ((heap (wam-heap wam)))
-    (format t "  +------+-----+--------------+----------------------------+~%")
-    (format t "  | ADDR | TYP |        VALUE | DEBUG                      |~%")
-    (format t "  +------+-----+--------------+----------------------------+~%")
+    (format t "  +------+-----+--------------+--------------------------------------+~%")
+    (format t "  | ADDR | TYP |        VALUE | DEBUG                                |~%")
+    (format t "  +------+-----+--------------+--------------------------------------+~%")
     (when (> from 0)
-      (format t "  |    ⋮ |  ⋮  |            ⋮ |                            |~%"))
+      (format t "  |    ⋮ |  ⋮  |            ⋮ |                                      |~%"))
     (flet ((print-cell (i cell)
              (let ((hi (= i highlight)))
-               (format t "~A ~4@A | ~A | ~12@A | ~26A ~A~%"
+               (format t "~A ~4@A | ~A | ~12@A | ~36A ~A~%"
                        (if hi "==>" "  |")
                        i
                        (cell-type-short-name cell)
@@ -32,21 +42,24 @@
       (loop :for i :from from :below to
             :do (print-cell i (aref heap i))))
     (when (< to (length heap))
-      (format t "  |    ⋮ |  ⋮  |            ⋮ |                            |~%"))
-    (format t "  +------+-----+--------------+----------------------------+~%")
+      (format t "  |    ⋮ |  ⋮  |            ⋮ |                                      |~%"))
+    (format t "  +------+-----+--------------+--------------------------------------+~%")
     (values)))
 
 
 (defun dump-wam-registers (wam)
   (format t "REGISTERS:~%")
-  (format t  "~5@A ->~4@A~%" "S" (wam-s wam))
+  (format t  "~5@A ->~6@A~%" "S" (wam-s wam))
   (loop :for i :from 0
         :for reg :across (wam-registers wam)
-        :for contents = (wam-register-cell wam i)
-        :do (format t "~5@A ->~4@A ~A~%"
+        :for contents = (when (not (= reg (1- +heap-limit+)))
+                          (wam-register-cell wam i))
+        :do (format t "~5@A ->~6@A ~A~%"
                     (format nil "X~D" i)
                     reg
-                    (cell-aesthetic contents))))
+                    (if contents
+                      (cell-aesthetic contents)
+                      "unset"))))
 
 (defun dump-wam-functors (wam)
   (format t " FUNCTORS: ~S~%" (wam-functors wam)))
@@ -72,7 +85,6 @@
             addr))
 
 
-
 (defun extract-thing (wam &optional (address (wam-register wam 0)))
   (let ((cell (wam-heap-cell wam (deref wam address))))
     (cond

--- a/src/wam/wam.lisp	Tue Mar 29 23:09:51 2016 +0000
+++ b/src/wam/wam.lisp	Wed Mar 30 00:30:33 2016 +0000
@@ -1,19 +1,14 @@
 (in-package #:bones.wam)
 
 ;;;; WAM
-(defparameter *wam-heap-size* 48)
-
 (defclass wam ()
   ((heap
-     :initform (make-array *wam-heap-size*
+     :initform (make-array 1024
+                           :fill-pointer 0
                            :initial-element (make-cell-null)
                            :element-type 'heap-cell)
      :reader wam-heap
      :documentation "The actual heap (stack).")
-   (heap-pointer
-     :initform 0
-     :accessor wam-heap-pointer
-     :documentation "The index of the first free cell on the heap (stack).")
    (functors
      :initform (make-array 16
                            :fill-pointer 0
@@ -24,9 +19,9 @@
    (registers
      :reader wam-registers
      :initform (make-array +register-count+
-                           ;; Point at the last heap index by default, just to
-                           ;; make it easier to read debug output.
-                           :initial-element (1- *wam-heap-size*)
+                           ;; Initialize to the last element in the heap for
+                           ;; debugging purposes.
+                           :initial-element (1- +heap-limit+)
                            :element-type 'heap-index)
      :documentation "An array of the X_i registers.")
    (fail
@@ -62,7 +57,6 @@
 ;;;
 ;;; TODO: Consider using an adjustable array.  There must still be a max size
 ;;; because you can only index so many addresses with N bits.
-
 (defun* wam-heap-push! ((wam wam) (cell heap-cell))
   (:returns (values heap-cell heap-index))
   "Push the cell onto the WAM heap and increment the heap pointer.
@@ -70,10 +64,15 @@
   Returns the cell and the address it was pushed to.
 
   "
-  (with-slots (heap heap-pointer) wam
-    (setf (aref heap heap-pointer) cell)
-    (incf heap-pointer)
-    (values cell (1- heap-pointer))))
+  (with-slots (heap) wam
+    (if (= +heap-limit+ (fill-pointer heap))
+      (error "WAM heap exhausted.")
+      (values cell (vector-push-extend cell heap)))))
+
+(defun* wam-heap-pointer ((wam wam))
+  (:returns heap-index)
+  "Return the current heap pointer of the WAM."
+  (fill-pointer (wam-heap wam)))
 
 
 (defun* wam-heap-cell ((wam wam) (address heap-index))