[armedbear-cvs] r12275 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Tue Nov 10 19:45:39 UTC 2009
Author: ehuelsmann
Date: Tue Nov 10 14:45:37 2009
New Revision: 12275
Log:
Switch special bindings access schema to mirror that of SBCL/CCL/XCL:
use an array of current bindings with a linked list to store the
bindings to be restored upon unwinding.
Note: This change means a ~40% performance increase in Maxima;
given your application, YMMV, but since this schema trades
efficiency of establishing and unwinding over access, you
theoretically could see slow downs.
Modified:
trunk/abcl/src/org/armedbear/lisp/LispThread.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/SpecialBinding.java
trunk/abcl/src/org/armedbear/lisp/SpecialBindingsMark.java
trunk/abcl/src/org/armedbear/lisp/Symbol.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 Tue Nov 10 14:45:37 2009
@@ -35,6 +35,7 @@
import java.util.Iterator;
import java.util.concurrent.ConcurrentHashMap;
+import java.util.concurrent.atomic.AtomicInteger;
public final class LispThread extends LispObject
{
@@ -66,7 +67,6 @@
private final Thread javaThread;
private boolean destroyed;
private final LispObject name;
- public SpecialBinding lastSpecialBinding;
public LispObject[] _values;
private boolean threadInterrupted;
private LispObject pending = NIL;
@@ -306,18 +306,57 @@
return obj;
}
+
+
+ final static int UNASSIGNED_SPECIAL_INDEX = 0;
+
+ /** Indicates the last special slot which has been assigned.
+ * Symbols which don't have a special slot assigned use a slot
+ * index of 0 for efficiency reasons: it eliminates the need to
+ * check for index validity before accessing the specials array.
+ *
+ */
+ final static AtomicInteger lastSpecial
+ = new AtomicInteger(UNASSIGNED_SPECIAL_INDEX);
+
+ /** This array stores the current special binding for every symbol
+ * which has been globally or locally declared special.
+ *
+ * If the array element has a null value, this means there currently
+ * is no active binding. If the array element contains a valid
+ * SpecialBinding object, but the value field of it is null, that
+ * indicates an "UNBOUND VARIABLE" situation.
+ */
+ final SpecialBinding[] specials = new SpecialBinding[4097];
+
+ /** This array stores the symbols associated with the special
+ * bindings slots.
+ */
+ final static Symbol[] specialNames = new Symbol[4097];
+
+ /** This variable points to the head of a linked list of saved
+ * special bindings. Its main purpose is to allow a mark/reset
+ * interface to special binding and unbinding.
+ */
+ private SpecialBindingsMark savedSpecials = null;
+
/** Marks the state of the special bindings,
* for later rewinding by resetSpecialBindings().
*/
public final SpecialBindingsMark markSpecialBindings() {
- return new SpecialBindingsMark(lastSpecialBinding);
+ return savedSpecials;
}
/** Restores the state of the special bindings to what
* was captured in the marker 'mark' by a call to markSpecialBindings().
*/
public final void resetSpecialBindings(SpecialBindingsMark mark) {
- lastSpecialBinding = mark.binding;
+ SpecialBindingsMark c = savedSpecials;
+ while (mark != c) {
+ specials[c.idx] = c.binding;
+ c = c.next;
+ }
+ savedSpecials = c;
}
/** Clears out all active special bindings including any marks
@@ -326,28 +365,46 @@
*/
// Package level access: only for Interpreter.run()
final void clearSpecialBindings() {
- lastSpecialBinding = null;
+ resetSpecialBindings(null);
+ }
+
+ /** Assigns a specials array index number to the symbol,
+ * if it doesn't already have one.
+ */
+ private static final void assignSpecialIndex(Symbol sym)
+ {
+ if (sym.specialIndex != 0)
+ return;
+
+ synchronized (sym) {
+ // Don't use an atomic access: we'll be swapping values only once.
+ if (sym.specialIndex == 0) {
+ sym.specialIndex = lastSpecial.incrementAndGet();
+ specialNames[sym.specialIndex] = sym;
+ }
+ }
}
public final SpecialBinding bindSpecial(Symbol name, LispObject value)
{
- return lastSpecialBinding
- = new SpecialBinding(name, value, lastSpecialBinding);
+ int idx;
+
+ assignSpecialIndex(name);
+ SpecialBinding binding = specials[idx = name.specialIndex];
+ savedSpecials = new SpecialBindingsMark(idx, binding, savedSpecials);
+ return specials[idx] = new SpecialBinding(idx, value);
}
public final SpecialBinding bindSpecialToCurrentValue(Symbol name)
{
- SpecialBinding binding = lastSpecialBinding;
- while (binding != null) {
- if (binding.name == name) {
- return lastSpecialBinding =
- new SpecialBinding(name, binding.value, lastSpecialBinding);
- }
- binding = binding.next;
- }
- // Not found.
- return lastSpecialBinding =
- new SpecialBinding(name, name.getSymbolValue(), lastSpecialBinding);
+ int idx;
+
+ assignSpecialIndex(name);
+ SpecialBinding binding = specials[idx = name.specialIndex];
+ savedSpecials = new SpecialBindingsMark(idx, binding, savedSpecials);
+ return specials[idx]
+ = new SpecialBinding(idx,
+ (binding == null) ? null : binding.value);
}
/** Looks up the value of a special binding in the context of the
@@ -361,38 +418,23 @@
*
* @see Symbol#symbolValue
*/
- public final LispObject lookupSpecial(LispObject name)
+ public final LispObject lookupSpecial(Symbol name)
{
- SpecialBinding binding = lastSpecialBinding;
- while (binding != null) {
- if (binding.name == name)
- return binding.value;
- binding = binding.next;
- }
- return null;
+ SpecialBinding binding = specials[name.specialIndex];
+ return (binding == null) ? null : binding.value;
}
- public final SpecialBinding getSpecialBinding(LispObject name)
+ public final SpecialBinding getSpecialBinding(Symbol name)
{
- SpecialBinding binding = lastSpecialBinding;
- while (binding != null) {
- if (binding.name == name)
- return binding;
- binding = binding.next;
- }
- return null;
+ return specials[name.specialIndex];
}
public final LispObject setSpecialVariable(Symbol name, LispObject value)
{
- SpecialBinding binding = lastSpecialBinding;
- while (binding != null) {
- if (binding.name == name) {
- binding.value = value;
- return value;
- }
- binding = binding.next;
- }
+ SpecialBinding binding = specials[name.specialIndex];
+ if (binding != null)
+ return binding.value = value;
+
name.setSymbolValue(value);
return value;
}
@@ -400,15 +442,10 @@
public final LispObject pushSpecial(Symbol name, LispObject thing)
{
- SpecialBinding binding = lastSpecialBinding;
- while (binding != null) {
- if (binding.name == name) {
- LispObject newValue = new Cons(thing, binding.value);
- binding.value = newValue;
- return newValue;
- }
- binding = binding.next;
- }
+ SpecialBinding binding = specials[name.specialIndex];
+ if (binding != null)
+ return binding.value = new Cons(thing, binding.value);
+
LispObject value = name.getSymbolValue();
if (value != null) {
LispObject newValue = new Cons(thing, value);
@@ -421,12 +458,10 @@
// Returns symbol value or NIL if unbound.
public final LispObject safeSymbolValue(Symbol name)
{
- SpecialBinding binding = lastSpecialBinding;
- while (binding != null) {
- if (binding.name == name)
- return binding.value;
- binding = binding.next;
- }
+ SpecialBinding binding = specials[name.specialIndex];
+ if (binding != null)
+ return binding.value;
+
LispObject value = name.getSymbolValue();
return value != null ? value : NIL;
}
@@ -479,7 +514,7 @@
{
}
- public final void pushStackFrame(StackFrame frame)
+ public final void pushStackFrame(StackFrame frame)
{
frame.setNext(stack);
stack = frame;
Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java Tue Nov 10 14:45:37 2009
@@ -427,7 +427,7 @@
// ### *fasl-version*
// internal symbol
private static final Symbol _FASL_VERSION_ =
- exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(33));
+ exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(34));
// ### *fasl-anonymous-package*
// internal symbol
Modified: trunk/abcl/src/org/armedbear/lisp/SpecialBinding.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SpecialBinding.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/SpecialBinding.java Tue Nov 10 14:45:37 2009
@@ -33,18 +33,20 @@
package org.armedbear.lisp;
-// Package accessibility.
final public class SpecialBinding
{
- final LispObject name;
+ /** The index in the specials array of the symbol
+ * to which this value belongs.
+ */
+ final int idx;
+
+ /** The value bound */
public LispObject value;
- final SpecialBinding next;
- SpecialBinding(LispObject name, LispObject value, SpecialBinding next)
+ SpecialBinding(int idx, LispObject value)
{
- this.name = name;
+ this.idx = idx;
this.value = value;
- this.next = next;
}
/** Return the value of the binding,
@@ -56,8 +58,19 @@
final public LispObject getValue()
{
if (value == null)
- return Lisp.error(new UnboundVariable(name));
+ // return or not: error doesn't return anyway
+ Lisp.error(new UnboundVariable(LispThread.specialNames[idx]));
return value;
}
+
+ /** Sets the value of the binding.
+ *
+ * Note: this method can only be called when the
+ * binding is the one which is currently visible.
+ */
+ final public void setValue(LispObject value)
+ {
+ this.value = value;
+ }
}
Modified: trunk/abcl/src/org/armedbear/lisp/SpecialBindingsMark.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SpecialBindingsMark.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/SpecialBindingsMark.java Tue Nov 10 14:45:37 2009
@@ -39,13 +39,20 @@
*/
final public class SpecialBindingsMark {
+ /** The index in the specials array of the saved binding. */
+ int idx;
+
/** Special binding state to be restored */
// package level access
SpecialBinding binding;
+ SpecialBindingsMark next;
/** Constructor to be called by LispThread.markSpecialBindings() only */
// package level access
- SpecialBindingsMark(SpecialBinding binding) {
+ SpecialBindingsMark(int idx, SpecialBinding binding,
+ SpecialBindingsMark next) {
+ this.idx = idx;
this.binding = binding;
+ this.next = next;
}
}
\ No newline at end of file
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Tue Nov 10 14:45:37 2009
@@ -49,6 +49,11 @@
public final SimpleString name;
private int hash = -1;
+
+ /** To be accessed by LispThread only:
+ * used to find the index in the LispThread.specials array
+ */
+ int specialIndex = LispThread.UNASSIGNED_SPECIAL_INDEX;
private LispObject pkg; // Either a package object or NIL.
private LispObject value;
private LispObject function;
More information about the armedbear-cvs
mailing list