[armedbear-cvs] r12272 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Sun Nov 8 22:37:22 UTC 2009
Author: ehuelsmann
Date: Sun Nov 8 17:37:19 2009
New Revision: 12272
Log:
Implement functional (declared final) interface to special bindings state unwinding
in preparation of an experiment to make our special binding access work like SBCL/CCL
with an array of "currently valid" special values.
Note: FASL version increase is not required: the old way still works.
Added:
trunk/abcl/src/org/armedbear/lisp/SpecialBindingsMark.java
Modified:
trunk/abcl/src/org/armedbear/lisp/AbstractArray.java
trunk/abcl/src/org/armedbear/lisp/AbstractVector.java
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/Closure.java
trunk/abcl/src/org/armedbear/lisp/Cons.java
trunk/abcl/src/org/armedbear/lisp/Do.java
trunk/abcl/src/org/armedbear/lisp/Function.java
trunk/abcl/src/org/armedbear/lisp/Interpreter.java
trunk/abcl/src/org/armedbear/lisp/Lisp.java
trunk/abcl/src/org/armedbear/lisp/LispThread.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/Primitives.java
trunk/abcl/src/org/armedbear/lisp/PrintNotReadable.java
trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
trunk/abcl/src/org/armedbear/lisp/Stream.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/TypeError.java
trunk/abcl/src/org/armedbear/lisp/UnboundSlot.java
trunk/abcl/src/org/armedbear/lisp/UnboundVariable.java
trunk/abcl/src/org/armedbear/lisp/arglist.java
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
trunk/abcl/src/org/armedbear/lisp/dolist.java
trunk/abcl/src/org/armedbear/lisp/dotimes.java
Modified: trunk/abcl/src/org/armedbear/lisp/AbstractArray.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/AbstractArray.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/AbstractArray.java Sun Nov 8 17:37:19 2009
@@ -258,7 +258,7 @@
_CURRENT_PRINT_LEVEL_.symbolValue(thread);
int currentLevel = Fixnum.getValue(currentPrintLevel);
if (currentLevel < maxLevel) {
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_CURRENT_PRINT_LEVEL_, currentPrintLevel.incr());
try {
sb.append('(');
@@ -281,7 +281,7 @@
sb.append(')');
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
} else
sb.append('#');
Modified: trunk/abcl/src/org/armedbear/lisp/AbstractVector.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/AbstractVector.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/AbstractVector.java Sun Nov 8 17:37:19 2009
@@ -244,7 +244,7 @@
maxLength = ((Fixnum)printLength).value;
final int length = length();
final int limit = Math.min(length, maxLength);
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_CURRENT_PRINT_LEVEL_, currentPrintLevel.incr());
try
{
@@ -257,7 +257,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
if (limit < length)
sb.append(limit > 0 ? " ..." : "...");
Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java Sun Nov 8 17:37:19 2009
@@ -97,7 +97,7 @@
{
if (className != null) {
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
int loadDepth = Fixnum.getValue(_LOAD_DEPTH_.symbolValue());
thread.bindSpecial(_LOAD_DEPTH_, Fixnum.getInstance(++loadDepth));
try {
@@ -128,7 +128,7 @@
e.printStackTrace();
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
} else
Load.loadSystemFile(getFileName(), true);
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Sun Nov 8 17:37:19 2009
@@ -387,7 +387,7 @@
{
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
Environment ext = new Environment(environment);
bindRequiredParameters(ext, thread, objects);
if (arity != minArgs)
@@ -405,7 +405,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
@@ -581,7 +581,7 @@
public LispObject execute(LispObject[] args)
{
final LispThread thread = LispThread.currentThread();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
Environment ext = new Environment(environment);
if (optionalParameters.length == 0 && keywordParameters.length == 0)
args = fastProcessArgs(args);
@@ -605,7 +605,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
@@ -630,7 +630,7 @@
// The bindings established here (if any) are lost when this function
// returns. They are used only in the evaluation of initforms for
// optional and keyword arguments.
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
Environment ext = new Environment(environment);
// Section 3.4.4: "...the &environment parameter is bound along with
// &whole before any other variables in the lambda list..."
@@ -864,7 +864,7 @@
}
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
return array;
}
Modified: trunk/abcl/src/org/armedbear/lisp/Cons.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Cons.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Cons.java Sun Nov 8 17:37:19 2009
@@ -654,7 +654,7 @@
int currentLevel = Fixnum.getValue(currentPrintLevel);
if (currentLevel < maxLevel)
{
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_CURRENT_PRINT_LEVEL_, currentPrintLevel.incr());
try
{
@@ -694,7 +694,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
else
Modified: trunk/abcl/src/org/armedbear/lisp/Do.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Do.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Do.java Sun Nov 8 17:37:19 2009
@@ -93,7 +93,7 @@
varlist = varlist.cdr();
}
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
// Process declarations.
final LispObject bodyAndDecls = parseBody(body, false);
@@ -197,7 +197,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
ext.inactive = true;
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/Function.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Function.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Function.java Sun Nov 8 17:37:19 2009
@@ -273,13 +273,13 @@
sb.append("()");
} else {
final LispThread thread = LispThread.currentThread();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_LENGTH, Fixnum.THREE);
try {
sb.append(lambdaList.writeToString());
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
sb.append(")");
Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java Sun Nov 8 17:37:19 2009
@@ -325,7 +325,7 @@
while (true) {
try {
thread.resetStack();
- thread.lastSpecialBinding = null;
+ thread.clearSpecialBindings();
out._writeString("* ");
out._finishOutput();
LispObject object =
@@ -475,7 +475,7 @@
final Condition condition = (Condition) first;
if (interpreter == null) {
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
try {
final LispObject truename =
@@ -500,7 +500,7 @@
}
catch (Throwable t) {}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
throw new UnhandledCondition(condition);
@@ -535,13 +535,13 @@
LispObject obj = stream.read(false, EOF, false, thread);
if (obj == EOF)
return error(new EndOfFile(stream));
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.DEBUGGER_HOOK, _DEBUGGER_HOOK_FUNCTION);
try {
return eval(obj, new Environment(), thread);
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Sun Nov 8 17:37:19 2009
@@ -2028,11 +2028,15 @@
if (j < args.length)
{
LispObject obj = args[j++];
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
thread.bindSpecial(Symbol.PRINT_READABLY, NIL);
- sb.append(obj.writeToString());
- thread.lastSpecialBinding = lastSpecialBinding;
+ try {
+ sb.append(obj.writeToString());
+ }
+ finally {
+ thread.resetSpecialBindings(mark);
+ }
}
}
else if (c == 'S' || c == 's')
@@ -2040,13 +2044,13 @@
if (j < args.length)
{
LispObject obj = args[j++];
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
try {
sb.append(obj.writeToString());
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
}
@@ -2055,7 +2059,7 @@
if (j < args.length)
{
LispObject obj = args[j++];
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
thread.bindSpecial(Symbol.PRINT_RADIX, NIL);
thread.bindSpecial(Symbol.PRINT_BASE, Fixnum.constants[10]);
@@ -2063,7 +2067,7 @@
sb.append(obj.writeToString());
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
}
@@ -2072,7 +2076,7 @@
if (j < args.length)
{
LispObject obj = args[j++];
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
thread.bindSpecial(Symbol.PRINT_RADIX, NIL);
thread.bindSpecial(Symbol.PRINT_BASE, Fixnum.constants[16]);
@@ -2080,7 +2084,7 @@
sb.append(obj.writeToString());
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
}
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 Nov 8 17:37:19 2009
@@ -306,6 +306,29 @@
return obj;
}
+ /** Marks the state of the special bindings,
+ * for later rewinding by resetSpecialBindings().
+ */
+ public final SpecialBindingsMark markSpecialBindings() {
+ return new SpecialBindingsMark(lastSpecialBinding);
+ }
+
+ /** 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;
+ }
+
+ /** Clears out all active special bindings including any marks
+ * previously set. Invoking resetSpecialBindings() with marks
+ * set before this call results in undefined behaviour.
+ */
+ // Package level access: only for Interpreter.run()
+ final void clearSpecialBindings() {
+ lastSpecialBinding = null;
+ }
+
public final SpecialBinding bindSpecial(Symbol name, LispObject value)
{
return lastSpecialBinding
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 Sun Nov 8 17:37:19 2009
@@ -282,7 +282,7 @@
{
LispThread thread = LispThread.currentThread();
if (auto) {
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.CURRENT_READTABLE,
STANDARD_READTABLE.symbolValue(thread));
thread.bindSpecial(Symbol._PACKAGE_, PACKAGE_CL_USER);
@@ -293,7 +293,7 @@
auto);
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
} else {
return loadSystemFile(filename,
@@ -386,7 +386,7 @@
}
if (in != null) {
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
try {
return loadFileFromStream(pathname, truename,
@@ -400,7 +400,7 @@
System.err.println(sb.toString());
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
try {
in.close();
}
@@ -481,7 +481,7 @@
{
long start = System.currentTimeMillis();
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
// "LOAD binds *READTABLE* and *PACKAGE* to the values they held before
// loading the file."
thread.bindSpecialToCurrentValue(Symbol.CURRENT_READTABLE);
@@ -527,7 +527,7 @@
return loadStream(in, print, thread, returnLastResult);
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
@@ -549,12 +549,10 @@
LispThread thread, boolean returnLastResult)
{
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_LOAD_STREAM_, in);
SpecialBinding sourcePositionBinding =
- new SpecialBinding(_SOURCE_POSITION_, Fixnum.ZERO,
- thread.lastSpecialBinding);
- thread.lastSpecialBinding = sourcePositionBinding;
+ thread.bindSpecial(_SOURCE_POSITION_, Fixnum.ZERO);
try {
final Environment env = new Environment();
LispObject result = NIL;
@@ -578,7 +576,7 @@
}
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
@@ -587,7 +585,7 @@
{
Stream in = (Stream) _LOAD_STREAM_.symbolValue(thread);
final Environment env = new Environment();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
LispObject result = NIL;
try {
thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, new Package());
@@ -599,7 +597,7 @@
}
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
return result;
//There's no point in using here the returnLastResult flag like in
Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java Sun Nov 8 17:37:19 2009
@@ -1642,7 +1642,7 @@
}
else
{
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol._PACKAGE_, PACKAGE_CL);
try
{
@@ -1651,7 +1651,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
}
@@ -3458,7 +3458,7 @@
{
LispObject defs = checkList(args.car());
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
try
{
@@ -3481,7 +3481,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
};
@@ -3748,7 +3748,7 @@
LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
body = bodyAndDecls.car();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
final Environment ext = new Environment(env);
int i = 0;
LispObject var = vars.car();
@@ -3792,7 +3792,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
return result;
}
Modified: trunk/abcl/src/org/armedbear/lisp/PrintNotReadable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/PrintNotReadable.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/PrintNotReadable.java Sun Nov 8 17:37:19 2009
@@ -89,7 +89,7 @@
}
if (object != UNBOUND_VALUE) {
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_READABLY, NIL);
thread.bindSpecial(Symbol.PRINT_ARRAY, NIL);
try {
@@ -99,7 +99,7 @@
sb.append("Object");
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
} else
sb.append("Object");
Added: trunk/abcl/src/org/armedbear/lisp/SpecialBindingsMark.java
==============================================================================
--- (empty file)
+++ trunk/abcl/src/org/armedbear/lisp/SpecialBindingsMark.java Sun Nov 8 17:37:19 2009
@@ -0,0 +1,51 @@
+/*
+ * SpecialBindingsMark.java
+ *
+ * Copyright (C) 1009 Erik Huelsmann
+ * $Id: LispThread.java 12255 2009-11-06 22:36:32Z ehuelsmann $
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module. An independent module is a module which is not derived from
+ * or based on this library. If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so. If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+
+package org.armedbear.lisp;
+
+/** Class used to mark special bindings state.
+ * Returned by LispThread.markSpecialBindings() and consumed by
+ * LispThread.resetSpecialBindings() to abstract from the implementation.
+ */
+final public class SpecialBindingsMark {
+
+ /** Special binding state to be restored */
+ // package level access
+ SpecialBinding binding;
+
+ /** Constructor to be called by LispThread.markSpecialBindings() only */
+ // package level access
+ SpecialBindingsMark(SpecialBinding binding) {
+ this.binding = binding;
+ }
+}
\ No newline at end of file
Modified: trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java Sun Nov 8 17:37:19 2009
@@ -114,7 +114,7 @@
{
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
try
{
LispObject varList = checkList(args.car());
@@ -166,7 +166,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
@@ -180,7 +180,7 @@
{
LispObject varList = checkList(args.car());
final LispThread thread = LispThread.currentThread();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
Environment ext = new Environment(env);
try
{
@@ -215,7 +215,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
};
@@ -300,7 +300,7 @@
// First argument is a list of local function definitions.
LispObject defs = checkList(args.car());
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
final Environment funEnv = new Environment(env);
while (defs != NIL)
{
@@ -357,7 +357,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
@@ -409,7 +409,7 @@
final LispThread thread = LispThread.currentThread();
final LispObject symbols = checkList(eval(args.car(), env, thread));
LispObject values = checkList(eval(args.cadr(), env, thread));
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
try
{
// Set up the new bindings.
@@ -419,7 +419,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
};
Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Stream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Stream.java Sun Nov 8 17:37:19 2009
@@ -468,7 +468,7 @@
}
else
{
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_SHARP_EQUAL_ALIST_, NIL);
try
{
@@ -476,7 +476,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
}
@@ -543,7 +543,7 @@
}
else
{
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_SHARP_EQUAL_ALIST_, NIL);
try
{
@@ -551,7 +551,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
}
@@ -1841,7 +1841,7 @@
public void prin1(LispObject obj)
{
LispThread thread = LispThread.currentThread();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
try
{
@@ -1849,7 +1849,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
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 Sun Nov 8 17:37:19 2009
@@ -107,7 +107,7 @@
public LispObject getDescription()
{
final LispThread thread = LispThread.currentThread();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
try
{
@@ -128,7 +128,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/TypeError.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/TypeError.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/TypeError.java Sun Nov 8 17:37:19 2009
@@ -130,7 +130,7 @@
// FIXME
try {
final LispThread thread = LispThread.currentThread();
- final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
try {
String s = super.getMessage();
@@ -164,7 +164,7 @@
return toString();
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
catch (Throwable t) {
Modified: trunk/abcl/src/org/armedbear/lisp/UnboundSlot.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/UnboundSlot.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/UnboundSlot.java Sun Nov 8 17:37:19 2009
@@ -70,7 +70,7 @@
public String getMessage()
{
final LispThread thread = LispThread.currentThread();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
try {
FastStringBuffer sb = new FastStringBuffer("The slot ");
@@ -81,7 +81,7 @@
return sb.toString();
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/UnboundVariable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/UnboundVariable.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/UnboundVariable.java Sun Nov 8 17:37:19 2009
@@ -49,7 +49,7 @@
public String getMessage()
{
LispThread thread = LispThread.currentThread();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
StringBuffer sb = new StringBuffer("The variable ");
// FIXME
@@ -59,7 +59,7 @@
}
catch (Throwable t) {}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
sb.append(" is unbound.");
return sb.toString();
Modified: trunk/abcl/src/org/armedbear/lisp/arglist.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/arglist.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/arglist.java Sun Nov 8 17:37:19 2009
@@ -81,13 +81,13 @@
s = "(" + s + ")";
// Bind *PACKAGE* so we use the EXT package if we need
// to intern any symbols.
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol._PACKAGE_, PACKAGE_EXT);
try {
arglist = readObjectFromString(s);
}
finally {
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
}
operator.setLambdaList(arglist);
}
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Sun Nov 8 17:37:19 2009
@@ -239,6 +239,8 @@
(defconstant +lisp-environment-class+ "org/armedbear/lisp/Environment")
(defconstant +lisp-special-binding+ "Lorg/armedbear/lisp/SpecialBinding;")
(defconstant +lisp-special-binding-class+ "org/armedbear/lisp/SpecialBinding")
+(defconstant +lisp-special-bindings-mark+ "Lorg/armedbear/lisp/SpecialBindingsMark;")
+(defconstant +lisp-special-bindings-mark-class+ "org/armedbear/lisp/SpecialBindingsMark")
(defconstant +lisp-throw-class+ "org/armedbear/lisp/Throw")
(defconstant +lisp-return-class+ "org/armedbear/lisp/Return")
(defconstant +lisp-go-class+ "org/armedbear/lisp/Go")
@@ -4046,16 +4048,22 @@
t)
(defun restore-dynamic-environment (register)
- (emit-push-current-thread)
- (aload register)
- (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
- +lisp-special-binding+))
+ (emit-push-current-thread)
+ (aload register)
+;; (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
+;; +lisp-special-binding+)
+ (emit-invokevirtual +lisp-thread-class+ "resetSpecialBindings"
+ (list +lisp-special-bindings-mark+) nil)
+ )
(defun save-dynamic-environment (register)
- (emit-push-current-thread)
- (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
- +lisp-special-binding+)
- (astore register))
+ (emit-push-current-thread)
+;; (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
+;; +lisp-special-binding+)
+ (emit-invokevirtual +lisp-thread-class+ "markSpecialBindings"
+ nil +lisp-special-bindings-mark+)
+ (astore register)
+ )
(defun restore-environment-and-make-handler (register label-START)
(let ((label-END (gensym))
Modified: trunk/abcl/src/org/armedbear/lisp/dolist.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dolist.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/dolist.java Sun Nov 8 17:37:19 2009
@@ -51,7 +51,7 @@
LispObject listForm = args.cadr();
final LispThread thread = LispThread.currentThread();
LispObject resultForm = args.cdr().cdr().car();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
// Process declarations.
LispObject bodyAndDecls = parseBody(bodyForm, false);
LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
@@ -121,7 +121,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
ext.inactive = true;
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/dotimes.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dotimes.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/dotimes.java Sun Nov 8 17:37:19 2009
@@ -50,7 +50,7 @@
LispObject countForm = args.cadr();
final LispThread thread = LispThread.currentThread();
LispObject resultForm = args.cdr().cdr().car();
- SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
LispObject bodyAndDecls = parseBody(bodyForm, false);
LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
@@ -147,7 +147,7 @@
}
finally
{
- thread.lastSpecialBinding = lastSpecialBinding;
+ thread.resetSpecialBindings(mark);
ext.inactive = true;
}
}
More information about the armedbear-cvs
mailing list