[armedbear-cvs] r13143 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Thu Jan 13 22:49:29 UTC 2011
Author: ehuelsmann
Date: Thu Jan 13 17:49:28 2011
New Revision: 13143
Log:
Add IntegrityError and ProcessingTerminated error classes
and adjust Interpreter.run() accordingly.
No longer call (directly or indirectly) System.exit(),
throw the relevant errors instead.
Added:
trunk/abcl/src/org/armedbear/lisp/IntegrityError.java
- copied, changed from r13136, /trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java
trunk/abcl/src/org/armedbear/lisp/ProcessingTerminated.java
- copied, changed from r13136, /trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java
Modified:
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/Extensions.java
trunk/abcl/src/org/armedbear/lisp/Interpreter.java
trunk/abcl/src/org/armedbear/lisp/Main.java
trunk/abcl/src/org/armedbear/lisp/Primitives.java
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 Thu Jan 13 17:49:28 2011
@@ -141,7 +141,7 @@
if (symbol != null) {
if (symbol.getSymbolFunction() instanceof Autoload) {
Debug.trace("Unable to autoload " + symbol.writeToString());
- System.exit(-1);
+ throw new IntegrityError();
}
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/Extensions.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Extensions.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Extensions.java Thu Jan 13 17:49:28 2011
@@ -200,8 +200,7 @@
@Override
public LispObject execute()
{
- exit(0);
- return LispThread.currentThread().nothing();
+ throw new ProcessingTerminated();
}
@Override
public LispObject execute(LispObject first, LispObject second)
@@ -213,8 +212,7 @@
if (second instanceof Fixnum)
status = ((Fixnum)second).value;
}
- exit(status);
- return LispThread.currentThread().nothing();
+ throw new ProcessingTerminated(status);
}
}
@@ -229,8 +227,7 @@
{
((Stream)Symbol.STANDARD_OUTPUT.getSymbolValue())._finishOutput();
((Stream)Symbol.ERROR_OUTPUT.getSymbolValue())._finishOutput();
- exit(0);
- return LispThread.currentThread().nothing();
+ throw new ProcessingTerminated();
}
@Override
public LispObject execute(LispObject first, LispObject second)
@@ -241,8 +238,7 @@
if (second instanceof Fixnum)
status = ((Fixnum)second).value;
}
- exit(status);
- return LispThread.currentThread().nothing();
+ throw new ProcessingTerminated(status);
}
}
Copied: trunk/abcl/src/org/armedbear/lisp/IntegrityError.java (from r13136, /trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java)
==============================================================================
--- /trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/IntegrityError.java Thu Jan 13 17:49:28 2011
@@ -1,7 +1,7 @@
/*
- * ThreadDestroyed.java
+ * IntegrityError.java
*
- * Copyright (C) 2003 Peter Graves
+ * Copyright (C) 2011 Erik Huelsmann
* $Id$
*
* This program is free software; you can redistribute it and/or
@@ -33,9 +33,9 @@
package org.armedbear.lisp;
-public class ThreadDestroyed extends Error
+public class IntegrityError extends Error
{
- public ThreadDestroyed()
+ public IntegrityError()
{
}
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 Thu Jan 13 17:49:28 2011
@@ -332,6 +332,7 @@
}
}
+ @SuppressWarnings("CallToThreadDumpStack")
public void run()
{
final LispThread thread = LispThread.currentThread();
@@ -342,66 +343,74 @@
thread.execute(tplFun);
return;
}
- // We only arrive here if something went wrong and we weren't able
- // to load top-level.lisp and run the normal top-level loop.
- Stream out = getStandardOutput();
- while (true) {
- try {
- thread.resetStack();
- thread.clearSpecialBindings();
- out._writeString("* ");
- out._finishOutput();
- LispObject object =
- getStandardInput().read(false, EOF, false, thread,
- Stream.currentReadtable);
- if (object == EOF)
- break;
- out.setCharPos(0);
- Symbol.MINUS.setSymbolValue(object);
- LispObject result = Lisp.eval(object, new Environment(), thread);
- Debug.assertTrue(result != null);
- Symbol.STAR_STAR_STAR.setSymbolValue(Symbol.STAR_STAR.getSymbolValue());
- Symbol.STAR_STAR.setSymbolValue(Symbol.STAR.getSymbolValue());
- Symbol.STAR.setSymbolValue(result);
- Symbol.PLUS_PLUS_PLUS.setSymbolValue(Symbol.PLUS_PLUS.getSymbolValue());
- Symbol.PLUS_PLUS.setSymbolValue(Symbol.PLUS.getSymbolValue());
- Symbol.PLUS.setSymbolValue(Symbol.MINUS.getSymbolValue());
- out = getStandardOutput();
- out.freshLine();
- LispObject[] values = thread.getValues();
- Symbol.SLASH_SLASH_SLASH.setSymbolValue(Symbol.SLASH_SLASH.getSymbolValue());
- Symbol.SLASH_SLASH.setSymbolValue(Symbol.SLASH.getSymbolValue());
- if (values != null) {
- LispObject slash = NIL;
- for (int i = values.length; i-- > 0;)
- slash = new Cons(values[i], slash);
- Symbol.SLASH.setSymbolValue(slash);
- for (int i = 0; i < values.length; i++)
- out._writeLine(values[i].writeToString());
- } else {
- Symbol.SLASH.setSymbolValue(new Cons(result));
- out._writeLine(result.writeToString());
- }
- out._finishOutput();
- }
- catch (StackOverflowError e) {
- getStandardInput().clearInput();
- out._writeLine("Stack overflow");
- }
- catch (ControlTransfer c) {
- // We're on the toplevel, if this occurs,
- // we're toast...
- reportError(c, thread);
- }
- catch (Throwable t) {
- getStandardInput().clearInput();
- out.printStackTrace(t);
- thread.printBacktrace();
- }
- }
+ }
+ catch (ProcessingTerminated e) {
+ throw e;
+ }
+ catch (IntegrityError e) {
+ return;
}
catch (Throwable t) {
t.printStackTrace();
+ return;
+ }
+
+ // We only arrive here if something went wrong and we weren't able
+ // to load top-level.lisp and run the normal top-level loop.
+ Stream out = getStandardOutput();
+ while (true) {
+ try {
+ thread.resetStack();
+ thread.clearSpecialBindings();
+ out._writeString("* ");
+ out._finishOutput();
+ LispObject object =
+ getStandardInput().read(false, EOF, false, thread,
+ Stream.currentReadtable);
+ if (object == EOF)
+ break;
+ out.setCharPos(0);
+ Symbol.MINUS.setSymbolValue(object);
+ LispObject result = Lisp.eval(object, new Environment(), thread);
+ Debug.assertTrue(result != null);
+ Symbol.STAR_STAR_STAR.setSymbolValue(Symbol.STAR_STAR.getSymbolValue());
+ Symbol.STAR_STAR.setSymbolValue(Symbol.STAR.getSymbolValue());
+ Symbol.STAR.setSymbolValue(result);
+ Symbol.PLUS_PLUS_PLUS.setSymbolValue(Symbol.PLUS_PLUS.getSymbolValue());
+ Symbol.PLUS_PLUS.setSymbolValue(Symbol.PLUS.getSymbolValue());
+ Symbol.PLUS.setSymbolValue(Symbol.MINUS.getSymbolValue());
+ out = getStandardOutput();
+ out.freshLine();
+ LispObject[] values = thread.getValues();
+ Symbol.SLASH_SLASH_SLASH.setSymbolValue(Symbol.SLASH_SLASH.getSymbolValue());
+ Symbol.SLASH_SLASH.setSymbolValue(Symbol.SLASH.getSymbolValue());
+ if (values != null) {
+ LispObject slash = NIL;
+ for (int i = values.length; i-- > 0;)
+ slash = new Cons(values[i], slash);
+ Symbol.SLASH.setSymbolValue(slash);
+ for (int i = 0; i < values.length; i++)
+ out._writeLine(values[i].writeToString());
+ } else {
+ Symbol.SLASH.setSymbolValue(new Cons(result));
+ out._writeLine(result.writeToString());
+ }
+ out._finishOutput();
+ }
+ catch (StackOverflowError e) {
+ getStandardInput().clearInput();
+ out._writeLine("Stack overflow");
+ }
+ catch (ControlTransfer c) {
+ // We're on the toplevel, if this occurs,
+ // we're toast...
+ reportError(c, thread);
+ }
+ catch (Throwable t) {
+ getStandardInput().clearInput();
+ out.printStackTrace(t);
+ thread.printBacktrace();
+ }
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/Main.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Main.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Main.java Thu Jan 13 17:49:28 2011
@@ -30,26 +30,29 @@
* obligated to do so. If you do not wish to do so, delete this
* exception statement from your version.
*/
-
package org.armedbear.lisp;
-public final class Main
-{
- public static final long startTimeMillis = System.currentTimeMillis();
+public final class Main {
+
+ public static final long startTimeMillis = System.currentTimeMillis();
+
+ public static void main(final String[] args) {
+ // Run the interpreter in a secondary thread so we can control the stack
+ // size.
+ Runnable r = new Runnable() {
+
+ public void run() {
+ Interpreter interpreter = Interpreter.createDefaultInstance(args);
+ if (interpreter != null) {
+ try {
+ interpreter.run();
+ } catch (ProcessingTerminated e) {
+ System.exit(e.getStatus());
+ }
- public static void main(final String[] args)
- {
- // Run the interpreter in a secondary thread so we can control the stack
- // size.
- Runnable r = new Runnable()
- {
- public void run()
- {
- Interpreter interpreter = Interpreter.createDefaultInstance(args);
- if (interpreter != null)
- interpreter.run();
- }
- };
- new Thread(null, r, "interpreter", 4194304L).start();
- }
+ }
+ }
+ };
+ new Thread(null, r, "interpreter", 4194304L).start();
+ }
}
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 Thu Jan 13 17:49:28 2011
@@ -1583,7 +1583,7 @@
@Override
@SuppressWarnings("CallToThreadDumpStack")
public LispObject execute(LispObject[] args) {
- Error e = new Error();
+ Error e = new IntegrityError();
e.printStackTrace();
@@ -1596,9 +1596,7 @@
for (LispObject a : args)
System.out.println(a.writeToString());
- //###FIXME: Bail out, but do it nicer...
- exit(1);
- return NIL;
+ throw e;
}
};
Copied: trunk/abcl/src/org/armedbear/lisp/ProcessingTerminated.java (from r13136, /trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java)
==============================================================================
--- /trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/ProcessingTerminated.java Thu Jan 13 17:49:28 2011
@@ -1,7 +1,7 @@
/*
- * ThreadDestroyed.java
+ * ProcessingTerminated.java
*
- * Copyright (C) 2003 Peter Graves
+ * Copyright (C) 2011 Erik Huelsmann
* $Id$
*
* This program is free software; you can redistribute it and/or
@@ -33,10 +33,20 @@
package org.armedbear.lisp;
-public class ThreadDestroyed extends Error
+public class ProcessingTerminated extends Error
{
- public ThreadDestroyed()
+ private int status;
+
+ public ProcessingTerminated()
{
}
+ public ProcessingTerminated(int status)
+ {
+ this.status = status;
+ }
+
+ int getStatus() {
+ return status;
+ }
}
More information about the armedbear-cvs
mailing list