[armedbear-cvs] r12065 - trunk/abcl/src/org/armedbear/lisp

Erik Huelsmann ehuelsmann at common-lisp.net
Sun Jul 26 22:37:30 UTC 2009


Author: ehuelsmann
Date: Sun Jul 26 18:37:27 2009
New Revision: 12065

Log:
Implement a stack frame pool to save execution time
on stack management.

Modified:
   trunk/abcl/src/org/armedbear/lisp/LispThread.java

Modified: trunk/abcl/src/org/armedbear/lisp/LispThread.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispThread.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/LispThread.java	Sun Jul 26 18:37:27 2009
@@ -449,63 +449,62 @@
 
     private static class StackFrame
     {
-        public final LispObject operator;
-        private final LispObject first;
-        private final LispObject second;
-        private final LispObject third;
-        private final LispObject[] args;
+        public LispObject operator;
+        private LispObject first;
+        private LispObject second;
+        private LispObject third;
+        private LispObject[] args;
         final StackFrame next;
 
-        public StackFrame(LispObject operator, StackFrame next)
+        public StackFrame(StackFrame next) {
+            this.next = next;
+        }
+
+        public final void set(LispObject operator)
         {
             this.operator = operator;
             first = null;
             second = null;
             third = null;
             args = null;
-            this.next = next;
         }
 
-        public StackFrame(LispObject operator, LispObject arg, StackFrame next)
+        public final void set(LispObject operator, LispObject arg)
         {
             this.operator = operator;
             first = arg;
             second = null;
             third = null;
             args = null;
-            this.next = next;
         }
 
-        public StackFrame(LispObject operator, LispObject first,
-                          LispObject second, StackFrame next)
+        public final void set(LispObject operator, LispObject first,
+                              LispObject second)
         {
             this.operator = operator;
             this.first = first;
             this.second = second;
             third = null;
             args = null;
-            this.next = next;
         }
 
-        public StackFrame(LispObject operator, LispObject first,
-                          LispObject second, LispObject third, StackFrame next)
+        public final void set(LispObject operator, LispObject first,
+                              LispObject second, LispObject third)
         {
             this.operator = operator;
             this.first = first;
             this.second = second;
             this.third = third;
             args = null;
-            this.next = next;
         }
 
-        public StackFrame(LispObject operator, LispObject[] args, StackFrame next)
+        public final void set(LispObject operator, LispObject[] args)
         {
             this.operator = operator;
             first = null;
             second = null;
             third = null;
             this.args = args;
-            this.next = next;
         }
 
         public LispObject toList() throws ConditionThrowable
@@ -541,6 +540,9 @@
     }
 
     private StackFrame stack = null;
+    private final int framePoolSize = 256;
+    private final StackFrame[] framePool = new StackFrame[256];
+    private int framePointer = -1;
 
     @Deprecated
     public LispObject getStack()
@@ -562,17 +564,26 @@
         }
     }
 
+    private final StackFrame newStackFrame() {
+        if (++framePointer < framePoolSize) {
+            if (framePool[framePointer] == null)
+                framePool[framePointer] = new StackFrame(stack);
+            return (stack = framePool[framePointer]);
+        } else
+            return (stack = new StackFrame(stack));
+    }
+
     public final void pushStackFrame(LispObject operator)
         throws ConditionThrowable
     {
-        stack = new StackFrame(operator, stack);
+        newStackFrame().set(operator);
         doProfiling();
     }
 
     public final void pushStackFrame(LispObject operator, LispObject arg)
         throws ConditionThrowable
     {
-        stack = new StackFrame(operator, arg, stack);
+        newStackFrame().set(operator, arg);
         doProfiling();
     }
 
@@ -580,7 +591,7 @@
                                LispObject second)
         throws ConditionThrowable
     {
-        stack = new StackFrame(operator, first, second, stack);
+        newStackFrame().set(operator, first, second);
         doProfiling();
     }
 
@@ -588,26 +599,36 @@
                                LispObject second, LispObject third)
         throws ConditionThrowable
     {
-        stack = new StackFrame(operator, first, second, third, stack);
+        newStackFrame().set(operator, first, second, third);
         doProfiling();
     }
 
     public final void pushStackFrame(LispObject operator, LispObject... args)
         throws ConditionThrowable
     {
-        stack = new StackFrame(operator, args, stack);
+        newStackFrame().set(operator, args);
         doProfiling();
     }
 
     public final void popStackFrame()
     {
-        if (stack != null)
+        if (stack != null) {
+            if (framePointer < framePoolSize)
+                stack.set(null);
             stack = stack.next;
+            framePointer--;
+        }
     }
 
     public void resetStack()
     {
         stack = null;
+        // Clear out old frames, in order to prevent leaking references
+        // to old objects
+        for (StackFrame frame : framePool)
+            if (frame != null)
+                frame.set(null);
+        framePointer = -1;
     }
 
     @Override




More information about the armedbear-cvs mailing list