df5a19b5f4c7 fixed-size-store

--- a/src/wam/bytecode.lisp	Sun May 15 00:06:53 2016 +0000
+++ b/src/wam/bytecode.lisp	Sun May 15 11:01:55 2016 +0000
@@ -1,6 +1,7 @@
 (in-package #:bones.wam)
 
 ;;;; Opcodes
+(declaim (inline instruction-size))
 (defun* instruction-size ((opcode opcode))
   (:returns (integer 1 3))
   "Return the size of an instruction for the given opcode.

--- a/src/wam/constants.lisp	Sun May 15 00:06:53 2016 +0000
+++ b/src/wam/constants.lisp	Sun May 15 11:01:55 2016 +0000
@@ -58,7 +58,6 @@
 (define-constant +stack-frame-size-limit+ (+ 7 +register-count+)
   :documentation "The maximum size, in stack frame words, that a stack frame could be.")
 
-
 (define-constant +stack-start+ +register-count+
   :documentation "The address in the store of the first cell of the stack.")
 

--- a/src/wam/wam.lisp	Sun May 15 00:06:53 2016 +0000
+++ b/src/wam/wam.lisp	Sun May 15 11:01:55 2016 +0000
@@ -11,6 +11,7 @@
           wam-backtracked
           wam-unification-stack
           wam-trail
+          wam-heap-pointer
           wam-number-of-arguments
           wam-subterm
           wam-program-counter
@@ -36,14 +37,14 @@
     ;;
     ;; `+register-count+` and `+stack-start+` are the same number, and
     ;; `+stack-end+` and `+heap-start+` are the same number as well.
-    (make-array (+ +register-count+ ; TODO: make all these configurable per-WAM
-                   +stack-limit+
-                   4096)
-      :fill-pointer (1+ +stack-end+)
-      :adjustable t
+    (make-array
+        ; (+ +register-count+ ; TODO: make all these configurable per-WAM
+        ;    +stack-limit+
+        ;    )
+      +store-limit+
       :initial-element (make-cell-null)
       :element-type 'cell)
-    :type (vector cell)
+    :type (simple-array cell (8192))
     :read-only t)
   (code
     ;; The WAM bytecode is all stored in this array.  The first
@@ -84,6 +85,7 @@
     :read-only t)
 
   ;; Unique registers
+  (heap-pointer       (1+ +heap-start+) :type heap-index)           ; H
   (number-of-arguments    0             :type arity)                ; NARGS
   (subterm                +heap-start+  :type heap-index)           ; S
   (program-counter        0             :type code-index)           ; P
@@ -125,9 +127,7 @@
 
 (declaim (inline wam-heap-pointer-unset-p
                  wam-heap-cell
-                 (setf wam-heap-cell)
-                 wam-heap-pointer
-                 (setf wam-heap-pointer)))
+                 (setf wam-heap-cell)))
 
 (defun* wam-heap-pointer-unset-p ((wam wam) (address heap-index))
   (:returns boolean)
@@ -142,18 +142,13 @@
   Returns the cell and the address it was pushed to.
 
   "
-  (let ((store (wam-store wam)))
-    (if (= +store-limit+ (fill-pointer store))
-      (error "WAM heap exhausted.")
-      (values cell (vector-push-extend cell store)))))
-
-(defun* wam-heap-pointer ((wam wam))
-  (:returns heap-index)
-  "Return the current heap pointer of the WAM."
-  (fill-pointer (wam-store wam)))
-
-(defun (setf wam-heap-pointer) (new-value wam)
-  (setf (fill-pointer (wam-store wam)) new-value))
+  (let ((store (wam-store wam))
+        (h (wam-heap-pointer wam)))
+    (when (= +store-limit+ h)
+      (error "WAM heap exhausted."))
+    (setf (aref store h) cell)
+    (incf (wam-heap-pointer wam))
+    (values cell h)))
 
 
 (defun* wam-heap-cell ((wam wam) (address heap-index))
@@ -475,10 +470,6 @@
 
 
 ;;;; Resetting
-(defun* wam-truncate-heap! ((wam wam))
-  (setf (fill-pointer (wam-store wam))
-        (1+ +heap-start+)))
-
 (defun* wam-truncate-trail! ((wam wam))
   (setf (fill-pointer (wam-trail wam)) 0))
 
@@ -490,7 +481,6 @@
         (setf (wam-local-register wam i) (make-cell-null))))
 
 (defun* wam-reset! ((wam wam))
-  (wam-truncate-heap! wam)
   (wam-truncate-trail! wam)
   (wam-truncate-unification-stack! wam)
   (policy-cond:policy-if (>= debug 2)
@@ -501,6 +491,7 @@
         (wam-environment-pointer wam) +stack-start+
         (wam-backtrack-pointer wam) +stack-start+
         (wam-heap-backtrack-pointer wam) +heap-start+
+        (wam-heap-pointer wam) (1+ +heap-start+)
         (wam-backtracked wam) nil
         (wam-fail wam) nil
         (wam-subterm wam) +heap-start+