0001: /*
0002: * Lisp.java
0003: *
0004: * Copyright (C) 2002-2004 Peter Graves
0005: * $Id: Lisp.java,v 1.280 2004/09/18 01:05:26 piso Exp $
0006: *
0007: * This program is free software; you can redistribute it and/or
0008: * modify it under the terms of the GNU General Public License
0009: * as published by the Free Software Foundation; either version 2
0010: * of the License, or (at your option) any later version.
0011: *
0012: * This program is distributed in the hope that it will be useful,
0013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
0014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
0015: * GNU General Public License for more details.
0016: *
0017: * You should have received a copy of the GNU General Public License
0018: * along with this program; if not, write to the Free Software
0019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
0020: */
0021:
0022: package org.armedbear.lisp;
0023:
0024: import java.io.File;
0025: import java.io.IOException;
0026: import java.io.InputStream;
0027: import java.math.BigInteger;
0028: import java.net.URL;
0029: import java.util.Hashtable;
0030: import java.util.zip.ZipEntry;
0031: import java.util.zip.ZipFile;
0032:
0033: public abstract class Lisp {
0034: public static boolean cold = true;
0035:
0036: public static boolean initialized;
0037:
0038: // Packages.
0039: public static final Package PACKAGE_CL = Packages.createPackage(
0040: "COMMON-LISP", 1024);
0041: public static final Package PACKAGE_CL_USER = Packages
0042: .createPackage("COMMON-LISP-USER", 1024);
0043: public static final Package PACKAGE_SYS = Packages
0044: .createPackage("SYSTEM");
0045: public static final Package PACKAGE_TPL = Packages
0046: .createPackage("TOP-LEVEL");
0047: public static final Package PACKAGE_EXT = Packages
0048: .createPackage("EXTENSIONS");
0049: public static final Package PACKAGE_JVM = Packages
0050: .createPackage("JVM");
0051: public static final Package PACKAGE_PROF = Packages
0052: .createPackage("PROFILER");
0053: public static final Package PACKAGE_JAVA = Packages
0054: .createPackage("JAVA");
0055: static {
0056: try {
0057: PACKAGE_CL.addNickname("CL");
0058: PACKAGE_CL_USER.addNickname("CL-USER");
0059: PACKAGE_CL_USER.usePackage(PACKAGE_CL);
0060: PACKAGE_CL_USER.usePackage(PACKAGE_EXT);
0061: PACKAGE_CL_USER.usePackage(PACKAGE_JAVA);
0062: PACKAGE_SYS.addNickname("SYS");
0063: PACKAGE_SYS.usePackage(PACKAGE_CL);
0064: PACKAGE_SYS.usePackage(PACKAGE_EXT);
0065: PACKAGE_TPL.addNickname("TPL");
0066: PACKAGE_TPL.usePackage(PACKAGE_CL);
0067: PACKAGE_TPL.usePackage(PACKAGE_EXT);
0068: PACKAGE_EXT.addNickname("EXT");
0069: PACKAGE_EXT.usePackage(PACKAGE_CL);
0070: PACKAGE_JVM.usePackage(PACKAGE_CL);
0071: PACKAGE_JVM.usePackage(PACKAGE_EXT);
0072: PACKAGE_PROF.addNickname("PROF");
0073: PACKAGE_PROF.usePackage(PACKAGE_CL);
0074: PACKAGE_PROF.usePackage(PACKAGE_EXT);
0075: PACKAGE_JAVA.usePackage(PACKAGE_CL);
0076: PACKAGE_JAVA.usePackage(PACKAGE_EXT);
0077: } catch (Throwable t) {
0078: t.printStackTrace();
0079: }
0080: }
0081: public static final Package PACKAGE_KEYWORD = Packages
0082: .createPackage("KEYWORD", 1024);
0083:
0084: static {
0085: PACKAGE_CL.addInitialExports(Exports.COMMON_LISP_SYMBOL_NAMES);
0086: }
0087:
0088: // ### nil
0089: public static final LispObject NIL = new Nil(PACKAGE_CL);
0090:
0091: // End-of-file marker.
0092: public static final LispObject EOF = new LispObject();
0093:
0094: // Functional types.
0095: static final int FTYPE_SPECIAL_OPERATOR = 1;
0096: static final int FTYPE_MACRO = 2;
0097: static final int FTYPE_AUTOLOAD = 3;
0098:
0099: private static boolean debug = true;
0100:
0101: public static boolean profiling;
0102:
0103: public static boolean sampling;
0104:
0105: public static volatile boolean sampleNow;
0106:
0107: // argv must not be null!
0108: public static final LispObject funcall(LispObject fun,
0109: LispObject[] argv, LispThread thread)
0110: throws ConditionThrowable {
0111: if (fun instanceof Autoload) {
0112: Autoload autoload = (Autoload) fun;
0113: autoload.load();
0114: fun = autoload.getSymbol().getSymbolFunction();
0115: }
0116: LispObject stack = thread.getStack();
0117: thread.pushStackFrame(fun, argv);
0118: thread.clearValues();
0119: LispObject result;
0120: if (profiling)
0121: if (!sampling)
0122: fun.incrementCallCount();
0123: try {
0124: switch (argv.length) {
0125: case 0:
0126: result = fun.execute();
0127: break;
0128: case 1:
0129: result = fun.execute(argv[0]);
0130: break;
0131: case 2:
0132: result = fun.execute(argv[0], argv[1]);
0133: break;
0134: case 3:
0135: result = fun.execute(argv[0], argv[1], argv[2]);
0136: break;
0137: case 4:
0138: result = fun
0139: .execute(argv[0], argv[1], argv[2], argv[3]);
0140: break;
0141: default:
0142: result = fun.execute(argv);
0143: break;
0144: }
0145: } finally {
0146: thread.setStack(stack);
0147: }
0148: return result;
0149: }
0150:
0151: public static final LispObject funcall0(LispObject fun,
0152: LispThread thread) throws ConditionThrowable {
0153: if (fun instanceof Autoload) {
0154: Autoload autoload = (Autoload) fun;
0155: autoload.load();
0156: fun = autoload.getSymbol().getSymbolFunction();
0157: }
0158: LispObject stack = thread.getStack();
0159: LispObject[] argv = new LispObject[0];
0160: thread.pushStackFrame(fun, argv);
0161: thread.clearValues();
0162: LispObject result;
0163: if (profiling)
0164: if (!sampling)
0165: fun.incrementCallCount();
0166: try {
0167: result = fun.execute();
0168: } finally {
0169: thread.setStack(stack);
0170: }
0171: return result;
0172: }
0173:
0174: public static final LispObject funcall1(LispObject fun,
0175: LispObject arg, LispThread thread)
0176: throws ConditionThrowable {
0177: if (fun instanceof Autoload) {
0178: Autoload autoload = (Autoload) fun;
0179: autoload.load();
0180: fun = autoload.getSymbol().getSymbolFunction();
0181: }
0182: LispObject stack = thread.getStack();
0183: LispObject[] argv = new LispObject[1];
0184: argv[0] = arg;
0185: thread.pushStackFrame(fun, argv);
0186: thread.clearValues();
0187: LispObject result;
0188: if (profiling)
0189: if (!sampling)
0190: fun.incrementCallCount();
0191: try {
0192: result = fun.execute(arg);
0193: } finally {
0194: thread.setStack(stack);
0195: }
0196: return result;
0197: }
0198:
0199: public static final LispObject funcall2(LispObject fun,
0200: LispObject first, LispObject second, LispThread thread)
0201: throws ConditionThrowable {
0202: if (fun instanceof Autoload) {
0203: Autoload autoload = (Autoload) fun;
0204: autoload.load();
0205: fun = autoload.getSymbol().getSymbolFunction();
0206: }
0207: LispObject stack = thread.getStack();
0208: LispObject[] argv = new LispObject[2];
0209: argv[0] = first;
0210: argv[1] = second;
0211: thread.pushStackFrame(fun, argv);
0212: thread.clearValues();
0213: LispObject result;
0214: if (profiling)
0215: if (!sampling)
0216: fun.incrementCallCount();
0217: try {
0218: result = fun.execute(first, second);
0219: } finally {
0220: thread.setStack(stack);
0221: }
0222: return result;
0223: }
0224:
0225: public static final LispObject funcall3(LispObject fun,
0226: LispObject first, LispObject second, LispObject third,
0227: LispThread thread) throws ConditionThrowable {
0228: if (fun instanceof Autoload) {
0229: Autoload autoload = (Autoload) fun;
0230: autoload.load();
0231: fun = autoload.getSymbol().getSymbolFunction();
0232: }
0233: LispObject stack = thread.getStack();
0234: LispObject[] argv = new LispObject[3];
0235: argv[0] = first;
0236: argv[1] = second;
0237: argv[2] = third;
0238: thread.pushStackFrame(fun, argv);
0239: thread.clearValues();
0240: LispObject result;
0241: if (profiling)
0242: if (!sampling)
0243: fun.incrementCallCount();
0244: try {
0245: result = fun.execute(first, second, third);
0246: } finally {
0247: thread.setStack(stack);
0248: }
0249: return result;
0250: }
0251:
0252: public static final LispObject macroexpand(LispObject form,
0253: final Environment env, final LispThread thread)
0254: throws ConditionThrowable {
0255: LispObject expanded = NIL;
0256: while (true) {
0257: form = macroexpand_1(form, env, thread);
0258: LispObject[] values = thread.getValues();
0259: if (values[1] == NIL) {
0260: values[1] = expanded;
0261: return form;
0262: }
0263: expanded = T;
0264: }
0265: }
0266:
0267: public static final LispObject macroexpand_1(final LispObject form,
0268: final Environment env, final LispThread thread)
0269: throws ConditionThrowable {
0270: if (form instanceof Cons) {
0271: LispObject car = form.car();
0272: if (car instanceof Symbol) {
0273: LispObject obj = env.lookupFunctional(car);
0274: if (obj instanceof Autoload) {
0275: Autoload autoload = (Autoload) obj;
0276: autoload.load();
0277: obj = autoload.getSymbol().getSymbolFunction();
0278: }
0279: if (obj instanceof SpecialOperator) {
0280: obj = get((Symbol) car, Symbol.MACROEXPAND_MACRO);
0281: if (obj instanceof Autoload) {
0282: Autoload autoload = (Autoload) obj;
0283: autoload.load();
0284: obj = get((Symbol) car,
0285: Symbol.MACROEXPAND_MACRO);
0286: }
0287: }
0288: if (obj instanceof MacroObject) {
0289: LispObject expander = ((MacroObject) obj)
0290: .getExpander();
0291: if (profiling)
0292: if (!sampling)
0293: expander.incrementCallCount();
0294: LispObject hook = coerceToFunction(_MACROEXPAND_HOOK_
0295: .symbolValue(thread));
0296: return thread.setValues(hook.execute(expander,
0297: form, env), T);
0298: }
0299: }
0300: } else if (form instanceof Symbol) {
0301: Symbol symbol = (Symbol) form;
0302: LispObject obj = null;
0303: if (symbol.isSpecialVariable())
0304: obj = thread.lookupSpecial(symbol);
0305: else
0306: obj = env.lookup(symbol);
0307: if (obj == null)
0308: obj = symbol.getSymbolValue();
0309: if (obj instanceof SymbolMacro)
0310: return thread.setValues(((SymbolMacro) obj)
0311: .getExpansion(), T);
0312: }
0313: // Not a macro.
0314: return thread.setValues(form, NIL);
0315: }
0316:
0317: // ### interactive-eval
0318: private static final Primitive1 INTERACTIVE_EVAL = new Primitive1(
0319: "interactive-eval", PACKAGE_SYS, false) {
0320: public LispObject execute(LispObject object)
0321: throws ConditionThrowable {
0322: final LispThread thread = LispThread.currentThread();
0323: Symbol.MINUS.setSymbolValue(object);
0324: LispObject result;
0325: try {
0326: result = funcall1(Symbol.EVAL.getSymbolFunction(),
0327: object, thread);
0328: } catch (OutOfMemoryError e) {
0329: return signal(new LispError("Out of memory."));
0330: } catch (StackOverflowError e) {
0331: return signal(new StorageCondition("Stack overflow."));
0332: } catch (ConditionThrowable t) {
0333: throw t;
0334: } catch (Throwable t) {
0335: Debug.trace(t);
0336: thread.bindSpecial(_SAVED_BACKTRACE_, thread
0337: .backtraceAsList(0));
0338: return signal(new LispError("Caught " + t + "."));
0339: }
0340: Debug.assertTrue(result != null);
0341: Symbol.STAR_STAR_STAR.setSymbolValue(Symbol.STAR_STAR
0342: .getSymbolValue());
0343: Symbol.STAR_STAR.setSymbolValue(Symbol.STAR
0344: .getSymbolValue());
0345: Symbol.STAR.setSymbolValue(result);
0346: Symbol.PLUS_PLUS_PLUS.setSymbolValue(Symbol.PLUS_PLUS
0347: .getSymbolValue());
0348: Symbol.PLUS_PLUS.setSymbolValue(Symbol.PLUS
0349: .getSymbolValue());
0350: Symbol.PLUS.setSymbolValue(Symbol.MINUS.getSymbolValue());
0351: LispObject[] values = thread.getValues();
0352: Symbol.SLASH_SLASH_SLASH.setSymbolValue(Symbol.SLASH_SLASH
0353: .getSymbolValue());
0354: Symbol.SLASH_SLASH.setSymbolValue(Symbol.SLASH
0355: .getSymbolValue());
0356: if (values != null) {
0357: LispObject slash = NIL;
0358: for (int i = values.length; i-- > 0;)
0359: slash = new Cons(values[i], slash);
0360: Symbol.SLASH.setSymbolValue(slash);
0361: } else {
0362: Symbol.SLASH.setSymbolValue(new Cons(result));
0363: }
0364: return result;
0365: }
0366: };
0367:
0368: public static final LispObject signal(Condition condition)
0369: throws ConditionThrowable {
0370: return Symbol.SIGNAL.getSymbolFunction().execute(condition);
0371: }
0372:
0373: protected static volatile boolean interrupted;
0374:
0375: public static synchronized final void setInterrupted(boolean b) {
0376: interrupted = b;
0377: }
0378:
0379: public static final void handleInterrupt()
0380: throws ConditionThrowable {
0381: setInterrupted(false);
0382: Symbol.BREAK.getSymbolFunction().execute();
0383: setInterrupted(false);
0384: }
0385:
0386: public static final LispObject eval(final LispObject obj,
0387: final Environment env, final LispThread thread)
0388: throws ConditionThrowable {
0389: if (profiling && sampling) {
0390: // FIXME
0391: // This is not exactly the right place to do this. We should
0392: // include the current call as well.
0393: if (sampleNow)
0394: Profiler.sample(thread);
0395: }
0396: thread.clearValues();
0397: if (interrupted)
0398: handleInterrupt();
0399: if (thread.isDestroyed())
0400: throw new ThreadDestroyed();
0401: if (obj instanceof Symbol) {
0402: LispObject result = null;
0403: if (env.isDeclaredSpecial((Symbol) obj)
0404: || obj.isSpecialVariable())
0405: result = thread.lookupSpecial(obj);
0406: else
0407: result = env.lookup(obj);
0408: if (result == null) {
0409: result = obj.getSymbolValue();
0410: if (result == null)
0411: return signal(new UnboundVariable(obj));
0412: }
0413: if (result instanceof SymbolMacro)
0414: return eval(((SymbolMacro) result).getExpansion(), env,
0415: thread);
0416: return result;
0417: } else if (obj instanceof Cons) {
0418: LispObject first = obj.car();
0419: if (first instanceof Symbol) {
0420: LispObject fun = env.lookupFunctional(first);
0421: if (fun == null)
0422: return signal(new UndefinedFunction(first));
0423: switch (fun.getFunctionalType()) {
0424: case FTYPE_SPECIAL_OPERATOR: {
0425: if (profiling)
0426: if (!sampling)
0427: fun.incrementCallCount();
0428: // Don't eval args!
0429: return fun.execute(obj.cdr(), env);
0430: }
0431: case FTYPE_MACRO:
0432: return eval(macroexpand(obj, env, thread), env,
0433: thread);
0434: case FTYPE_AUTOLOAD: {
0435: Autoload autoload = (Autoload) fun;
0436: autoload.load();
0437: return eval(obj, env, thread);
0438: }
0439: default: {
0440: return funcall(fun,
0441: evalList(obj.cdr(), env, thread), thread);
0442: }
0443: }
0444: } else {
0445: LispObject args = obj.cdr();
0446: if (!args.listp())
0447: return signal(new TypeError(args, "list"));
0448: LispObject funcar = first.car();
0449: LispObject rest = first.cdr();
0450: Symbol symbol = checkSymbol(funcar);
0451: if (symbol == Symbol.LAMBDA) {
0452: Closure closure = new Closure(rest.car(), rest
0453: .cdr(), env);
0454: return closure.execute(evalList(args, env, thread));
0455: } else
0456: return signal(new ProgramError(
0457: "Illegal function object: "
0458: + first.writeToString()));
0459: }
0460: } else
0461: return obj;
0462: }
0463:
0464: private static final LispObject[] evalList(LispObject exps,
0465: Environment env, LispThread thread)
0466: throws ConditionThrowable {
0467: final int length = exps.length();
0468: LispObject[] results = new LispObject[length];
0469: for (int i = 0; i < length; i++) {
0470: results[i] = eval(exps.car(), env, thread);
0471: exps = exps.cdr();
0472: }
0473: // Ignore multiple values!
0474: thread.clearValues();
0475: return results;
0476: }
0477:
0478: public static final LispObject progn(LispObject body,
0479: Environment env, LispThread thread)
0480: throws ConditionThrowable {
0481: LispObject result = NIL;
0482: while (body != NIL) {
0483: result = eval(body.car(), env, thread);
0484: body = body.cdr();
0485: }
0486: return result;
0487: }
0488:
0489: // Environment wrappers.
0490: public static final void bind(Symbol symbol, LispObject value,
0491: Environment env) throws ConditionThrowable {
0492: if (env.isDeclaredSpecial(symbol) || symbol.isSpecialVariable())
0493: LispThread.currentThread().bindSpecial(symbol, value);
0494: else
0495: env.bind(symbol, value);
0496: }
0497:
0498: public static final void rebind(Symbol symbol, LispObject value,
0499: Environment env) throws ConditionThrowable {
0500: if (env.isDeclaredSpecial(symbol) || symbol.isSpecialVariable()) {
0501: Environment dynEnv = LispThread.currentThread()
0502: .getDynamicEnvironment();
0503: Debug.assertTrue(dynEnv != null);
0504: dynEnv.rebind(symbol, value);
0505: } else
0506: env.rebind(symbol, value);
0507: }
0508:
0509: public static final void bindSpecialVariable(Symbol symbol,
0510: LispObject value) throws ConditionThrowable {
0511: LispThread.currentThread().bindSpecial(symbol, value);
0512: }
0513:
0514: public static final LispObject setSpecialVariable(Symbol symbol,
0515: LispObject value, LispThread thread) {
0516: Environment dynEnv = thread.getDynamicEnvironment();
0517: if (dynEnv != null) {
0518: Binding binding = dynEnv.getBinding(symbol);
0519: if (binding != null) {
0520: binding.value = value;
0521: return value;
0522: }
0523: }
0524: symbol.setSymbolValue(value);
0525: return value;
0526: }
0527:
0528: public static final Cons list1(LispObject obj1) {
0529: return new Cons(obj1);
0530: }
0531:
0532: public static final Cons list2(LispObject obj1, LispObject obj2) {
0533: return new Cons(obj1, new Cons(obj2));
0534: }
0535:
0536: public static final Cons list3(LispObject obj1, LispObject obj2,
0537: LispObject obj3) {
0538: return new Cons(obj1, new Cons(obj2, new Cons(obj3)));
0539: }
0540:
0541: public static final Cons list4(LispObject obj1, LispObject obj2,
0542: LispObject obj3, LispObject obj4) {
0543: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0544: obj4))));
0545: }
0546:
0547: public static final Cons list5(LispObject obj1, LispObject obj2,
0548: LispObject obj3, LispObject obj4, LispObject obj5) {
0549: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0550: obj4, new Cons(obj5)))));
0551: }
0552:
0553: public static final Cons list6(LispObject obj1, LispObject obj2,
0554: LispObject obj3, LispObject obj4, LispObject obj5,
0555: LispObject obj6) {
0556: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0557: obj4, new Cons(obj5, new Cons(obj6))))));
0558: }
0559:
0560: public static final Cons list7(LispObject obj1, LispObject obj2,
0561: LispObject obj3, LispObject obj4, LispObject obj5,
0562: LispObject obj6, LispObject obj7) {
0563: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0564: obj4, new Cons(obj5, new Cons(obj6, new Cons(obj7)))))));
0565: }
0566:
0567: public static final Cons list8(LispObject obj1, LispObject obj2,
0568: LispObject obj3, LispObject obj4, LispObject obj5,
0569: LispObject obj6, LispObject obj7, LispObject obj8) {
0570: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0571: obj4, new Cons(obj5, new Cons(obj6, new Cons(obj7,
0572: new Cons(obj8))))))));
0573: }
0574:
0575: // Used by JVM compiler.
0576: public static final LispObject multipleValueList(LispObject result)
0577: throws ConditionThrowable {
0578: LispThread thread = LispThread.currentThread();
0579: LispObject[] values = thread.getValues();
0580: if (values == null)
0581: return new Cons(result);
0582: thread.clearValues();
0583: LispObject list = NIL;
0584: for (int i = values.length; i-- > 0;)
0585: list = new Cons(values[i], list);
0586: return list;
0587: }
0588:
0589: // Used by JVM compiler for MULTIPLE-VALUE-CALLs with a single values form.
0590: public static final LispObject multipleValueCall1(
0591: LispObject result, LispObject function, LispThread thread)
0592: throws ConditionThrowable {
0593: LispObject[] values = thread.getValues();
0594: thread.clearValues();
0595: if (values == null)
0596: return funcall1(coerceToFunction(function), result, thread);
0597: else
0598: return funcall(coerceToFunction(function), values, thread);
0599: }
0600:
0601: public static Symbol checkSymbol(LispObject obj)
0602: throws ConditionThrowable {
0603: if (obj == null)
0604: throw new NullPointerException();
0605: try {
0606: return (Symbol) obj;
0607: } catch (ClassCastException e) {
0608: signal(new TypeError(obj, "symbol"));
0609: // Not reached.
0610: return null;
0611: }
0612: }
0613:
0614: public static final Cons checkCons(LispObject obj)
0615: throws ConditionThrowable {
0616: if (obj == null)
0617: throw new NullPointerException();
0618: try {
0619: return (Cons) obj;
0620: } catch (ClassCastException e) {
0621: signal(new TypeError(obj, "cons"));
0622: // Not reached.
0623: return null;
0624: }
0625: }
0626:
0627: public static final LispObject checkList(LispObject obj)
0628: throws ConditionThrowable {
0629: if (obj == null)
0630: throw new NullPointerException();
0631: if (obj.listp())
0632: return obj;
0633: return signal(new TypeError(obj, Symbol.LIST));
0634: }
0635:
0636: public static final AbstractArray checkArray(LispObject obj)
0637: throws ConditionThrowable {
0638: if (obj == null)
0639: throw new NullPointerException();
0640: try {
0641: return (AbstractArray) obj;
0642: } catch (ClassCastException e) {
0643: signal(new TypeError(obj, Symbol.ARRAY));
0644: // Not reached.
0645: return null;
0646: }
0647: }
0648:
0649: public static final AbstractVector checkVector(LispObject obj)
0650: throws ConditionThrowable {
0651: if (obj == null)
0652: throw new NullPointerException();
0653: try {
0654: return (AbstractVector) obj;
0655: } catch (ClassCastException e) {
0656: signal(new TypeError(obj, Symbol.VECTOR));
0657: // Not reached.
0658: return null;
0659: }
0660: }
0661:
0662: public static final String javaString(LispObject arg)
0663: throws ConditionThrowable {
0664: if (arg instanceof AbstractString)
0665: return arg.getStringValue();
0666: if (arg instanceof Symbol)
0667: return arg.getName();
0668: if (arg instanceof LispCharacter)
0669: return String
0670: .valueOf(new char[] { ((LispCharacter) arg).value });
0671: signal(new TypeError(arg.writeToString()
0672: + " cannot be coerced to a string."));
0673: // Not reached.
0674: return null;
0675: }
0676:
0677: public static final LispObject number(long n) {
0678: if (n >= Integer.MIN_VALUE && n <= Integer.MAX_VALUE)
0679: return new Fixnum((int) n);
0680: else
0681: return new Bignum(n);
0682: }
0683:
0684: private static final BigInteger INT_MIN = BigInteger
0685: .valueOf(Integer.MIN_VALUE);
0686: private static final BigInteger INT_MAX = BigInteger
0687: .valueOf(Integer.MAX_VALUE);
0688:
0689: public static final LispObject number(BigInteger numerator,
0690: BigInteger denominator) throws ConditionThrowable {
0691: if (denominator.signum() == 0)
0692: signal(new DivisionByZero());
0693: if (denominator.signum() < 0) {
0694: numerator = numerator.negate();
0695: denominator = denominator.negate();
0696: }
0697: BigInteger gcd = numerator.gcd(denominator);
0698: if (!gcd.equals(BigInteger.ONE)) {
0699: numerator = numerator.divide(gcd);
0700: denominator = denominator.divide(gcd);
0701: }
0702: if (denominator.equals(BigInteger.ONE))
0703: return number(numerator);
0704: else
0705: return new Ratio(numerator, denominator);
0706: }
0707:
0708: public static final LispObject number(BigInteger n) {
0709: if (n.compareTo(INT_MIN) >= 0 && n.compareTo(INT_MAX) <= 0)
0710: return new Fixnum(n.intValue());
0711: else
0712: return new Bignum(n);
0713: }
0714:
0715: // Adapted from SBCL.
0716: public static final int mix(long x, long y) {
0717: long xy = x * 3 + y;
0718: return (int) (536870911L & (441516657L ^ xy ^ (xy >> 5)));
0719: }
0720:
0721: public static final LispObject readObjectFromString(String s) {
0722: try {
0723: return new StringInputStream(s).read(true, NIL, false);
0724: } catch (Throwable t) {
0725: return null;
0726: }
0727: }
0728:
0729: public static final LispObject loadCompiledFunction(
0730: String namestring) throws ConditionThrowable {
0731: // INIT-FASL binds *DEFAULT-PATHNAME-DEFAULTS* to *LOAD-TRUENAME*.
0732: Pathname defaultPathname = Pathname
0733: .coerceToPathname(_DEFAULT_PATHNAME_DEFAULTS_
0734: .symbolValue());
0735: if (defaultPathname.getDevice() instanceof Pathname) {
0736: // We're loading a fasl from j.jar.
0737: URL url = Lisp.class.getResource(namestring);
0738: if (url != null) {
0739: try {
0740: String s = url.toString();
0741: String zipFileName;
0742: String entryName;
0743: if (s.startsWith("jar:file:")) {
0744: s = s.substring(9);
0745: int index = s.lastIndexOf('!');
0746: if (index >= 0) {
0747: zipFileName = s.substring(0, index);
0748: entryName = s.substring(index + 1);
0749: if (entryName.startsWith("/"))
0750: entryName = entryName.substring(1);
0751: ZipFile zipFile = new ZipFile(zipFileName);
0752: ZipEntry entry = zipFile
0753: .getEntry(entryName);
0754: if (entry != null) {
0755: long size = entry.getSize();
0756: InputStream in = zipFile
0757: .getInputStream(entry);
0758: byte[] bytes = new byte[(int) size];
0759: int bytesRemaining = (int) size;
0760: int bytesRead = 0;
0761: while (bytesRemaining > 0) {
0762: int n;
0763: if (bytesRemaining >= 4096)
0764: n = in.read(bytes, bytesRead,
0765: 4096);
0766: else
0767: n = in.read(bytes, bytesRead,
0768: bytesRemaining);
0769: if (n < 0)
0770: break;
0771: bytesRead += n;
0772: bytesRemaining -= n;
0773: }
0774: in.close();
0775: if (bytesRemaining > 0)
0776: Debug.trace("bytesRemaining = "
0777: + bytesRemaining);
0778: JavaClassLoader loader = new JavaClassLoader();
0779: Class c = loader
0780: .loadClassFromByteArray(null,
0781: bytes, 0, bytes.length);
0782: if (c != null) {
0783: Class[] parameterTypes = new Class[0];
0784: java.lang.reflect.Constructor constructor = c
0785: .getConstructor(parameterTypes);
0786: Object[] initargs = new Object[0];
0787: LispObject obj = (LispObject) constructor
0788: .newInstance(initargs);
0789: return obj;
0790: }
0791: }
0792: }
0793: }
0794: } catch (VerifyError e) {
0795: return signal(new LispError(
0796: "Class verification failed: "
0797: + e.getMessage()));
0798: } catch (IOException e) {
0799: Debug.trace(e);
0800: } catch (Throwable t) {
0801: Debug.trace(t);
0802: }
0803: }
0804: } else {
0805: Pathname pathname = new Pathname(namestring);
0806: File file = Utilities.getFile(pathname);
0807: if (file != null && file.isFile()) {
0808: try {
0809: JavaClassLoader loader = new JavaClassLoader();
0810: Class c = loader.loadClassFromFile(file);
0811: if (c != null) {
0812: Class[] parameterTypes = new Class[0];
0813: java.lang.reflect.Constructor constructor = c
0814: .getConstructor(parameterTypes);
0815: Object[] initargs = new Object[0];
0816: LispObject obj = (LispObject) constructor
0817: .newInstance(initargs);
0818: return obj;
0819: }
0820: } catch (VerifyError e) {
0821: return signal(new LispError(
0822: "Class verification failed: "
0823: + e.getMessage()));
0824: } catch (Throwable t) {
0825: Debug.trace(t);
0826: }
0827: return signal(new LispError("Unable to load "
0828: + pathname.writeToString()));
0829: }
0830: }
0831: return signal(new LispError("Unable to load " + namestring));
0832: }
0833:
0834: public static final LispObject makeCompiledClosure(LispObject ctf,
0835: LispObject[][] context) {
0836: return new CompiledClosure((ClosureTemplateFunction) ctf,
0837: context);
0838: }
0839:
0840: public static final String safeWriteToString(LispObject obj) {
0841: try {
0842: return obj.writeToString();
0843: } catch (ConditionThrowable t) {
0844: return obj.toString();
0845: } catch (NullPointerException e) {
0846: Debug.trace(e);
0847: return "null";
0848: }
0849: }
0850:
0851: public static final LispObject getUpgradedArrayElementType(
0852: LispObject type) {
0853: if (type == Symbol.CHARACTER || type == Symbol.BASE_CHAR
0854: || type == Symbol.STANDARD_CHAR)
0855: return Symbol.CHARACTER;
0856: if (type == BuiltInClass.CHARACTER)
0857: return Symbol.CHARACTER;
0858: if (type == Symbol.BIT)
0859: return Symbol.BIT;
0860: if (type == NIL)
0861: return NIL;
0862: return T;
0863: }
0864:
0865: public static final LispCharacter checkCharacter(LispObject obj)
0866: throws ConditionThrowable {
0867: if (obj == null)
0868: throw new NullPointerException();
0869: try {
0870: return (LispCharacter) obj;
0871: } catch (ClassCastException e) {
0872: signal(new TypeError(obj, "character"));
0873: // Not reached.
0874: return null;
0875: }
0876: }
0877:
0878: public static final Package checkPackage(LispObject obj)
0879: throws ConditionThrowable {
0880: if (obj == null)
0881: throw new NullPointerException();
0882: try {
0883: return (Package) obj;
0884: } catch (ClassCastException e) {
0885: signal(new TypeError(obj, "package"));
0886: // Not reached.
0887: return null;
0888: }
0889: }
0890:
0891: public static final Function checkFunction(LispObject obj)
0892: throws ConditionThrowable {
0893: if (obj == null)
0894: throw new NullPointerException();
0895: try {
0896: return (Function) obj;
0897: } catch (ClassCastException e) {
0898: signal(new TypeError(obj, "function"));
0899: // Not reached.
0900: return null;
0901: }
0902: }
0903:
0904: public static final Stream checkStream(LispObject obj)
0905: throws ConditionThrowable {
0906: if (obj == null)
0907: throw new NullPointerException();
0908: try {
0909: return (Stream) obj;
0910: } catch (ClassCastException e) {
0911: signal(new TypeError(obj, Symbol.STREAM));
0912: // Not reached.
0913: return null;
0914: }
0915: }
0916:
0917: public static final Stream checkCharacterInputStream(LispObject obj)
0918: throws ConditionThrowable {
0919: if (obj instanceof Stream)
0920: if (((Stream) obj).isCharacterInputStream())
0921: return (Stream) obj;
0922: if (obj == null)
0923: throw new NullPointerException();
0924: signal(new TypeError(obj, "character input stream"));
0925: // Not reached.
0926: return null;
0927: }
0928:
0929: public static final Stream checkCharacterOutputStream(LispObject obj)
0930: throws ConditionThrowable {
0931: if (obj instanceof Stream)
0932: if (((Stream) obj).isCharacterOutputStream())
0933: return (Stream) obj;
0934: if (obj == null)
0935: throw new NullPointerException();
0936: signal(new TypeError(obj, "character output stream"));
0937: // Not reached.
0938: return null;
0939: }
0940:
0941: public static final Stream checkBinaryInputStream(LispObject obj)
0942: throws ConditionThrowable {
0943: if (obj instanceof Stream)
0944: if (((Stream) obj).isBinaryInputStream())
0945: return (Stream) obj;
0946: if (obj == null)
0947: throw new NullPointerException();
0948: signal(new TypeError(obj, "binary input stream"));
0949: // Not reached.
0950: return null;
0951: }
0952:
0953: public static final Stream checkBinaryOutputStream(LispObject obj)
0954: throws ConditionThrowable {
0955: if (obj instanceof Stream)
0956: if (((Stream) obj).isBinaryOutputStream())
0957: return (Stream) obj;
0958: if (obj == null)
0959: throw new NullPointerException();
0960: signal(new TypeError(obj, "binary output stream"));
0961: // Not reached.
0962: return null;
0963: }
0964:
0965: public static final Stream inSynonymOf(LispObject obj)
0966: throws ConditionThrowable {
0967: if (obj == T)
0968: return checkCharacterInputStream(_TERMINAL_IO_
0969: .symbolValue());
0970: if (obj == NIL)
0971: return checkCharacterInputStream(_STANDARD_INPUT_
0972: .symbolValue());
0973: if (obj instanceof Stream) {
0974: Stream stream = (Stream) obj;
0975: if (stream instanceof TwoWayStream) {
0976: Stream in = ((TwoWayStream) stream).getInputStream();
0977: return inSynonymOf(in);
0978: }
0979: if (stream.isCharacterInputStream())
0980: return stream;
0981: }
0982: signal(new TypeError(obj, "character input stream"));
0983: // Not reached.
0984: return null;
0985: }
0986:
0987: public static final Stream outSynonymOf(LispObject obj)
0988: throws ConditionThrowable {
0989: if (obj == T)
0990: return checkCharacterOutputStream(_TERMINAL_IO_
0991: .symbolValue());
0992: if (obj == NIL)
0993: return checkCharacterOutputStream(_STANDARD_OUTPUT_
0994: .symbolValue());
0995: if (obj instanceof Stream) {
0996: Stream stream = (Stream) obj;
0997: if (stream instanceof TwoWayStream) {
0998: Stream out = ((TwoWayStream) obj).getOutputStream();
0999: return outSynonymOf(out);
1000: }
1001: if (stream.isCharacterOutputStream())
1002: return stream;
1003: }
1004: signal(new TypeError(obj, "character output stream"));
1005: // Not reached.
1006: return null;
1007: }
1008:
1009: public static final Readtable checkReadtable(LispObject obj)
1010: throws ConditionThrowable {
1011: if (obj == null)
1012: throw new NullPointerException();
1013: try {
1014: return (Readtable) obj;
1015: } catch (ClassCastException e) {
1016: signal(new TypeError(obj, Symbol.READTABLE));
1017: // Not reached.
1018: return null;
1019: }
1020: }
1021:
1022: public static final Environment checkEnvironment(LispObject obj)
1023: throws ConditionThrowable {
1024: if (obj == null)
1025: throw new NullPointerException();
1026: try {
1027: return (Environment) obj;
1028: } catch (ClassCastException e) {
1029: signal(new TypeError(obj, "environment"));
1030: // Not reached.
1031: return null;
1032: }
1033: }
1034:
1035: public static final void checkBounds(int start, int end, int length)
1036: throws ConditionThrowable {
1037: if (start < 0 || end < 0 || start > end || end > length) {
1038: StringBuffer sb = new StringBuffer("The bounding indices ");
1039: sb.append(start);
1040: sb.append(" and ");
1041: sb.append(end);
1042: sb.append(" are bad for a sequence of length ");
1043: sb.append(length);
1044: sb.append('.');
1045: signal(new TypeError(sb.toString()));
1046: }
1047: }
1048:
1049: public static final LispObject coerceToFunction(LispObject obj)
1050: throws ConditionThrowable {
1051: if (obj instanceof Function)
1052: return obj;
1053: if (obj instanceof GenericFunction)
1054: return obj;
1055: if (obj instanceof Symbol) {
1056: LispObject fun = obj.getSymbolFunction();
1057: if (fun instanceof Function)
1058: return (Function) fun;
1059: } else if (obj instanceof Cons && obj.car() == Symbol.LAMBDA)
1060: return new Closure(obj.cadr(), obj.cddr(),
1061: new Environment());
1062: signal(new UndefinedFunction(obj));
1063: // Not reached.
1064: return null;
1065: }
1066:
1067: public static final Functional coerceToFunctional(LispObject obj)
1068: throws ConditionThrowable {
1069: if (obj instanceof Functional)
1070: return (Functional) obj;
1071: if (obj instanceof Symbol) {
1072: LispObject fun = obj.getSymbolFunction();
1073: if (fun instanceof Functional)
1074: return (Functional) fun;
1075: } else if (obj instanceof Cons && obj.car() == Symbol.LAMBDA)
1076: return new Closure(obj.cadr(), obj.cddr(),
1077: new Environment());
1078: signal(new UndefinedFunction(obj));
1079: // Not reached.
1080: return null;
1081: }
1082:
1083: // Returns package or throws exception.
1084: public static final Package coerceToPackage(LispObject obj)
1085: throws ConditionThrowable {
1086: if (obj instanceof Package)
1087: return (Package) obj;
1088: Package pkg = Packages.findPackage(javaString(obj));
1089: if (pkg != null)
1090: return pkg;
1091: signal(new PackageError(obj.writeToString()
1092: + " is not the name of a package."));
1093: // Not reached.
1094: return null;
1095: }
1096:
1097: public static final boolean memq(LispObject item, LispObject listArg)
1098: throws ConditionThrowable {
1099: LispObject list = listArg;
1100: while (list instanceof Cons) {
1101: if (item == list.car())
1102: return true;
1103: list = list.cdr();
1104: }
1105: if (list != NIL)
1106: signal(new TypeError(String.valueOf(listArg)
1107: + " is not a proper list."));
1108: return false;
1109: }
1110:
1111: public static final boolean memql(LispObject item,
1112: LispObject listArg) throws ConditionThrowable {
1113: LispObject list = listArg;
1114: while (list instanceof Cons) {
1115: if (item.eql(list.car()))
1116: return true;
1117: list = list.cdr();
1118: }
1119: if (list != NIL)
1120: signal(new TypeError(String.valueOf(listArg)
1121: + " is not a proper list."));
1122: return false;
1123: }
1124:
1125: // Property lists.
1126: public static final LispObject getf(LispObject plist,
1127: LispObject indicator, LispObject defaultValue)
1128: throws ConditionThrowable {
1129: LispObject list = plist;
1130: while (list != NIL) {
1131: if (list.car() == indicator)
1132: return list.cadr();
1133: if (list.cdr() instanceof Cons)
1134: list = list.cddr();
1135: else
1136: return signal(new TypeError("Malformed property list: "
1137: + plist + "."));
1138: }
1139: return defaultValue;
1140: }
1141:
1142: public static final LispObject get(Symbol symbol,
1143: LispObject indicator, LispObject defaultValue)
1144: throws ConditionThrowable {
1145: LispObject list = symbol.getPropertyList();
1146: while (list != NIL) {
1147: if (list.car() == indicator)
1148: return list.cadr();
1149: list = list.cddr();
1150: }
1151: return defaultValue;
1152: }
1153:
1154: // Returns null if there is no property with the specified indicator.
1155: public static final LispObject get(Symbol symbol,
1156: LispObject indicator) throws ConditionThrowable {
1157: LispObject list = symbol.getPropertyList();
1158: while (list != NIL) {
1159: if (list.car() == indicator)
1160: return list.cadr();
1161: list = list.cddr();
1162: }
1163: return null;
1164: }
1165:
1166: public static final LispObject put(Symbol symbol,
1167: LispObject indicator, LispObject value)
1168: throws ConditionThrowable {
1169: LispObject list = symbol.getPropertyList();
1170: while (list != NIL) {
1171: if (list.car() == indicator) {
1172: // Found it!
1173: LispObject rest = list.cdr();
1174: rest.setCar(value);
1175: return value;
1176: }
1177: list = list.cddr();
1178: }
1179: // Not found.
1180: symbol.setPropertyList(new Cons(indicator, new Cons(value,
1181: symbol.getPropertyList())));
1182: return value;
1183: }
1184:
1185: public static final LispObject remprop(Symbol symbol,
1186: LispObject indicator) throws ConditionThrowable {
1187: LispObject list = checkList(symbol.getPropertyList());
1188: LispObject prev = null;
1189: while (list != NIL) {
1190: if (!(list.cdr() instanceof Cons))
1191: signal(new ProgramError(
1192: String.valueOf(symbol)
1193: + " has an odd number of items in its property list."));
1194: if (list.car() == indicator) {
1195: // Found it!
1196: if (prev != null)
1197: prev.setCdr(list.cddr());
1198: else
1199: symbol.setPropertyList(list.cddr());
1200: return T;
1201: }
1202: prev = list.cdr();
1203: list = list.cddr();
1204: }
1205: // Not found.
1206: return NIL;
1207: }
1208:
1209: public static final String format(LispObject formatControl,
1210: LispObject formatArguments) throws ConditionThrowable {
1211: final LispThread thread = LispThread.currentThread();
1212: String control = formatControl.getStringValue();
1213: LispObject[] args = formatArguments.copyToArray();
1214: StringBuffer sb = new StringBuffer();
1215: if (control != null) {
1216: final int limit = control.length();
1217: int j = 0;
1218: final int NEUTRAL = 0;
1219: final int TILDE = 1;
1220: int state = NEUTRAL;
1221: for (int i = 0; i < limit; i++) {
1222: char c = control.charAt(i);
1223: if (state == NEUTRAL) {
1224: if (c == '~')
1225: state = TILDE;
1226: else
1227: sb.append(c);
1228: } else if (state == TILDE) {
1229: if (c == 'A' || c == 'a') {
1230: if (j < args.length) {
1231: LispObject obj = args[j++];
1232: Environment oldDynEnv = thread
1233: .getDynamicEnvironment();
1234: thread.bindSpecial(_PRINT_ESCAPE_, NIL);
1235: thread.bindSpecial(_PRINT_READABLY_, NIL);
1236: sb.append(obj.writeToString());
1237: thread.setDynamicEnvironment(oldDynEnv);
1238: }
1239: } else if (c == 'S' || c == 's') {
1240: if (j < args.length) {
1241: LispObject obj = args[j++];
1242: Environment oldDynEnv = thread
1243: .getDynamicEnvironment();
1244: thread.bindSpecial(_PRINT_ESCAPE_, T);
1245: sb.append(obj.writeToString());
1246: thread.setDynamicEnvironment(oldDynEnv);
1247: }
1248: } else if (c == 'D' || c == 'd') {
1249: if (j < args.length) {
1250: LispObject obj = args[j++];
1251: Environment oldDynEnv = thread
1252: .getDynamicEnvironment();
1253: thread.bindSpecial(_PRINT_ESCAPE_, NIL);
1254: thread.bindSpecial(_PRINT_RADIX_, NIL);
1255: thread.bindSpecial(_PRINT_BASE_,
1256: new Fixnum(10));
1257: sb.append(obj.writeToString());
1258: thread.setDynamicEnvironment(oldDynEnv);
1259: }
1260: } else if (c == 'X' || c == 'x') {
1261: if (j < args.length) {
1262: LispObject obj = args[j++];
1263: Environment oldDynEnv = thread
1264: .getDynamicEnvironment();
1265: thread.bindSpecial(_PRINT_ESCAPE_, NIL);
1266: thread.bindSpecial(_PRINT_RADIX_, NIL);
1267: thread.bindSpecial(_PRINT_BASE_,
1268: new Fixnum(16));
1269: sb.append(obj.writeToString());
1270: thread.setDynamicEnvironment(oldDynEnv);
1271: }
1272: } else if (c == '%') {
1273: sb.append('\n');
1274: }
1275: state = NEUTRAL;
1276: } else {
1277: // There are no other valid states.
1278: Debug.assertTrue(false);
1279: }
1280: }
1281: }
1282: return sb.toString();
1283: }
1284:
1285: public static final String invert(String s) {
1286: // "When the readtable case is :INVERT, the case of all alphabetic
1287: // characters in single case symbol names is inverted. Mixed-case
1288: // symbol names are printed as is." (22.1.3.3.2)
1289: final int limit = s.length();
1290: final int LOWER = 1;
1291: final int UPPER = 2;
1292: int state = 0;
1293: for (int i = 0; i < limit; i++) {
1294: char c = s.charAt(i);
1295: if (Character.isUpperCase(c)) {
1296: if (state == LOWER)
1297: return s; // Mixed case.
1298: state = UPPER;
1299: }
1300: if (Character.isLowerCase(c)) {
1301: if (state == UPPER)
1302: return s; // Mixed case.
1303: state = LOWER;
1304: }
1305: }
1306: StringBuffer sb = new StringBuffer(limit);
1307: for (int i = 0; i < limit; i++) {
1308: char c = s.charAt(i);
1309: if (Character.isUpperCase(c))
1310: sb.append(Character.toLowerCase(c));
1311: else if (Character.isLowerCase(c))
1312: sb.append(Character.toUpperCase(c));
1313: else
1314: sb.append(c);
1315: }
1316: return sb.toString();
1317: }
1318:
1319: public static final Symbol intern(String name, Package pkg) {
1320: return pkg.intern(name);
1321: }
1322:
1323: // Used by jvm compiler.
1324: public static final Symbol internInPackage(String name,
1325: String packageName) throws ConditionThrowable {
1326: Package pkg = Packages.findPackage(packageName);
1327: if (pkg == null)
1328: signal(new LispError(packageName
1329: + " is not the name of a package."));
1330: return pkg.intern(name);
1331: }
1332:
1333: // The jvm compiler's object table.
1334: private static final Hashtable objectTable = new Hashtable();
1335:
1336: public static final LispObject recall(SimpleString key) {
1337: return (LispObject) objectTable.get(key.getStringValue());
1338: }
1339:
1340: public static final void forget(SimpleString key) {
1341: objectTable.remove(key.getStringValue());
1342: }
1343:
1344: public static final Primitive2 REMEMBER = new Primitive2(
1345: "remember", PACKAGE_SYS, false) {
1346: public LispObject execute(LispObject key, LispObject value)
1347: throws ConditionThrowable {
1348: objectTable.put(key.getStringValue(), value);
1349: return NIL;
1350: }
1351: };
1352:
1353: public static final Symbol export(String name, Package pkg) {
1354: Symbol symbol = pkg.intern(name);
1355: try {
1356: pkg.export(symbol); // FIXME Inefficient!
1357: } catch (ConditionThrowable t) {
1358: Debug.trace(t);
1359: }
1360: return symbol;
1361: }
1362:
1363: public static final Symbol internSpecial(String name, Package pkg,
1364: LispObject value) {
1365: Symbol symbol = pkg.intern(name);
1366: symbol.setSpecial(true);
1367: symbol.setSymbolValue(value);
1368: return symbol;
1369: }
1370:
1371: public static final Symbol internConstant(String name, Package pkg,
1372: LispObject value) {
1373: Symbol symbol = pkg.intern(name);
1374: symbol.setSpecial(true);
1375: symbol.setSymbolValue(value);
1376: symbol.setConstant(true);
1377: return symbol;
1378: }
1379:
1380: public static final Symbol exportSpecial(String name, Package pkg,
1381: LispObject value) {
1382: Symbol symbol = pkg.intern(name);
1383: try {
1384: pkg.export(symbol); // FIXME Inefficient!
1385: } catch (ConditionThrowable t) {
1386: Debug.trace(t);
1387: }
1388: symbol.setSpecial(true);
1389: symbol.setSymbolValue(value);
1390: return symbol;
1391: }
1392:
1393: public static final Symbol exportConstant(String name, Package pkg,
1394: LispObject value) {
1395: Symbol symbol = pkg.intern(name);
1396: try {
1397: pkg.export(symbol); // FIXME Inefficient!
1398: } catch (ConditionThrowable t) {
1399: Debug.trace(t);
1400: }
1401: symbol.setSpecial(true);
1402: symbol.setSymbolValue(value);
1403: symbol.setConstant(true);
1404: return symbol;
1405: }
1406:
1407: public static final Symbol _DEFAULT_PATHNAME_DEFAULTS_ = PACKAGE_CL
1408: .addExternalSymbol("*DEFAULT-PATHNAME-DEFAULTS*");
1409: static {
1410: String userDir = System.getProperty("user.dir");
1411: if (userDir != null && userDir.length() > 0) {
1412: if (userDir.charAt(userDir.length() - 1) != File.separatorChar)
1413: userDir = userDir.concat(File.separator);
1414: }
1415: // This string will be converted to a pathname when Pathname.java is loaded.
1416: _DEFAULT_PATHNAME_DEFAULTS_.setSymbolValue(new SimpleString(
1417: userDir));
1418: _DEFAULT_PATHNAME_DEFAULTS_.setSpecial(true);
1419: }
1420:
1421: public static final Symbol _PACKAGE_ = exportSpecial("*PACKAGE*",
1422: PACKAGE_CL, PACKAGE_CL_USER);
1423:
1424: public static final Package getCurrentPackage() {
1425: return (Package) _PACKAGE_.symbolValueNoThrow();
1426: }
1427:
1428: private static Stream stdin = new Stream(System.in,
1429: Symbol.CHARACTER, true);
1430:
1431: private static Stream stdout = new Stream(System.out,
1432: Symbol.CHARACTER, true);
1433:
1434: public static final Symbol _STANDARD_INPUT_ = exportSpecial(
1435: "*STANDARD-INPUT*", PACKAGE_CL, stdin);
1436:
1437: public static final Symbol _STANDARD_OUTPUT_ = exportSpecial(
1438: "*STANDARD-OUTPUT*", PACKAGE_CL, stdout);
1439:
1440: public static final Symbol _ERROR_OUTPUT_ = exportSpecial(
1441: "*ERROR-OUTPUT*", PACKAGE_CL, stdout);
1442:
1443: public static final Symbol _TRACE_OUTPUT_ = exportSpecial(
1444: "*TRACE-OUTPUT*", PACKAGE_CL, stdout);
1445:
1446: public static final Symbol _TERMINAL_IO_ = exportSpecial(
1447: "*TERMINAL-IO*", PACKAGE_CL, new TwoWayStream(stdin,
1448: stdout, true));
1449:
1450: public static final Symbol _QUERY_IO_ = exportSpecial("*QUERY-IO*",
1451: PACKAGE_CL, new TwoWayStream(stdin, stdout, true));
1452:
1453: public static final Symbol _DEBUG_IO_ = exportSpecial("*DEBUG-IO*",
1454: PACKAGE_CL, new TwoWayStream(stdin, stdout, true));
1455:
1456: public static final void resetIO(Stream in, Stream out) {
1457: stdin = in;
1458: stdout = out;
1459: _STANDARD_INPUT_.setSymbolValue(stdin);
1460: _STANDARD_OUTPUT_.setSymbolValue(stdout);
1461: _ERROR_OUTPUT_.setSymbolValue(stdout);
1462: _TRACE_OUTPUT_.setSymbolValue(stdout);
1463: _TERMINAL_IO_.setSymbolValue(new TwoWayStream(stdin, stdout,
1464: true));
1465: _QUERY_IO_
1466: .setSymbolValue(new TwoWayStream(stdin, stdout, true));
1467: _DEBUG_IO_
1468: .setSymbolValue(new TwoWayStream(stdin, stdout, true));
1469: }
1470:
1471: public static final void resetIO() {
1472: resetIO(new Stream(System.in, Symbol.CHARACTER, true),
1473: new Stream(System.out, Symbol.CHARACTER, true));
1474: }
1475:
1476: public static final TwoWayStream getTerminalIO() {
1477: return (TwoWayStream) _TERMINAL_IO_.symbolValueNoThrow();
1478: }
1479:
1480: public static final Stream getStandardInput() {
1481: return (Stream) _STANDARD_INPUT_.symbolValueNoThrow();
1482: }
1483:
1484: public static final Stream getStandardOutput()
1485: throws ConditionThrowable {
1486: return checkCharacterOutputStream(_STANDARD_OUTPUT_
1487: .symbolValue());
1488: }
1489:
1490: public static final Symbol _READTABLE_ = exportSpecial(
1491: "*READTABLE*", PACKAGE_CL, new Readtable());
1492:
1493: public static final Readtable currentReadtable()
1494: throws ConditionThrowable {
1495: return (Readtable) _READTABLE_.symbolValue();
1496: }
1497:
1498: public static final Readtable currentReadtable(LispThread thread)
1499: throws ConditionThrowable {
1500: return (Readtable) _READTABLE_.symbolValue(thread);
1501: }
1502:
1503: public static final Symbol _READ_SUPPRESS_ = exportSpecial(
1504: "*READ-SUPPRESS*", PACKAGE_CL, NIL);
1505:
1506: public static final Symbol _DEBUGGER_HOOK_ = exportSpecial(
1507: "*DEBUGGER-HOOK*", PACKAGE_CL, NIL);
1508:
1509: public static final Symbol MOST_POSITIVE_FIXNUM = exportConstant(
1510: "MOST-POSITIVE-FIXNUM", PACKAGE_CL, new Fixnum(
1511: Integer.MAX_VALUE));
1512:
1513: public static final Symbol MOST_NEGATIVE_FIXNUM = exportConstant(
1514: "MOST-NEGATIVE-FIXNUM", PACKAGE_CL, new Fixnum(
1515: Integer.MIN_VALUE));
1516:
1517: public static void exit() {
1518: Interpreter interpreter = Interpreter.getInstance();
1519: if (interpreter != null)
1520: interpreter.kill();
1521: }
1522:
1523: // ### t
1524: // We can't use exportConstant() here since we need to set T's value to
1525: // itself.
1526: public static final Symbol T = PACKAGE_CL.addExternalSymbol("T");
1527: static {
1528: T.setSpecial(true);
1529: T.setSymbolValue(T);
1530: T.setConstant(true);
1531: }
1532:
1533: // ### *read-eval*
1534: public static final Symbol _READ_EVAL_ = exportSpecial(
1535: "*READ-EVAL*", PACKAGE_CL, T);
1536:
1537: // ### *features*
1538: public static final Symbol _FEATURES_ = PACKAGE_CL
1539: .addExternalSymbol("*FEATURES*");
1540: static {
1541: _FEATURES_.setSpecial(true);
1542: String osName = System.getProperty("os.name");
1543: if (osName.startsWith("Linux")) {
1544: _FEATURES_.setSymbolValue(list6(Keyword.ARMEDBEAR,
1545: Keyword.ABCL, Keyword.COMMON_LISP, Keyword.ANSI_CL,
1546: Keyword.UNIX, Keyword.LINUX));
1547: } else if (osName.startsWith("Mac OS X")) {
1548: _FEATURES_.setSymbolValue(list6(Keyword.ARMEDBEAR,
1549: Keyword.ABCL, Keyword.COMMON_LISP, Keyword.ANSI_CL,
1550: Keyword.UNIX, Keyword.DARWIN));
1551: } else if (osName.startsWith("Windows")) {
1552: _FEATURES_.setSymbolValue(list5(Keyword.ARMEDBEAR,
1553: Keyword.ABCL, Keyword.COMMON_LISP, Keyword.ANSI_CL,
1554: Keyword.WINDOWS));
1555: } else {
1556: _FEATURES_
1557: .setSymbolValue(list4(Keyword.ARMEDBEAR,
1558: Keyword.ABCL, Keyword.COMMON_LISP,
1559: Keyword.ANSI_CL));
1560: }
1561: }
1562:
1563: // ### *modules*
1564: public static final Symbol _MODULES_ = exportSpecial("*MODULES*",
1565: PACKAGE_CL, NIL);
1566:
1567: // ### *load-verbose*
1568: public static final Symbol _LOAD_VERBOSE_ = exportSpecial(
1569: "*LOAD-VERBOSE*", PACKAGE_CL, NIL);
1570:
1571: // ### *load-print*
1572: public static final Symbol _LOAD_PRINT_ = exportSpecial(
1573: "*LOAD-PRINT*", PACKAGE_CL, NIL);
1574:
1575: // ### *load-pathname*
1576: public static final Symbol _LOAD_PATHNAME_ = exportSpecial(
1577: "*LOAD-PATHNAME*", PACKAGE_CL, NIL);
1578:
1579: // ### *load-truename*
1580: public static final Symbol _LOAD_TRUENAME_ = exportSpecial(
1581: "*LOAD-TRUENAME*", PACKAGE_CL, NIL);
1582:
1583: // ### *load-depth*
1584: // internal symbol
1585: public static final Symbol _LOAD_DEPTH_ = internSpecial(
1586: "*LOAD-DEPTH*", PACKAGE_SYS, new Fixnum(0));
1587:
1588: // ### *load-stream*
1589: // internal symbol
1590: public static final Symbol _LOAD_STREAM_ = internSpecial(
1591: "*LOAD-STREAM*", PACKAGE_SYS, NIL);
1592:
1593: // ### *autoload-verbose*
1594: // internal symbol
1595: public static final Symbol _AUTOLOAD_VERBOSE_ = exportSpecial(
1596: "*AUTOLOAD-VERBOSE*", PACKAGE_EXT, NIL);
1597:
1598: // ### *compile-verbose*
1599: public static final Symbol _COMPILE_VERBOSE_ = exportSpecial(
1600: "*COMPILE-VERBOSE*", PACKAGE_CL, NIL);
1601:
1602: // ### *compile-print*
1603: public static final Symbol _COMPILE_PRINT_ = exportSpecial(
1604: "*COMPILE-PRINT*", PACKAGE_CL, NIL);
1605:
1606: // ### *compile-file-pathname*
1607: public static final Symbol _COMPILE_FILE_PATHNAME_ = exportSpecial(
1608: "*COMPILE-FILE-PATHNAME*", PACKAGE_CL, NIL);
1609:
1610: // ### *compile-file-truename*
1611: public static final Symbol _COMPILE_FILE_TRUENAME_ = exportSpecial(
1612: "*COMPILE-FILE-TRUENAME*", PACKAGE_CL, NIL);
1613:
1614: // ### *compile-file-type*
1615: public static final String COMPILE_FILE_TYPE = "abcl";
1616: public static final Symbol _COMPILE_FILE_TYPE_ = internConstant(
1617: "*COMPILE-FILE-TYPE*", PACKAGE_SYS, new SimpleString(
1618: COMPILE_FILE_TYPE));
1619:
1620: // ### *macroexpand-hook*
1621: public static final Symbol _MACROEXPAND_HOOK_ = exportSpecial(
1622: "*MACROEXPAND-HOOK*", PACKAGE_CL, Symbol.FUNCALL);
1623:
1624: // ### array-dimension-limit
1625: public static final int ARRAY_DIMENSION_MAX = 0x1000000;
1626: public static final Symbol ARRAY_DIMENSION_LIMIT = exportConstant(
1627: "ARRAY-DIMENSION-LIMIT", PACKAGE_CL, new Fixnum(
1628: ARRAY_DIMENSION_MAX));
1629:
1630: // ### char-code-limit
1631: // "The upper exclusive bound on the value returned by the function CHAR-CODE."
1632: public static final int CHAR_MAX = 256;
1633: public static final Symbol CHAR_CODE_LIMIT = exportConstant(
1634: "CHAR-CODE-LIMIT", PACKAGE_CL, new Fixnum(CHAR_MAX));
1635:
1636: // ### *read-base*
1637: public static final Symbol _READ_BASE_ = exportSpecial(
1638: "*READ-BASE*", PACKAGE_CL, new Fixnum(10));
1639:
1640: // ### *read-default-float-format*
1641: public static final Symbol _READ_DEFAULT_FLOAT_FORMAT_ = exportSpecial(
1642: "*READ-DEFAULT-FLOAT-FORMAT*", PACKAGE_CL,
1643: Symbol.DOUBLE_FLOAT);
1644:
1645: // Printer control variables.
1646: public static final Symbol _PRINT_ARRAY_ = exportSpecial(
1647: "*PRINT-ARRAY*", PACKAGE_CL, T);
1648:
1649: public static final Symbol _PRINT_BASE_ = exportSpecial(
1650: "*PRINT-BASE*", PACKAGE_CL, new Fixnum(10));
1651:
1652: public static final Symbol _PRINT_CASE_ = exportSpecial(
1653: "*PRINT-CASE*", PACKAGE_CL, Keyword.UPCASE);
1654:
1655: public static final Symbol _PRINT_CIRCLE_ = exportSpecial(
1656: "*PRINT-CIRCLE*", PACKAGE_CL, NIL);
1657:
1658: public static final Symbol _PRINT_ESCAPE_ = exportSpecial(
1659: "*PRINT-ESCAPE*", PACKAGE_CL, T);
1660:
1661: public static final Symbol _PRINT_GENSYM_ = exportSpecial(
1662: "*PRINT-GENSYM*", PACKAGE_CL, T);
1663:
1664: public static final Symbol _PRINT_LENGTH_ = exportSpecial(
1665: "*PRINT-LENGTH*", PACKAGE_CL, NIL);
1666:
1667: public static final Symbol _PRINT_LEVEL_ = exportSpecial(
1668: "*PRINT-LEVEL*", PACKAGE_CL, NIL);
1669:
1670: public static final Symbol _PRINT_LINES_ = exportSpecial(
1671: "*PRINT-LINES*", PACKAGE_CL, NIL);
1672:
1673: public static final Symbol _PRINT_MISER_WIDTH_ = exportSpecial(
1674: "*PRINT-MISER-WIDTH*", PACKAGE_CL, NIL);
1675:
1676: public static final Symbol _PRINT_PPRINT_DISPATCH_ = exportSpecial(
1677: "*PRINT-PPRINT-DISPATCH*", PACKAGE_CL, T);
1678:
1679: public static final Symbol _PRINT_PRETTY_ = exportSpecial(
1680: "*PRINT-PRETTY*", PACKAGE_CL, NIL);
1681:
1682: public static final Symbol _PRINT_RADIX_ = exportSpecial(
1683: "*PRINT-RADIX*", PACKAGE_CL, NIL);
1684:
1685: public static final Symbol _PRINT_READABLY_ = exportSpecial(
1686: "*PRINT-READABLY*", PACKAGE_CL, NIL);
1687:
1688: public static final Symbol _PRINT_RIGHT_MARGIN_ = exportSpecial(
1689: "*PRINT-RIGHT-MARGIN*", PACKAGE_CL, NIL);
1690:
1691: public static final Symbol _PRINT_FASL_ = internConstant(
1692: "*PRINT-FASL*", PACKAGE_SYS, NIL);
1693:
1694: public static final Symbol _RANDOM_STATE_ = exportSpecial(
1695: "*RANDOM-STATE*", PACKAGE_CL, new RandomState());
1696:
1697: public static final Symbol STAR = exportSpecial("*", PACKAGE_CL,
1698: NIL);
1699: public static final Symbol STAR_STAR = exportSpecial("**",
1700: PACKAGE_CL, NIL);
1701: public static final Symbol STAR_STAR_STAR = exportSpecial("***",
1702: PACKAGE_CL, NIL);
1703:
1704: public static final Symbol MINUS = exportSpecial("-", PACKAGE_CL,
1705: NIL);
1706:
1707: public static final Symbol PLUS = exportSpecial("+", PACKAGE_CL,
1708: NIL);
1709: public static final Symbol PLUS_PLUS = exportSpecial("++",
1710: PACKAGE_CL, NIL);
1711: public static final Symbol PLUS_PLUS_PLUS = exportSpecial("+++",
1712: PACKAGE_CL, NIL);
1713:
1714: public static final Symbol SLASH = exportSpecial("/", PACKAGE_CL,
1715: NIL);
1716: public static final Symbol SLASH_SLASH = exportSpecial("//",
1717: PACKAGE_CL, NIL);
1718: public static final Symbol SLASH_SLASH_SLASH = exportSpecial("///",
1719: PACKAGE_CL, NIL);
1720:
1721: public static final Symbol PI = exportConstant("PI", PACKAGE_CL,
1722: LispFloat.PI);
1723:
1724: public static final Symbol SHORT_FLOAT_EPSILON = exportConstant(
1725: "SHORT-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1726: (double) 1.1102230246251568E-16));
1727:
1728: public static final Symbol SINGLE_FLOAT_EPSILON = exportConstant(
1729: "SINGLE-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1730: (double) 1.1102230246251568E-16));
1731:
1732: public static final Symbol DOUBLE_FLOAT_EPSILON = exportConstant(
1733: "DOUBLE-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1734: (double) 1.1102230246251568E-16));
1735:
1736: public static final Symbol LONG_FLOAT_EPSILON = exportConstant(
1737: "LONG-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1738: (double) 1.1102230246251568E-16));
1739:
1740: public static final Symbol SHORT_FLOAT_NEGATIVE_EPSILON = exportConstant(
1741: "SHORT-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1742: (double) 5.551115123125784E-17));
1743:
1744: public static final Symbol SINGLE_FLOAT_NEGATIVE_EPSILON = exportConstant(
1745: "SINGLE-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1746: (double) 5.551115123125784E-17));
1747:
1748: public static final Symbol DOUBLE_FLOAT_NEGATIVE_EPSILON = exportConstant(
1749: "DOUBLE-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1750: (double) 5.551115123125784E-17));
1751:
1752: public static final Symbol LONG_FLOAT_NEGATIVE_EPSILON = exportConstant(
1753: "LONG-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1754: (double) 5.551115123125784E-17));
1755:
1756: public static final Symbol MOST_POSITIVE_SHORT_FLOAT = exportConstant(
1757: "MOST-POSITIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1758: Double.MAX_VALUE));
1759:
1760: public static final Symbol MOST_POSITIVE_SINGLE_FLOAT = exportConstant(
1761: "MOST-POSITIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1762: Double.MAX_VALUE));
1763:
1764: public static final Symbol MOST_POSITIVE_DOUBLE_FLOAT = exportConstant(
1765: "MOST-POSITIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1766: Double.MAX_VALUE));
1767:
1768: public static final Symbol MOST_POSITIVE_LONG_FLOAT = exportConstant(
1769: "MOST-POSITIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1770: Double.MAX_VALUE));
1771:
1772: public static final Symbol LEAST_POSITIVE_SHORT_FLOAT = exportConstant(
1773: "LEAST-POSITIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1774: Double.MIN_VALUE));
1775:
1776: public static final Symbol LEAST_POSITIVE_SINGLE_FLOAT = exportConstant(
1777: "LEAST-POSITIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1778: Double.MIN_VALUE));
1779:
1780: public static final Symbol LEAST_POSITIVE_DOUBLE_FLOAT = exportConstant(
1781: "LEAST-POSITIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1782: Double.MIN_VALUE));
1783:
1784: public static final Symbol LEAST_POSITIVE_LONG_FLOAT = exportConstant(
1785: "LEAST-POSITIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1786: Double.MIN_VALUE));
1787:
1788: public static final Symbol LEAST_POSITIVE_NORMALIZED_SHORT_FLOAT = exportConstant(
1789: "LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT", PACKAGE_CL,
1790: new LispFloat(Double.MIN_VALUE));
1791:
1792: public static final Symbol LEAST_POSITIVE_NORMALIZED_SINGLE_FLOAT = exportConstant(
1793: "LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT", PACKAGE_CL,
1794: new LispFloat(Double.MIN_VALUE));
1795:
1796: public static final Symbol LEAST_POSITIVE_NORMALIZED_DOUBLE_FLOAT = exportConstant(
1797: "LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT", PACKAGE_CL,
1798: new LispFloat(Double.MIN_VALUE));
1799:
1800: public static final Symbol LEAST_POSITIVE_NORMALIZED_LONG_FLOAT = exportConstant(
1801: "LEAST-POSITIVE-NORMALIZED-LONG-FLOAT", PACKAGE_CL,
1802: new LispFloat(Double.MIN_VALUE));
1803:
1804: public static final Symbol MOST_NEGATIVE_SHORT_FLOAT = exportConstant(
1805: "MOST-NEGATIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1806: -Double.MAX_VALUE));
1807:
1808: public static final Symbol MOST_NEGATIVE_SINGLE_FLOAT = exportConstant(
1809: "MOST-NEGATIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1810: -Double.MAX_VALUE));
1811:
1812: public static final Symbol MOST_NEGATIVE_DOUBLE_FLOAT = exportConstant(
1813: "MOST-NEGATIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1814: -Double.MAX_VALUE));
1815:
1816: public static final Symbol MOST_NEGATIVE_LONG_FLOAT = exportConstant(
1817: "MOST-NEGATIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1818: -Double.MAX_VALUE));
1819:
1820: public static final Symbol LEAST_NEGATIVE_SHORT_FLOAT = exportConstant(
1821: "LEAST-NEGATIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1822: -Double.MIN_VALUE));
1823:
1824: public static final Symbol LEAST_NEGATIVE_SINGLE_FLOAT = exportConstant(
1825: "LEAST-NEGATIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1826: -Double.MIN_VALUE));
1827:
1828: public static final Symbol LEAST_NEGATIVE_DOUBLE_FLOAT = exportConstant(
1829: "LEAST-NEGATIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1830: -Double.MIN_VALUE));
1831:
1832: public static final Symbol LEAST_NEGATIVE_LONG_FLOAT = exportConstant(
1833: "LEAST-NEGATIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1834: -Double.MIN_VALUE));
1835:
1836: public static final Symbol LEAST_NEGATIVE_NORMALIZED_SHORT_FLOAT = exportConstant(
1837: "LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT", PACKAGE_CL,
1838: new LispFloat(-Double.MIN_VALUE));
1839:
1840: public static final Symbol LEAST_NEGATIVE_NORMALIZED_SINGLE_FLOAT = exportConstant(
1841: "LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT", PACKAGE_CL,
1842: new LispFloat(-Double.MIN_VALUE));
1843:
1844: public static final Symbol LEAST_NEGATIVE_NORMALIZED_DOUBLE_FLOAT = exportConstant(
1845: "LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT", PACKAGE_CL,
1846: new LispFloat(-Double.MIN_VALUE));
1847:
1848: public static final Symbol LEAST_NEGATIVE_NORMALIZED_LONG_FLOAT = exportConstant(
1849: "LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT", PACKAGE_CL,
1850: new LispFloat(-Double.MIN_VALUE));
1851:
1852: public static final Symbol BOOLE_CLR = exportConstant("BOOLE-CLR",
1853: PACKAGE_CL, Fixnum.ZERO);
1854:
1855: public static final Symbol BOOLE_SET = exportConstant("BOOLE-SET",
1856: PACKAGE_CL, Fixnum.ONE);
1857:
1858: public static final Symbol BOOLE_1 = exportConstant("BOOLE-1",
1859: PACKAGE_CL, Fixnum.TWO);
1860:
1861: public static final Symbol BOOLE_2 = exportConstant("BOOLE-2",
1862: PACKAGE_CL, new Fixnum(3));
1863:
1864: public static final Symbol BOOLE_C1 = exportConstant("BOOLE-C1",
1865: PACKAGE_CL, new Fixnum(4));
1866:
1867: public static final Symbol BOOLE_C2 = exportConstant("BOOLE-C2",
1868: PACKAGE_CL, new Fixnum(5));
1869:
1870: public static final Symbol BOOLE_AND = exportConstant("BOOLE-AND",
1871: PACKAGE_CL, new Fixnum(6));
1872:
1873: public static final Symbol BOOLE_IOR = exportConstant("BOOLE-IOR",
1874: PACKAGE_CL, new Fixnum(7));
1875:
1876: public static final Symbol BOOLE_XOR = exportConstant("BOOLE-XOR",
1877: PACKAGE_CL, new Fixnum(8));
1878:
1879: public static final Symbol BOOLE_EQV = exportConstant("BOOLE-EQV",
1880: PACKAGE_CL, new Fixnum(9));
1881:
1882: public static final Symbol BOOLE_NAND = exportConstant(
1883: "BOOLE-NAND", PACKAGE_CL, new Fixnum(10));
1884:
1885: public static final Symbol BOOLE_NOR = exportConstant("BOOLE-NOR",
1886: PACKAGE_CL, new Fixnum(11));
1887:
1888: public static final Symbol BOOLE_ANDC1 = exportConstant(
1889: "BOOLE-ANDC1", PACKAGE_CL, new Fixnum(12));
1890:
1891: public static final Symbol BOOLE_ANDC2 = exportConstant(
1892: "BOOLE-ANDC2", PACKAGE_CL, new Fixnum(13));
1893:
1894: public static final Symbol BOOLE_ORC1 = exportConstant(
1895: "BOOLE-ORC1", PACKAGE_CL, new Fixnum(14));
1896:
1897: public static final Symbol BOOLE_ORC2 = exportConstant(
1898: "BOOLE-ORC2", PACKAGE_CL, new Fixnum(15));
1899:
1900: // ### *saved-backtrace*
1901: public static final Symbol _SAVED_BACKTRACE_ = exportSpecial(
1902: "*SAVED-BACKTRACE*", PACKAGE_EXT, NIL);
1903:
1904: // ### *speed* compiler policy
1905: public static final Symbol _SPEED_ = internSpecial("*SPEED*",
1906: PACKAGE_JVM, Fixnum.ONE);
1907:
1908: // ### *safety* compiler policy
1909: public static final Symbol _SAFETY_ = internSpecial("*SAFETY*",
1910: PACKAGE_JVM, Fixnum.ONE);
1911:
1912: // ### *debug* compiler policy
1913: public static final Symbol _DEBUG_ = internSpecial("*DEBUG*",
1914: PACKAGE_JVM, Fixnum.ONE);
1915:
1916: public static final LispObject UNBOUND = new LispObject() {
1917: public LispObject getDescription() {
1918: return new SimpleString("..unbound..");
1919: }
1920: };
1921:
1922: public static final Symbol _KEYWORD_PACKAGE_ = exportConstant(
1923: "*KEYWORD-PACKAGE*", PACKAGE_SYS, PACKAGE_KEYWORD);
1924:
1925: // Initialized in function_info.java.
1926: public static EqualHashTable FUNCTION_TABLE;
1927:
1928: private static final void loadClass(String className) {
1929: try {
1930: Class.forName(className);
1931: } catch (ClassNotFoundException e) {
1932: e.printStackTrace();
1933: }
1934: }
1935:
1936: static {
1937: loadClass("org.armedbear.lisp.Primitives");
1938: loadClass("org.armedbear.lisp.SpecialOperators");
1939: loadClass("org.armedbear.lisp.Extensions");
1940: loadClass("org.armedbear.lisp.Java");
1941: loadClass("org.armedbear.lisp.CompiledFunction");
1942: loadClass("org.armedbear.lisp.Autoload");
1943: loadClass("org.armedbear.lisp.AutoloadMacro");
1944: loadClass("org.armedbear.lisp.cxr");
1945: loadClass("org.armedbear.lisp.Do");
1946: loadClass("org.armedbear.lisp.dolist");
1947: loadClass("org.armedbear.lisp.dotimes");
1948: loadClass("org.armedbear.lisp.Pathname");
1949: loadClass("org.armedbear.lisp.LispClass");
1950: loadClass("org.armedbear.lisp.BuiltInClass");
1951: loadClass("org.armedbear.lisp.StructureObject");
1952:
1953: loadClass("org.armedbear.lisp.ash");
1954:
1955: cold = false;
1956: }
1957: }
|