# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468098181 0
# Node ID 92c590f78133b5b89863d9f728236f6a50cac4ee
# Parent  8c853f632f8c8dd9f75dc75a4bd71d8aa72b3eeb
Pool logic frames to avoid creating so many hash tables

diff -r 8c853f632f8c -r 92c590f78133 src/wam/dump.lisp
--- a/src/wam/dump.lisp	Fri Jul 08 18:14:05 2016 +0000
+++ b/src/wam/dump.lisp	Sat Jul 09 21:03:01 2016 +0000
@@ -308,8 +308,8 @@
      (to (min (+ (wam-program-counter wam) 8) ; is
               (length (wam-code wam))))) ; bad
   (format t "CODE (size: ~D frame(s) / ~:[OPEN~;CLOSED~])~%"
-          (length (wam-code-stack wam))
-          (wam-code-closed-p wam))
+          (length (wam-logic-stack wam))
+          (wam-logic-closed-p wam))
   (dump-code-store wam (wam-code wam) from to))
 
 
diff -r 8c853f632f8c -r 92c590f78133 src/wam/wam.lisp
--- a/src/wam/wam.lisp	Fri Jul 08 18:14:05 2016 +0000
+++ b/src/wam/wam.lisp	Sat Jul 09 21:03:01 2016 +0000
@@ -7,6 +7,7 @@
           wam-code
           wam-code-labels
           wam-logic-stack
+          wam-logic-pool
           wam-functors
           wam-fail
           wam-backtracked
@@ -65,6 +66,9 @@
   (logic-stack
     nil
     :type list)
+  (logic-pool
+    nil
+    :type list)
   (functors
     (make-array 64
       :fill-pointer 0
@@ -615,6 +619,20 @@
   (predicates (make-hash-table) :type hash-table))
 
 
+(defun* wam-logic-pool-release ((wam wam) (frame logic-frame))
+  (:returns :void)
+  (with-slots (start final predicates) frame
+    (clrhash predicates)
+    (setf start 0 final nil))
+  (push frame (wam-logic-pool wam))
+  (values))
+
+(defun* wam-logic-pool-request ((wam wam))
+  (:returns logic-frame)
+  (or (pop (wam-logic-pool wam))
+      (make-logic-frame)))
+
+
 (defun* wam-current-logic-frame ((wam wam))
   (:returns (or null logic-frame))
   (first (wam-logic-stack wam)))
@@ -638,11 +656,10 @@
   (:returns :void)
   (assert (wam-logic-closed-p wam) ()
     "Cannot push logic frame unless the logic stack is closed.")
-  (push (make-logic-frame
-          :start (fill-pointer (wam-code wam))
-          :final nil
-          :predicates (make-hash-table))
-        (wam-logic-stack wam))
+  (let ((frame (wam-logic-pool-request wam)))
+    (setf (logic-frame-start frame)
+          (fill-pointer (wam-code wam)))
+    (push frame (wam-logic-stack wam)))
   (values))
 
 (defun* wam-pop-logic-frame! ((wam wam))
@@ -652,11 +669,12 @@
       "Cannot pop logic frame from an empty logic stack.")
     (assert (logic-frame-final (first logic-stack)) ()
       "Cannot pop unfinalized logic frame.")
-    (with-slots (start predicates)
-        (pop logic-stack)
-      (setf (fill-pointer (wam-code wam)) start)
-      (loop :for label :being :the hash-keys :of predicates
-            :do (remhash label (wam-code-labels wam)))))
+    (let ((frame (pop logic-stack)))
+      (setf (fill-pointer (wam-code wam))
+            (logic-frame-start frame))
+      (loop :for label :being :the hash-keys :of (logic-frame-predicates frame)
+            :do (remhash label (wam-code-labels wam)))
+      (wam-logic-pool-release wam frame)))
   (values))