source: branches/0.15.x/abcl/src/org/armedbear/lisp/Lisp.java

Last change on this file was 11995, checked in by vvoutilainen, 16 years ago

Backport the packaging changes for macroexpand-all and compiler-let.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 83.0 KB
Line 
1/*
2 * Lisp.java
3 *
4 * Copyright (C) 2002-2007 Peter Graves <peter@armedbear.org>
5 * $Id: Lisp.java 11995 2009-06-06 14:15:00Z vvoutilainen $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import java.io.File;
37import java.io.FileInputStream;
38import java.io.IOException;
39import java.io.InputStream;
40import java.lang.reflect.Constructor;
41import java.math.BigInteger;
42import java.net.URL;
43import java.net.URLDecoder;
44import java.util.Hashtable;
45import java.util.zip.ZipEntry;
46import java.util.zip.ZipFile;
47
48public abstract class Lisp
49{
50  public static final boolean debug = true;
51
52  public static boolean cold = true;
53
54  public static boolean initialized;
55
56  // Packages.
57  public static final Package PACKAGE_CL =
58    Packages.createPackage("COMMON-LISP", 1024);
59  public static final Package PACKAGE_CL_USER =
60    Packages.createPackage("COMMON-LISP-USER", 1024);
61  public static final Package PACKAGE_KEYWORD =
62    Packages.createPackage("KEYWORD", 1024);
63  public static final Package PACKAGE_SYS =
64    Packages.createPackage("SYSTEM");
65  public static final Package PACKAGE_MOP =
66    Packages.createPackage("MOP");
67  public static final Package PACKAGE_TPL =
68    Packages.createPackage("TOP-LEVEL");
69  public static final Package PACKAGE_EXT =
70    Packages.createPackage("EXTENSIONS");
71  public static final Package PACKAGE_JVM =
72    Packages.createPackage("JVM");
73  public static final Package PACKAGE_LOOP =
74    Packages.createPackage("LOOP");
75  public static final Package PACKAGE_PROF =
76    Packages.createPackage("PROFILER");
77  public static final Package PACKAGE_JAVA =
78    Packages.createPackage("JAVA");
79  public static final Package PACKAGE_LISP =
80    Packages.createPackage("LISP");
81
82  // ### nil
83  public static final LispObject NIL = Nil.NIL;
84
85  // We need NIL before we can call usePackage().
86  static
87  {
88    try
89      {
90        PACKAGE_CL.addNickname("CL");
91        PACKAGE_CL_USER.addNickname("CL-USER");
92        PACKAGE_CL_USER.usePackage(PACKAGE_CL);
93        PACKAGE_CL_USER.usePackage(PACKAGE_EXT);
94        PACKAGE_CL_USER.usePackage(PACKAGE_JAVA);
95        PACKAGE_SYS.addNickname("SYS");
96        PACKAGE_SYS.usePackage(PACKAGE_CL);
97        PACKAGE_SYS.usePackage(PACKAGE_EXT);
98        PACKAGE_MOP.usePackage(PACKAGE_CL);
99        PACKAGE_MOP.usePackage(PACKAGE_EXT);
100        PACKAGE_MOP.usePackage(PACKAGE_SYS);
101        PACKAGE_TPL.addNickname("TPL");
102        PACKAGE_TPL.usePackage(PACKAGE_CL);
103        PACKAGE_TPL.usePackage(PACKAGE_EXT);
104        PACKAGE_EXT.addNickname("EXT");
105        PACKAGE_EXT.usePackage(PACKAGE_CL);
106        PACKAGE_JVM.usePackage(PACKAGE_CL);
107        PACKAGE_JVM.usePackage(PACKAGE_EXT);
108        PACKAGE_JVM.usePackage(PACKAGE_SYS);
109        PACKAGE_LOOP.usePackage(PACKAGE_CL);
110        PACKAGE_PROF.addNickname("PROF");
111        PACKAGE_PROF.usePackage(PACKAGE_CL);
112        PACKAGE_PROF.usePackage(PACKAGE_EXT);
113        PACKAGE_JAVA.usePackage(PACKAGE_CL);
114        PACKAGE_JAVA.usePackage(PACKAGE_EXT);
115        PACKAGE_LISP.usePackage(PACKAGE_CL);
116        PACKAGE_LISP.usePackage(PACKAGE_EXT);
117        PACKAGE_LISP.usePackage(PACKAGE_SYS);
118      }
119    catch (Throwable t)
120      {
121        t.printStackTrace();
122      }
123  }
124
125  // End-of-file marker.
126  public static final LispObject EOF = new LispObject();
127
128  public static boolean profiling;
129
130  public static boolean sampling;
131
132  public static volatile boolean sampleNow;
133
134  // args must not be null!
135  public static final LispObject funcall(LispObject fun, LispObject[] args,
136                                         LispThread thread)
137    throws ConditionThrowable
138  {
139    LispObject stack = thread.getStack();
140    thread.pushStackFrame(fun, args);
141    thread._values = null;
142    LispObject result;
143    if (profiling)
144      if (!sampling)
145        fun.incrementCallCount();
146    try
147      {
148        switch (args.length)
149          {
150          case 0:
151            result = fun.execute();
152            break;
153          case 1:
154            result = fun.execute(args[0]);
155            break;
156          case 2:
157            result = fun.execute(args[0], args[1]);
158            break;
159          case 3:
160            result = fun.execute(args[0], args[1], args[2]);
161            break;
162          case 4:
163            result = fun.execute(args[0], args[1], args[2], args[3]);
164            break;
165          case 5:
166            result = fun.execute(args[0], args[1], args[2], args[3],
167                                 args[4]);
168            break;
169          case 6:
170            result = fun.execute(args[0], args[1], args[2], args[3],
171                                 args[4], args[5]);
172            break;
173          case 7:
174            result = fun.execute(args[0], args[1], args[2], args[3],
175                                 args[4], args[5], args[6]);
176            break;
177          case 8:
178            result = fun.execute(args[0], args[1], args[2], args[3],
179                                 args[4], args[5], args[6], args[7]);
180            break;
181          default:
182            result = fun.execute(args);
183            break;
184          }
185      }
186    finally
187      {
188        thread.setStack(stack);
189      }
190    return result;
191  }
192
193  public static final LispObject macroexpand(LispObject form,
194                                             final Environment env,
195                                             final LispThread thread)
196    throws ConditionThrowable
197  {
198    LispObject expanded = NIL;
199    while (true)
200      {
201        form = macroexpand_1(form, env, thread);
202        LispObject[] values = thread._values;
203        if (values[1] == NIL)
204          {
205            values[1] = expanded;
206            return form;
207          }
208        expanded = T;
209      }
210  }
211
212  public static final LispObject macroexpand_1(final LispObject form,
213                                               final Environment env,
214                                               final LispThread thread)
215    throws ConditionThrowable
216  {
217    if (form instanceof Cons)
218      {
219        LispObject car = ((Cons)form).car;
220        if (car instanceof Symbol)
221          {
222            LispObject obj = env.lookupFunction(car);
223            if (obj instanceof Autoload)
224              {
225                Autoload autoload = (Autoload) obj;
226                autoload.load();
227                obj = car.getSymbolFunction();
228              }
229            if (obj instanceof SpecialOperator)
230              {
231                obj = get(car, Symbol.MACROEXPAND_MACRO, null);
232                if (obj instanceof Autoload)
233                  {
234                    Autoload autoload = (Autoload) obj;
235                    autoload.load();
236                    obj = get(car, Symbol.MACROEXPAND_MACRO, null);
237                  }
238              }
239            if (obj instanceof MacroObject)
240              {
241                LispObject expander = ((MacroObject)obj).expander;
242                if (profiling)
243                  if (!sampling)
244                    expander.incrementCallCount();
245                LispObject hook =
246                  coerceToFunction(Symbol.MACROEXPAND_HOOK.symbolValue(thread));
247                return thread.setValues(hook.execute(expander, form, env),
248                                        T);
249              }
250          }
251      }
252    else if (form instanceof Symbol)
253      {
254        Symbol symbol = (Symbol) form;
255        LispObject obj = null;
256        if (symbol.isSpecialVariable())
257          obj = thread.lookupSpecial(symbol);
258        else
259          obj = env.lookup(symbol);
260        if (obj == null)
261          obj = symbol.getSymbolValue();
262        if (obj instanceof SymbolMacro)
263          return thread.setValues(((SymbolMacro)obj).getExpansion(), T);
264      }
265    // Not a macro.
266    return thread.setValues(form, NIL);
267  }
268
269  // ### interactive-eval
270  private static final Primitive INTERACTIVE_EVAL =
271    new Primitive("interactive-eval", PACKAGE_SYS, true)
272    {
273      @Override
274      public LispObject execute(LispObject object) throws ConditionThrowable
275      {
276        final LispThread thread = LispThread.currentThread();
277        thread.setSpecialVariable(Symbol.MINUS, object);
278        LispObject result;
279        try
280          {
281            result = thread.execute(Symbol.EVAL.getSymbolFunction(), object);
282          }
283        catch (OutOfMemoryError e)
284          {
285            return error(new LispError("Out of memory."));
286          }
287        catch (StackOverflowError e)
288          {
289            thread.setSpecialVariable(_SAVED_BACKTRACE_,
290                                      thread.backtraceAsList(0));
291            return error(new StorageCondition("Stack overflow."));
292          }
293        catch (Go go)
294          {
295            throw go;
296          }
297        catch (Throw t)
298          {
299            return error(new ControlError("Attempt to throw to the nonexistent tag " +
300                                           t.tag.writeToString() + "."));
301          }
302        catch (Throwable t)
303          {
304            Debug.trace(t);
305            thread.setSpecialVariable(_SAVED_BACKTRACE_,
306                                      thread.backtraceAsList(0));
307            return error(new LispError("Caught " + t + "."));
308          }
309        Debug.assertTrue(result != null);
310        thread.setSpecialVariable(Symbol.STAR_STAR_STAR,
311                                  thread.safeSymbolValue(Symbol.STAR_STAR));
312        thread.setSpecialVariable(Symbol.STAR_STAR,
313                                  thread.safeSymbolValue(Symbol.STAR));
314        thread.setSpecialVariable(Symbol.STAR, result);
315        thread.setSpecialVariable(Symbol.PLUS_PLUS_PLUS,
316                                  thread.safeSymbolValue(Symbol.PLUS_PLUS));
317        thread.setSpecialVariable(Symbol.PLUS_PLUS,
318                                  thread.safeSymbolValue(Symbol.PLUS));
319        thread.setSpecialVariable(Symbol.PLUS,
320                                  thread.safeSymbolValue(Symbol.MINUS));
321        LispObject[] values = thread._values;
322        thread.setSpecialVariable(Symbol.SLASH_SLASH_SLASH,
323                                  thread.safeSymbolValue(Symbol.SLASH_SLASH));
324        thread.setSpecialVariable(Symbol.SLASH_SLASH,
325                                  thread.safeSymbolValue(Symbol.SLASH));
326        if (values != null)
327          {
328            LispObject slash = NIL;
329            for (int i = values.length; i-- > 0;)
330              slash = new Cons(values[i], slash);
331            thread.setSpecialVariable(Symbol.SLASH, slash);
332          }
333        else
334          thread.setSpecialVariable(Symbol.SLASH, new Cons(result));
335        return result;
336      }
337    };
338
339  public static final LispObject error(LispObject condition)
340    throws ConditionThrowable
341  {
342    return Symbol.ERROR.execute(condition);
343  }
344
345  public static final LispObject error(LispObject condition, LispObject message)
346    throws ConditionThrowable
347  {
348    return Symbol.ERROR.execute(condition, Keyword.FORMAT_CONTROL, message);
349  }
350
351  public static final LispObject type_error(LispObject datum,
352                                            LispObject expectedType)
353    throws ConditionThrowable
354  {
355    return error(new TypeError(datum, expectedType));
356  }
357
358  protected static volatile boolean interrupted;
359
360  public static synchronized final void setInterrupted(boolean b)
361  {
362    interrupted = b;
363  }
364
365  public static final void handleInterrupt() throws ConditionThrowable
366  {
367    setInterrupted(false);
368    Symbol.BREAK.getSymbolFunction().execute();
369    setInterrupted(false);
370  }
371
372  // Used by the compiler.
373  public static final LispObject loadTimeValue(LispObject obj)
374    throws ConditionThrowable
375  {
376    final LispThread thread = LispThread.currentThread();
377    if (Symbol.LOAD_TRUENAME.symbolValue(thread) != NIL)
378      return eval(obj, new Environment(), thread);
379    else
380      return NIL;
381  }
382
383  public static final LispObject eval(LispObject obj)
384    throws ConditionThrowable
385  {
386    return eval(obj, new Environment(), LispThread.currentThread());
387  }
388
389  public static final LispObject eval(final LispObject obj,
390                                      final Environment env,
391                                      final LispThread thread)
392    throws ConditionThrowable
393  {
394    thread._values = null;
395    if (interrupted)
396      handleInterrupt();
397    if (thread.isDestroyed())
398      throw new ThreadDestroyed();
399    if (obj instanceof Symbol)
400      {
401        LispObject result;
402        if (obj.isSpecialVariable())
403          {
404            if (obj.constantp())
405              return obj.getSymbolValue();
406            else
407              result = thread.lookupSpecial(obj);
408          }
409        else if (env.isDeclaredSpecial(obj))
410          result = thread.lookupSpecial(obj);
411        else
412          result = env.lookup(obj);
413        if (result == null)
414          {
415            result = obj.getSymbolValue();
416            if (result == null)
417              return error(new UnboundVariable(obj));
418          }
419        if (result instanceof SymbolMacro)
420          return eval(((SymbolMacro)result).getExpansion(), env, thread);
421        return result;
422      }
423    else if (obj instanceof Cons)
424      {
425        LispObject first = ((Cons)obj).car;
426        if (first instanceof Symbol)
427          {
428            LispObject fun = env.lookupFunction(first);
429            if (fun instanceof SpecialOperator)
430              {
431                if (profiling)
432                  if (!sampling)
433                    fun.incrementCallCount();
434                // Don't eval args!
435                return fun.execute(((Cons)obj).cdr, env);
436              }
437            if (fun instanceof MacroObject)
438              return eval(macroexpand(obj, env, thread), env, thread);
439            if (fun instanceof Autoload)
440              {
441                Autoload autoload = (Autoload) fun;
442                autoload.load();
443                return eval(obj, env, thread);
444              }
445            return evalCall(fun != null ? fun : first,
446                            ((Cons)obj).cdr, env, thread);
447          }
448        else
449          {
450            if (first.car() == Symbol.LAMBDA)
451              {
452                Closure closure = new Closure(first, env);
453                return evalCall(closure, ((Cons)obj).cdr, env, thread);
454              }
455            else
456              return error(new ProgramError("Illegal function object: " +
457                                             first.writeToString()));
458          }
459      }
460    else
461      return obj;
462  }
463
464  public static final int CALL_REGISTERS_MAX = 8;
465
466  // Also used in JProxy.java.
467  protected static final LispObject evalCall(LispObject function,
468                                             LispObject args,
469                                             Environment env,
470                                             LispThread thread)
471    throws ConditionThrowable
472  {
473    if (args == NIL)
474      return thread.execute(function);
475    LispObject first = eval(args.car(), env, thread);
476    args = ((Cons)args).cdr;
477    if (args == NIL)
478      {
479        thread._values = null;
480        return thread.execute(function, first);
481      }
482    LispObject second = eval(args.car(), env, thread);
483    args = ((Cons)args).cdr;
484    if (args == NIL)
485      {
486        thread._values = null;
487        return thread.execute(function, first, second);
488      }
489    LispObject third = eval(args.car(), env, thread);
490    args = ((Cons)args).cdr;
491    if (args == NIL)
492      {
493        thread._values = null;
494        return thread.execute(function, first, second, third);
495      }
496    LispObject fourth = eval(args.car(), env, thread);
497    args = ((Cons)args).cdr;
498    if (args == NIL)
499      {
500        thread._values = null;
501        return thread.execute(function, first, second, third, fourth);
502      }
503    LispObject fifth = eval(args.car(), env, thread);
504    args = ((Cons)args).cdr;
505    if (args == NIL)
506      {
507        thread._values = null;
508        return thread.execute(function, first, second, third, fourth, fifth);
509      }
510    LispObject sixth = eval(args.car(), env, thread);
511    args = ((Cons)args).cdr;
512    if (args == NIL)
513      {
514        thread._values = null;
515        return thread.execute(function, first, second, third, fourth, fifth,
516                              sixth);
517      }
518    LispObject seventh = eval(args.car(), env, thread);
519    args = ((Cons)args).cdr;
520    if (args == NIL)
521      {
522        thread._values = null;
523        return thread.execute(function, first, second, third, fourth, fifth,
524                              sixth, seventh);
525      }
526    LispObject eighth = eval(args.car(), env, thread);
527    args = ((Cons)args).cdr;
528    if (args == NIL)
529      {
530        thread._values = null;
531        return thread.execute(function, first, second, third, fourth, fifth,
532                              sixth, seventh, eighth);
533      }
534    // More than CALL_REGISTERS_MAX arguments.
535    final int length = args.length() + CALL_REGISTERS_MAX;
536    LispObject[] array = new LispObject[length];
537    array[0] = first;
538    array[1] = second;
539    array[2] = third;
540    array[3] = fourth;
541    array[4] = fifth;
542    array[5] = sixth;
543    array[6] = seventh;
544    array[7] = eighth;
545    for (int i = CALL_REGISTERS_MAX; i < length; i++)
546      {
547        array[i] = eval(args.car(), env, thread);
548        args = args.cdr();
549      }
550    thread._values = null;
551    return thread.execute(function, array);
552  }
553
554  public static final LispObject parseBody(LispObject body,
555                                           boolean documentationAllowed)
556    throws ConditionThrowable
557  {
558      LispObject decls = NIL;
559      LispObject doc = NIL;
560
561      while (body != NIL) {
562        LispObject form = body.car();
563        if (documentationAllowed && form instanceof AbstractString
564            && body.cdr() != NIL) {
565          doc = body.car();
566          documentationAllowed = false;
567        } else if (form instanceof Cons && form.car() == Symbol.DECLARE)
568          decls = new Cons(form, decls);
569        else
570          break;
571
572        body = body.cdr();
573      }
574      return list(body, decls.nreverse(), doc);
575  }
576
577  public static final LispObject parseSpecials(LispObject forms)
578    throws ConditionThrowable
579  {
580    LispObject specials = NIL;
581    while (forms != NIL) {
582      LispObject decls = forms.car();
583
584      Debug.assertTrue(decls instanceof Cons);
585      Debug.assertTrue(decls.car() == Symbol.DECLARE);
586      decls = decls.cdr();
587      while (decls != NIL) {
588        LispObject decl = decls.car();
589
590        if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) {
591            decl = decl.cdr();
592            while (decl != NIL) {
593              specials = new Cons(checkSymbol(decl.car()), specials);
594              decl = decl.cdr();
595            }
596        }
597
598        decls = decls.cdr();
599      }
600
601      forms = forms.cdr();
602    }
603
604    return specials;
605  }
606
607  public static final LispObject progn(LispObject body, Environment env,
608                                       LispThread thread)
609    throws ConditionThrowable
610  {
611    LispObject result = NIL;
612    while (body != NIL)
613      {
614        result = eval(body.car(), env, thread);
615        body = ((Cons)body).cdr;
616      }
617    return result;
618  }
619
620  // Environment wrappers.
621  private static final boolean isSpecial(Symbol sym, LispObject ownSpecials,
622                                         Environment env)
623    throws ConditionThrowable
624  {
625    if (ownSpecials != null)
626      {
627        if (sym.isSpecialVariable())
628          return true;
629        for (; ownSpecials != NIL; ownSpecials = ownSpecials.cdr())
630          {
631            if (sym == ownSpecials.car())
632              return true;
633          }
634      }
635    return false;
636  }
637
638  protected static final void bindArg(LispObject ownSpecials,
639                                      Symbol sym, LispObject value,
640                                      Environment env, LispThread thread)
641    throws ConditionThrowable
642  {
643    if (isSpecial(sym, ownSpecials, env)) {
644      env.declareSpecial(sym);
645      thread.bindSpecial(sym, value);
646    }
647    else
648      env.bind(sym, value);
649  }
650
651
652  public static final Cons list(LispObject obj1, LispObject... remaining)
653  {
654    Cons theList = null;
655    if (remaining.length > 0) {
656      theList = new Cons(remaining[remaining.length-1]);
657      for (int i = remaining.length - 2; i >= 0; i--)
658        theList = new Cons(remaining[i], theList);
659    }
660    return (theList == null) ? new Cons(obj1) : new Cons(obj1, theList);
661  }
662
663  @Deprecated
664  public static final Cons list1(LispObject obj1)
665  {
666    return new Cons(obj1);
667  }
668
669  @Deprecated
670  public static final Cons list2(LispObject obj1, LispObject obj2)
671  {
672    return new Cons(obj1, new Cons(obj2));
673  }
674
675  @Deprecated
676  public static final Cons list3(LispObject obj1, LispObject obj2,
677                                 LispObject obj3)
678  {
679    return new Cons(obj1, new Cons(obj2, new Cons(obj3)));
680  }
681
682  @Deprecated
683  public static final Cons list4(LispObject obj1, LispObject obj2,
684                                 LispObject obj3, LispObject obj4)
685  {
686    return new Cons(obj1,
687                    new Cons(obj2,
688                             new Cons(obj3,
689                                      new Cons(obj4))));
690  }
691
692  @Deprecated
693  public static final Cons list5(LispObject obj1, LispObject obj2,
694                                 LispObject obj3, LispObject obj4,
695                                 LispObject obj5)
696  {
697    return new Cons(obj1,
698                    new Cons(obj2,
699                             new Cons(obj3,
700                                      new Cons(obj4,
701                                               new Cons(obj5)))));
702  }
703
704  @Deprecated
705  public static final Cons list6(LispObject obj1, LispObject obj2,
706                                 LispObject obj3, LispObject obj4,
707                                 LispObject obj5, LispObject obj6)
708  {
709    return new Cons(obj1,
710                    new Cons(obj2,
711                             new Cons(obj3,
712                                      new Cons(obj4,
713                                               new Cons(obj5,
714                                                        new Cons(obj6))))));
715  }
716
717  @Deprecated
718  public static final Cons list7(LispObject obj1, LispObject obj2,
719                                 LispObject obj3, LispObject obj4,
720                                 LispObject obj5, LispObject obj6,
721                                 LispObject obj7)
722  {
723    return new Cons(obj1,
724                    new Cons(obj2,
725                             new Cons(obj3,
726                                      new Cons(obj4,
727                                               new Cons(obj5,
728                                                        new Cons(obj6,
729                                                                 new Cons(obj7)))))));
730  }
731
732  @Deprecated
733  public static final Cons list8(LispObject obj1, LispObject obj2,
734                                 LispObject obj3, LispObject obj4,
735                                 LispObject obj5, LispObject obj6,
736                                 LispObject obj7, LispObject obj8)
737  {
738    return new Cons(obj1,
739                    new Cons(obj2,
740                             new Cons(obj3,
741                                      new Cons(obj4,
742                                               new Cons(obj5,
743                                                        new Cons(obj6,
744                                                                 new Cons(obj7,
745                                                                          new Cons(obj8))))))));
746  }
747
748  @Deprecated
749  public static final Cons list9(LispObject obj1, LispObject obj2,
750                                 LispObject obj3, LispObject obj4,
751                                 LispObject obj5, LispObject obj6,
752                                 LispObject obj7, LispObject obj8,
753                                 LispObject obj9)
754  {
755    return new Cons(obj1,
756                    new Cons(obj2,
757                             new Cons(obj3,
758                                      new Cons(obj4,
759                                               new Cons(obj5,
760                                                        new Cons(obj6,
761                                                                 new Cons(obj7,
762                                                                          new Cons(obj8,
763                                                                                   new Cons(obj9)))))))));
764  }
765
766  // Used by the compiler.
767  public static final LispObject multipleValueList(LispObject result)
768    throws ConditionThrowable
769  {
770    LispThread thread = LispThread.currentThread();
771    LispObject[] values = thread._values;
772    if (values == null)
773      return new Cons(result);
774    thread._values = null;
775    LispObject list = NIL;
776    for (int i = values.length; i-- > 0;)
777      list = new Cons(values[i], list);
778    return list;
779  }
780
781  // Used by the compiler for MULTIPLE-VALUE-CALLs with a single values form.
782  public static final LispObject multipleValueCall1(LispObject result,
783                                                    LispObject function,
784                                                    LispThread thread)
785    throws ConditionThrowable
786  {
787    LispObject[] values = thread._values;
788    thread._values = null;
789    if (values == null)
790      return thread.execute(coerceToFunction(function), result);
791    else
792      return funcall(coerceToFunction(function), values, thread);
793  }
794
795  public static final void progvBindVars(LispObject symbols,
796                                         LispObject values,
797                                         LispThread thread)
798    throws ConditionThrowable
799  {
800    for (LispObject list = symbols; list != NIL; list = list.cdr())
801      {
802        Symbol symbol = checkSymbol(list.car());
803        LispObject value;
804        if (values != NIL)
805          {
806            value = values.car();
807            values = values.cdr();
808          }
809        else
810          {
811            // "If too few values are supplied, the remaining symbols are
812            // bound and then made to have no value."
813            value = null;
814          }
815        thread.bindSpecial(symbol, value);
816      }
817  }
818
819  public static Symbol checkSymbol(LispObject obj) throws ConditionThrowable
820  {             
821          if (obj instanceof Symbol)     
822                  return (Symbol) obj;         
823          return (Symbol)// Not reached.       
824              type_error(obj, Symbol.SYMBOL);
825  }
826
827  public static final LispObject checkList(LispObject obj)
828    throws ConditionThrowable
829  {
830    if (obj.listp())
831      return obj;
832    return type_error(obj, Symbol.LIST);
833  }
834
835  public static final AbstractArray checkArray(LispObject obj)
836    throws ConditionThrowable
837  {
838          if (obj instanceof AbstractArray)       
839                  return (AbstractArray) obj;         
840          return (AbstractArray)// Not reached.       
841        type_error(obj, Symbol.ARRAY);
842  }
843
844  public static final AbstractVector checkVector(LispObject obj)
845    throws ConditionThrowable
846  {
847          if (obj instanceof AbstractVector)     
848                  return (AbstractVector) obj;         
849          return (AbstractVector)// Not reached.       
850        type_error(obj, Symbol.VECTOR);
851  }
852
853  static
854  {
855    // ### *gensym-counter*
856    Symbol.GENSYM_COUNTER.initializeSpecial(Fixnum.ZERO);
857  }
858
859  public static final Symbol gensym(LispThread thread)
860    throws ConditionThrowable
861  {
862    return gensym("G", thread);
863  }
864
865  public static final Symbol gensym(String prefix, LispThread thread)
866    throws ConditionThrowable
867  {
868    FastStringBuffer sb = new FastStringBuffer(prefix);
869    SpecialBinding binding = thread.getSpecialBinding(Symbol.GENSYM_COUNTER);
870    final LispObject oldValue;
871    if (binding != null)
872      oldValue = binding.value;
873    else
874      oldValue = Symbol.GENSYM_COUNTER.getSymbolValue();
875    // Decimal representation.
876    if (oldValue instanceof Fixnum)
877      sb.append(((Fixnum)oldValue).value);
878    else if (oldValue instanceof Bignum)
879      sb.append(((Bignum)oldValue).value.toString());
880    else
881      {
882        // Restore sanity.
883        if (binding != null)
884          binding.value = Fixnum.ZERO;
885        else
886          Symbol.GENSYM_COUNTER.setSymbolValue(Fixnum.ZERO);
887        error(new TypeError("The value of *GENSYM-COUNTER* was not a nonnegative integer. Old value: " +
888                             oldValue.writeToString() + " New value: 0"));
889      }
890    if (binding != null)
891      binding.value = oldValue.incr();
892    else
893      Symbol.GENSYM_COUNTER.setSymbolValue(oldValue.incr());
894    return new Symbol(new SimpleString(sb));
895  }
896
897  public static final String javaString(LispObject arg)
898    throws ConditionThrowable
899  {
900    if (arg instanceof AbstractString)
901      return arg.getStringValue();
902    if (arg instanceof Symbol)
903      return ((Symbol)arg).getName();
904    if (arg instanceof LispCharacter)
905      return String.valueOf(new char[] {((LispCharacter)arg).value});
906    type_error(arg, list(Symbol.OR, Symbol.STRING, Symbol.SYMBOL,
907                               Symbol.CHARACTER));
908    // Not reached.
909    return null;
910  }
911
912  public static final LispObject number(long n)
913  {
914    if (n >= Integer.MIN_VALUE && n <= Integer.MAX_VALUE)
915      return Fixnum.getInstance((int)n);
916    else
917      return Bignum.getInstance(n);
918  }
919
920  private static final BigInteger INT_MIN = BigInteger.valueOf(Integer.MIN_VALUE);
921  private static final BigInteger INT_MAX = BigInteger.valueOf(Integer.MAX_VALUE);
922
923  public static final LispObject number(BigInteger numerator,
924                                        BigInteger denominator)
925    throws ConditionThrowable
926  {
927    if (denominator.signum() == 0)
928      error(new DivisionByZero());
929    if (denominator.signum() < 0)
930      {
931        numerator = numerator.negate();
932        denominator = denominator.negate();
933      }
934    BigInteger gcd = numerator.gcd(denominator);
935    if (!gcd.equals(BigInteger.ONE))
936      {
937        numerator = numerator.divide(gcd);
938        denominator = denominator.divide(gcd);
939      }
940    if (denominator.equals(BigInteger.ONE))
941      return number(numerator);
942    else
943      return new Ratio(numerator, denominator);
944  }
945
946  public static final LispObject number(BigInteger n)
947  {
948    if (n.compareTo(INT_MIN) >= 0 && n.compareTo(INT_MAX) <= 0)
949      return Fixnum.getInstance(n.intValue());
950    else
951      return Bignum.getInstance(n);
952  }
953
954  public static final int mod(int number, int divisor)
955    throws ConditionThrowable
956  {
957    final int r;
958    try
959      {
960        r = number % divisor;
961      }
962    catch (ArithmeticException e)
963      {
964        error(new ArithmeticError("Division by zero."));
965        // Not reached.
966        return 0;
967      }
968    if (r == 0)
969      return r;
970    if (divisor < 0)
971      {
972        if (number > 0)
973          return r + divisor;
974      }
975    else
976      {
977        if (number < 0)
978          return r + divisor;
979      }
980    return r;
981  }
982
983  // Adapted from SBCL.
984  public static final int mix(long x, long y)
985  {
986    long xy = x * 3 + y;
987    return (int) (536870911L & (441516657L ^ xy ^ (xy >> 5)));
988  }
989
990  // Used by the compiler.
991  public static final LispObject readObjectFromString(String s)
992  {
993    try
994      {
995        return new StringInputStream(s).faslRead(true, NIL, false,
996                                                 LispThread.currentThread());
997      }
998    catch (Throwable t)
999      {
1000        return null;
1001      }
1002  }
1003
1004  public static final LispObject loadCompiledFunction(final String namestring)
1005    throws ConditionThrowable
1006  {
1007    final LispThread thread = LispThread.currentThread();
1008    final boolean absolute = Utilities.isFilenameAbsolute(namestring);
1009    LispObject device = NIL;
1010    final Pathname defaultPathname;
1011    if (absolute)
1012      {
1013        defaultPathname =
1014          coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue(thread));
1015      }
1016    else
1017      {
1018        LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread);
1019        if (loadTruename instanceof Pathname)
1020          {
1021            defaultPathname = (Pathname) loadTruename;
1022            // We're loading a file.
1023            device = ((Pathname)loadTruename).getDevice();
1024          }
1025        else
1026          {
1027            defaultPathname =
1028              coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue(thread));
1029          }
1030      }
1031    if (device instanceof Pathname)
1032      {
1033        // We're loading a fasl from j.jar.
1034        URL url = Lisp.class.getResource(namestring);
1035        if (url != null)
1036          {
1037            try
1038              {
1039                String s = url.toString();
1040                String zipFileName;
1041                String entryName;
1042                if (s.startsWith("jar:file:"))
1043                  {
1044                    s = s.substring(9);
1045                    int index = s.lastIndexOf('!');
1046                    if (index >= 0)
1047                      {
1048                        zipFileName = s.substring(0, index);
1049                        entryName = s.substring(index + 1);
1050                        if (entryName.length() > 0 && entryName.charAt(0) == '/')
1051                          entryName = entryName.substring(1);
1052                        if (Utilities.isPlatformWindows)
1053                          {
1054                            // "/C:/Documents%20and%20Settings/peter/Desktop/j.jar"
1055                            if (zipFileName.length() > 0 && zipFileName.charAt(0) == '/')
1056                              zipFileName = zipFileName.substring(1);
1057                          }
1058                        zipFileName = URLDecoder.decode(zipFileName, "UTF-8");
1059                        ZipFile zipFile = new ZipFile(zipFileName);
1060                        try
1061                          {
1062                            ZipEntry entry = zipFile.getEntry(entryName);
1063                            if (entry != null)
1064                              {
1065                                long size = entry.getSize();
1066                                InputStream in = zipFile.getInputStream(entry);
1067                                LispObject obj = loadCompiledFunction(in, (int) size);
1068                                return obj != null ? obj : NIL;
1069                              }
1070                          }
1071                        finally
1072                          {
1073                            zipFile.close();
1074                          }
1075                      }
1076                  }
1077              }
1078            catch (VerifyError e)
1079              {
1080                return error(new LispError("Class verification failed: " +
1081                                            e.getMessage()));
1082              }
1083            catch (IOException e)
1084              {
1085                Debug.trace(e);
1086              }
1087            catch (Throwable t)
1088              {
1089                Debug.trace(t);
1090              }
1091          }
1092        return error(new LispError("Unable to load " + namestring));
1093      }
1094    Pathname pathname = new Pathname(namestring);
1095    final File file = Utilities.getFile(pathname, defaultPathname);
1096    if (file != null && file.isFile())
1097      {
1098        // The .cls file exists.
1099        try
1100          {
1101            LispObject obj = loadCompiledFunction(new FileInputStream(file),
1102                                                  (int) file.length());
1103            // FIXME close stream!
1104            if (obj != null)
1105              return obj;
1106          }
1107        catch (VerifyError e)
1108          {
1109            return error(new LispError("Class verification failed: " +
1110                                        e.getMessage()));
1111          }
1112        catch (Throwable t)
1113          {
1114            Debug.trace(t);
1115          }
1116        return error(new LispError("Unable to load " +
1117                                    pathname.writeToString()));
1118      }
1119    try
1120      {
1121        LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread);
1122        String zipFileName = ((Pathname)loadTruename).getNamestring();
1123        ZipFile zipFile = new ZipFile(zipFileName);
1124        try
1125          {
1126            ZipEntry entry = zipFile.getEntry(namestring);
1127            if (entry != null)
1128              {
1129                LispObject obj = loadCompiledFunction(zipFile.getInputStream(entry),
1130                                                      (int) entry.getSize());
1131                if (obj != null)
1132                  return obj;
1133                Debug.trace("Unable to load " + namestring);
1134                return error(new LispError("Unable to load " + namestring));
1135              }
1136          }
1137        finally
1138          {
1139            zipFile.close();
1140          }
1141      }
1142    catch (Throwable t)
1143      {
1144        Debug.trace(t);
1145      }
1146    return error(new FileError("File not found: " + namestring,
1147                                new Pathname(namestring)));
1148  }
1149
1150  private static final LispObject loadCompiledFunction(InputStream in, int size)
1151  {
1152    try
1153      {
1154        byte[] bytes = new byte[size];
1155        int bytesRemaining = size;
1156        int bytesRead = 0;
1157        while (bytesRemaining > 0)
1158          {
1159            int n = in.read(bytes, bytesRead, bytesRemaining);
1160            if (n < 0)
1161              break;
1162            bytesRead += n;
1163            bytesRemaining -= n;
1164          }
1165        in.close();
1166        if (bytesRemaining > 0)
1167          Debug.trace("bytesRemaining = " + bytesRemaining);
1168
1169        return loadCompiledFunction(bytes);
1170      }
1171    catch (Throwable t)
1172      {
1173        Debug.trace(t);
1174      }
1175    return null;
1176  }
1177
1178    public static final LispObject loadCompiledFunction(byte[] bytes) throws Throwable {
1179        Class c = (new JavaClassLoader()).loadClassFromByteArray(null, bytes, 0, bytes.length);
1180        if (c != null) {
1181            Class sc = c.getSuperclass();
1182            Constructor constructor = c.getConstructor((Class[])null);
1183            LispObject obj = (LispObject) constructor.newInstance((Object[])null);
1184            if (obj instanceof Function) {
1185              ((Function)obj).setClassBytes(bytes);
1186            }
1187            return obj;
1188        } else {
1189            return null;
1190        }
1191    }
1192
1193  public static final LispObject makeCompiledClosure(LispObject template,
1194                                                     ClosureBinding[] context)
1195    throws ConditionThrowable
1196  {
1197    return ((CompiledClosure)template).dup().setContext(context);
1198  }
1199
1200  public static final String safeWriteToString(LispObject obj)
1201  {
1202    try
1203      {
1204        return obj.writeToString();
1205      }
1206    catch (ConditionThrowable t)
1207      {
1208        return obj.toString();
1209      }
1210    catch (NullPointerException e)
1211      {
1212        Debug.trace(e);
1213        return "null";
1214      }
1215  }
1216
1217  public static final boolean isValidSetfFunctionName(LispObject obj)
1218  {
1219    if (obj instanceof Cons)
1220      {
1221        Cons cons = (Cons) obj;
1222        if (cons.car == Symbol.SETF && cons.cdr instanceof Cons)
1223          {
1224            Cons cdr = (Cons) cons.cdr;
1225            return (cdr.car instanceof Symbol && cdr.cdr == NIL);
1226          }
1227      }
1228    return false;
1229  }
1230
1231  public static final LispObject FUNCTION_NAME =
1232    list(Symbol.OR,
1233          Symbol.SYMBOL,
1234          list(Symbol.CONS,
1235                list(Symbol.EQL, Symbol.SETF),
1236                list(Symbol.CONS, Symbol.SYMBOL, Symbol.NULL)));
1237
1238  public static final LispObject UNSIGNED_BYTE_8 =
1239    list(Symbol.UNSIGNED_BYTE, Fixnum.constants[8]);
1240
1241  public static final LispObject UNSIGNED_BYTE_16 =
1242    list(Symbol.UNSIGNED_BYTE, Fixnum.constants[16]);
1243
1244  public static final LispObject UNSIGNED_BYTE_32 =
1245    list(Symbol.UNSIGNED_BYTE, Fixnum.constants[32]);
1246
1247  public static final LispObject UNSIGNED_BYTE_32_MAX_VALUE =
1248    Bignum.getInstance(4294967296L);
1249
1250  public static final LispObject getUpgradedArrayElementType(LispObject type)
1251    throws ConditionThrowable
1252  {
1253    if (type instanceof Symbol)
1254      {
1255        if (type == Symbol.CHARACTER || type == Symbol.BASE_CHAR ||
1256            type == Symbol.STANDARD_CHAR)
1257          return Symbol.CHARACTER;
1258        if (type == Symbol.BIT)
1259          return Symbol.BIT;
1260        if (type == NIL)
1261          return NIL;
1262      }
1263    if (type == BuiltInClass.CHARACTER)
1264      return Symbol.CHARACTER;
1265    if (type instanceof Cons)
1266      {
1267        if (type.equal(UNSIGNED_BYTE_8))
1268          return type;
1269        if (type.equal(UNSIGNED_BYTE_16))
1270          return type;
1271        if (type.equal(UNSIGNED_BYTE_32))
1272          return type;
1273        LispObject car = type.car();
1274        if (car == Symbol.INTEGER)
1275          {
1276            LispObject lower = type.cadr();
1277            LispObject upper = type.cdr().cadr();
1278            // Convert to inclusive bounds.
1279            if (lower instanceof Cons)
1280              lower = lower.car().incr();
1281            if (upper instanceof Cons)
1282              upper = upper.car().decr();
1283            if (lower.integerp() && upper.integerp())
1284              {
1285                if (lower instanceof Fixnum && upper instanceof Fixnum)
1286                  {
1287                    int l = ((Fixnum)lower).value;
1288                    if (l >= 0)
1289                      {
1290                        int u = ((Fixnum)upper).value;
1291                        if (u <= 1)
1292                          return Symbol.BIT;
1293                        if (u <= 255)
1294                          return UNSIGNED_BYTE_8;
1295                        if (u <= 65535)
1296                          return UNSIGNED_BYTE_16;
1297                        return UNSIGNED_BYTE_32;
1298                      }
1299                  }
1300                if (lower.isGreaterThanOrEqualTo(Fixnum.ZERO))
1301                  {
1302                    if (lower.isLessThan(UNSIGNED_BYTE_32_MAX_VALUE))
1303                      {
1304                        if (upper.isLessThan(UNSIGNED_BYTE_32_MAX_VALUE))
1305                          return UNSIGNED_BYTE_32;
1306                      }
1307                  }
1308              }
1309          }
1310        else if (car == Symbol.EQL)
1311          {
1312            LispObject obj = type.cadr();
1313            if (obj instanceof Fixnum)
1314              {
1315                int val = ((Fixnum)obj).value;
1316                if (val >= 0)
1317                  {
1318                    if (val <= 1)
1319                      return Symbol.BIT;
1320                    if (val <= 255)
1321                      return UNSIGNED_BYTE_8;
1322                    if (val <= 65535)
1323                      return UNSIGNED_BYTE_16;
1324                    return UNSIGNED_BYTE_32;
1325                  }
1326              }
1327            else if (obj instanceof Bignum)
1328              {
1329                if (obj.isGreaterThanOrEqualTo(Fixnum.ZERO))
1330                  {
1331                    if (obj.isLessThan(UNSIGNED_BYTE_32_MAX_VALUE))
1332                      return UNSIGNED_BYTE_32;
1333                  }
1334              }
1335          }
1336        else if (car == Symbol.MEMBER)
1337          {
1338            LispObject rest = type.cdr();
1339            while (rest != NIL)
1340              {
1341                LispObject obj = rest.car();
1342                if (obj instanceof LispCharacter)
1343                  rest = rest.cdr();
1344                else
1345                  return T;
1346              }
1347            return Symbol.CHARACTER;
1348          }
1349      }
1350    return T;
1351  }
1352
1353  public static final byte coerceLispObjectToJavaByte(LispObject obj)
1354    throws ConditionThrowable
1355  {
1356          return (byte)Fixnum.getValue(obj);
1357  }
1358
1359  public static final LispObject coerceJavaByteToLispObject(byte b)
1360  {
1361    return Fixnum.constants[((int)b) & 0xff];
1362  }
1363
1364  public static final LispCharacter checkCharacter(LispObject obj)
1365    throws ConditionThrowable
1366  {
1367          if (obj instanceof LispCharacter) 
1368                  return (LispCharacter) obj;         
1369          return (LispCharacter) // Not reached.       
1370        type_error(obj, Symbol.CHARACTER);
1371  }
1372
1373  public static final Package checkPackage(LispObject obj)
1374    throws ConditionThrowable
1375  {
1376          if (obj instanceof Package)     
1377                  return (Package) obj;         
1378          return (Package) // Not reached.       
1379        type_error(obj, Symbol.PACKAGE);
1380  }
1381
1382  public static final Function checkFunction(LispObject obj)
1383    throws ConditionThrowable
1384  {
1385          if (obj instanceof Function)   
1386                  return (Function) obj;         
1387          return (Function) // Not reached.       
1388        type_error(obj, Symbol.FUNCTION);
1389  }
1390
1391  public static final Stream checkStream(LispObject obj)
1392    throws ConditionThrowable
1393  {
1394          if (obj instanceof Stream)     
1395                  return (Stream) obj;         
1396          return (Stream) // Not reached.       
1397        type_error(obj, Symbol.STREAM);
1398  }
1399
1400  public static final Stream checkCharacterInputStream(LispObject obj)
1401    throws ConditionThrowable
1402  {
1403          final Stream stream = checkStream(obj);
1404          if (stream.isCharacterInputStream())     
1405                  return stream;                       
1406          return (Stream) // Not reached.                     
1407          error(new TypeError("The value " + obj.writeToString() +
1408                        " is not a character input stream."));
1409  }
1410
1411  public static final Stream checkCharacterOutputStream(LispObject obj)
1412    throws ConditionThrowable
1413  {
1414          final Stream stream = checkStream(obj);
1415          if (stream.isCharacterOutputStream())     
1416                  return stream;                       
1417        return (Stream) // Not reached.
1418        error(new TypeError("The value " + obj.writeToString() +
1419                            " is not a character output stream."));
1420  }
1421
1422  public static final Stream checkBinaryInputStream(LispObject obj)
1423    throws ConditionThrowable
1424  {
1425          final Stream stream = checkStream(obj);
1426          if (stream.isBinaryInputStream())     
1427                  return stream;                       
1428        return (Stream) // Not reached.
1429        error(new TypeError("The value " + obj.writeToString() +
1430                             " is not a binary input stream."));
1431  }
1432 
1433  public static final Stream outSynonymOf(LispObject obj)
1434  throws ConditionThrowable
1435  {       
1436          if (obj instanceof Stream)
1437            return (Stream) obj;
1438          if (obj == T)
1439            return checkCharacterOutputStream(Symbol.TERMINAL_IO.symbolValue());
1440          if (obj == NIL)
1441            return checkCharacterOutputStream(Symbol.STANDARD_OUTPUT.symbolValue());
1442          return (Stream)         // Not reached.
1443          type_error(obj, Symbol.STREAM);
1444  }
1445
1446  public static final Stream inSynonymOf(LispObject obj)
1447    throws ConditionThrowable
1448  {
1449    if (obj instanceof Stream)
1450      return (Stream) obj;
1451    if (obj == T)
1452      return checkCharacterInputStream(Symbol.TERMINAL_IO.symbolValue());
1453    if (obj == NIL)
1454      return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
1455          return (Stream)         // Not reached.
1456          type_error(obj, Symbol.STREAM);
1457  }
1458
1459  public static final void writeByte(int n, LispObject obj)
1460    throws ConditionThrowable
1461  {
1462    if (n < 0 || n > 255)
1463      type_error(Fixnum.getInstance(n), UNSIGNED_BYTE_8);
1464    checkStream(obj)._writeByte(n);
1465  }
1466
1467  public static final Readtable checkReadtable(LispObject obj)
1468    throws ConditionThrowable
1469  {
1470          if (obj instanceof Readtable)   
1471                  return (Readtable) obj;         
1472          return (Readtable)// Not reached.       
1473          type_error(obj, Symbol.READTABLE);
1474  }
1475 
1476  public final static AbstractString checkString(LispObject obj) 
1477   throws ConditionThrowable
1478  {
1479          if (obj instanceof AbstractString)           
1480                  return (AbstractString) obj;                   
1481          return (AbstractString)// Not reached.               
1482              type_error(obj, Symbol.STRING);
1483  }
1484 
1485  public final static LispClass checkClass(LispObject obj) 
1486   throws ConditionThrowable
1487   {
1488          if (obj instanceof LispClass)         
1489                  return (LispClass) obj;                         
1490          return (LispClass)// Not reached.                   
1491                type_error(obj, Symbol.CLASS);
1492   }   
1493
1494  public final static Layout checkLayout(LispObject obj) 
1495   throws ConditionThrowable
1496  {
1497          if (obj instanceof Layout)           
1498                  return (Layout) obj;                   
1499          return (Layout)// Not reached.               
1500                type_error(obj, Symbol.LAYOUT);
1501  }
1502
1503  public static final Readtable designator_readtable(LispObject obj)
1504    throws ConditionThrowable
1505  {
1506    if (obj == NIL)
1507      obj = STANDARD_READTABLE.symbolValue();
1508    if (obj == null)
1509        throw new NullPointerException();
1510    return checkReadtable(obj);
1511  }
1512
1513  public static final Environment checkEnvironment(LispObject obj)
1514    throws ConditionThrowable
1515  {
1516          if (obj instanceof Environment)         
1517                  return (Environment) obj;         
1518          return (Environment)// Not reached.       
1519        type_error(obj, Symbol.ENVIRONMENT);
1520  }
1521
1522  public static final void checkBounds(int start, int end, int length)
1523    throws ConditionThrowable
1524  {
1525    if (start < 0 || end < 0 || start > end || end > length)
1526      {
1527        FastStringBuffer sb = new FastStringBuffer("The bounding indices ");
1528        sb.append(start);
1529        sb.append(" and ");
1530        sb.append(end);
1531        sb.append(" are bad for a sequence of length ");
1532        sb.append(length);
1533        sb.append('.');
1534        error(new TypeError(sb.toString()));
1535      }
1536  }
1537
1538  public static final LispObject coerceToFunction(LispObject obj)
1539    throws ConditionThrowable
1540  {
1541    if (obj instanceof Function)
1542      return obj;
1543    if (obj instanceof StandardGenericFunction)
1544      return obj;
1545    if (obj instanceof Symbol)
1546      {
1547        LispObject fun = obj.getSymbolFunction();
1548        if (fun instanceof Function)
1549          return (Function) fun;
1550      }
1551    else if (obj instanceof Cons && obj.car() == Symbol.LAMBDA)
1552      return new Closure(obj, new Environment());
1553    error(new UndefinedFunction(obj));
1554    // Not reached.
1555    return null;
1556  }
1557
1558  // Returns package or throws exception.
1559  public static final Package coerceToPackage(LispObject obj)
1560    throws ConditionThrowable
1561  {
1562    if (obj instanceof Package)
1563      return (Package) obj;
1564    Package pkg = Packages.findPackage(javaString(obj));
1565    if (pkg != null)
1566      return pkg;
1567    error(new PackageError(obj.writeToString() + " is not the name of a package."));
1568    // Not reached.
1569    return null;
1570  }
1571
1572  public static Pathname coerceToPathname(LispObject arg)
1573    throws ConditionThrowable
1574  {
1575    if (arg instanceof Pathname)
1576      return (Pathname) arg;
1577    if (arg instanceof AbstractString)
1578      return Pathname.parseNamestring((AbstractString)arg);
1579    if (arg instanceof FileStream)
1580      return ((FileStream)arg).getPathname();
1581    type_error(arg, list(Symbol.OR, Symbol.PATHNAME,
1582                               Symbol.STRING, Symbol.FILE_STREAM));
1583    // Not reached.
1584    return null;
1585  }
1586
1587  public LispObject assq(LispObject item, LispObject alist)
1588    throws ConditionThrowable
1589  {
1590    while (alist instanceof Cons)
1591      {
1592        LispObject entry = ((Cons)alist).car;
1593        if (entry instanceof Cons)
1594          {
1595            if (((Cons)entry).car == item)
1596              return entry;
1597          }
1598        else if (entry != NIL)
1599          return type_error(entry, Symbol.LIST);
1600        alist = ((Cons)alist).cdr;
1601      }
1602    if (alist != NIL)
1603      return type_error(alist, Symbol.LIST);
1604    return NIL;
1605  }
1606
1607  public static final boolean memq(LispObject item, LispObject list)
1608    throws ConditionThrowable
1609  {
1610    while (list instanceof Cons)
1611      {
1612        if (item == ((Cons)list).car)
1613          return true;
1614        list = ((Cons)list).cdr;
1615      }
1616    if (list != NIL)
1617      type_error(list, Symbol.LIST);
1618    return false;
1619  }
1620
1621  public static final boolean memql(LispObject item, LispObject list)
1622    throws ConditionThrowable
1623  {
1624    while (list instanceof Cons)
1625      {
1626        if (item.eql(((Cons)list).car))
1627          return true;
1628        list = ((Cons)list).cdr;
1629      }
1630    if (list != NIL)
1631      type_error(list, Symbol.LIST);
1632    return false;
1633  }
1634
1635  // Property lists.
1636  public static final LispObject getf(LispObject plist, LispObject indicator,
1637                                      LispObject defaultValue)
1638    throws ConditionThrowable
1639  {
1640    LispObject list = plist;
1641    while (list != NIL)
1642      {
1643        if (list.car() == indicator)
1644          return list.cadr();
1645        if (list.cdr() instanceof Cons)
1646          list = list.cddr();
1647        else
1648          return error(new TypeError("Malformed property list: " +
1649                                      plist.writeToString()));
1650      }
1651    return defaultValue;
1652  }
1653
1654  public static final LispObject get(LispObject symbol, LispObject indicator)
1655    throws ConditionThrowable
1656  {
1657    LispObject list = checkSymbol(symbol).getPropertyList();
1658    while (list != NIL)
1659      {
1660        if (list.car() == indicator)
1661          return list.cadr();
1662        list = list.cddr();
1663      }
1664    return NIL;
1665  }
1666
1667  public static final LispObject get(LispObject symbol, LispObject indicator,
1668                                     LispObject defaultValue)
1669    throws ConditionThrowable
1670  {
1671    LispObject list = checkSymbol(symbol).getPropertyList();
1672    while (list != NIL)
1673      {
1674        if (list.car() == indicator)
1675          return list.cadr();
1676        list = list.cddr();
1677      }
1678    return defaultValue;
1679  }
1680
1681  public static final LispObject put(Symbol symbol, LispObject indicator,
1682                                     LispObject value)
1683    throws ConditionThrowable
1684  {
1685    LispObject list = symbol.getPropertyList();
1686    while (list != NIL)
1687      {
1688        if (list.car() == indicator)
1689          {
1690            // Found it!
1691            LispObject rest = list.cdr();
1692            rest.setCar(value);
1693            return value;
1694          }
1695        list = list.cddr();
1696      }
1697    // Not found.
1698    symbol.setPropertyList(new Cons(indicator,
1699                                    new Cons(value,
1700                                             symbol.getPropertyList())));
1701    return value;
1702  }
1703
1704  public static final LispObject putf(LispObject plist, LispObject indicator,
1705                                      LispObject value)
1706    throws ConditionThrowable
1707  {
1708    LispObject list = plist;
1709    while (list != NIL)
1710      {
1711        if (list.car() == indicator)
1712          {
1713            // Found it!
1714            LispObject rest = list.cdr();
1715            rest.setCar(value);
1716            return plist;
1717          }
1718        list = list.cddr();
1719      }
1720    // Not found.
1721    return new Cons(indicator, new Cons(value, plist));
1722  }
1723
1724  public static final LispObject remprop(Symbol symbol, LispObject indicator)
1725    throws ConditionThrowable
1726  {
1727    LispObject list = checkList(symbol.getPropertyList());
1728    LispObject prev = null;
1729    while (list != NIL)
1730      {
1731        if (!(list.cdr() instanceof Cons))
1732          error(new ProgramError("The symbol " + symbol.writeToString() +
1733                                  " has an odd number of items in its property list."));
1734        if (list.car() == indicator)
1735          {
1736            // Found it!
1737            if (prev != null)
1738              prev.setCdr(list.cddr());
1739            else
1740              symbol.setPropertyList(list.cddr());
1741            return T;
1742          }
1743        prev = list.cdr();
1744        list = list.cddr();
1745      }
1746    // Not found.
1747    return NIL;
1748  }
1749
1750  public static final String format(LispObject formatControl,
1751                                    LispObject formatArguments)
1752    throws ConditionThrowable
1753  {
1754    final LispThread thread = LispThread.currentThread();
1755    String control = formatControl.getStringValue();
1756    LispObject[] args = formatArguments.copyToArray();
1757    StringBuffer sb = new StringBuffer();
1758    if (control != null)
1759      {
1760        final int limit = control.length();
1761        int j = 0;
1762        final int NEUTRAL = 0;
1763        final int TILDE = 1;
1764        int state = NEUTRAL;
1765        for (int i = 0; i < limit; i++)
1766          {
1767            char c = control.charAt(i);
1768            if (state == NEUTRAL)
1769              {
1770                if (c == '~')
1771                  state = TILDE;
1772                else
1773                  sb.append(c);
1774              }
1775            else if (state == TILDE)
1776              {
1777                if (c == 'A' || c == 'a')
1778                  {
1779                    if (j < args.length)
1780                      {
1781                        LispObject obj = args[j++];
1782                        SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
1783                        thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
1784                        thread.bindSpecial(Symbol.PRINT_READABLY, NIL);
1785                        sb.append(obj.writeToString());
1786                        thread.lastSpecialBinding = lastSpecialBinding;
1787                      }
1788                  }
1789                else if (c == 'S' || c == 's')
1790                  {
1791                    if (j < args.length)
1792                      {
1793                        LispObject obj = args[j++];
1794                        SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
1795                        thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
1796                        try {
1797                            sb.append(obj.writeToString());
1798                        }
1799                        finally {
1800                            thread.lastSpecialBinding = lastSpecialBinding;
1801                        }
1802                      }
1803                  }
1804                else if (c == 'D' || c == 'd')
1805                  {
1806                    if (j < args.length)
1807                      {
1808                        LispObject obj = args[j++];
1809                        SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
1810                        thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
1811                        thread.bindSpecial(Symbol.PRINT_RADIX, NIL);
1812                        thread.bindSpecial(Symbol.PRINT_BASE, Fixnum.constants[10]);
1813                        try {
1814                            sb.append(obj.writeToString());
1815                        }
1816                        finally {
1817                            thread.lastSpecialBinding = lastSpecialBinding;
1818                        }
1819                      }
1820                  }
1821                else if (c == 'X' || c == 'x')
1822                  {
1823                    if (j < args.length)
1824                      {
1825                        LispObject obj = args[j++];
1826                        SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
1827                        thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
1828                        thread.bindSpecial(Symbol.PRINT_RADIX, NIL);
1829                        thread.bindSpecial(Symbol.PRINT_BASE, Fixnum.constants[16]);
1830                        try {
1831                            sb.append(obj.writeToString());
1832                        }
1833                        finally {
1834                            thread.lastSpecialBinding = lastSpecialBinding;
1835                        }
1836                      }
1837                  }
1838                else if (c == '%')
1839                  {
1840                    sb.append('\n');
1841                  }
1842                state = NEUTRAL;
1843              }
1844            else
1845              {
1846                // There are no other valid states.
1847                Debug.assertTrue(false);
1848              }
1849          }
1850      }
1851    return sb.toString();
1852  }
1853
1854  public static final Symbol intern(String name, Package pkg)
1855  {
1856    return pkg.intern(name);
1857  }
1858
1859  // Used by the compiler.
1860  public static final Symbol internInPackage(String name, String packageName)
1861    throws ConditionThrowable
1862  {
1863    Package pkg = Packages.findPackage(packageName);
1864    if (pkg == null)
1865      error(new LispError(packageName + " is not the name of a package."));
1866    return pkg.intern(name);
1867  }
1868
1869  public static final Symbol internKeyword(String s)
1870  {
1871    return PACKAGE_KEYWORD.intern(s);
1872  }
1873
1874  // The compiler's object table.
1875  private static final Hashtable<String,LispObject> objectTable =
1876          new Hashtable<String,LispObject>();
1877
1878  public static final LispObject recall(SimpleString key)
1879  {
1880    return (LispObject) objectTable.remove(key.getStringValue());
1881  }
1882
1883  // ### remember
1884  public static final Primitive REMEMBER =
1885    new Primitive("remember", PACKAGE_SYS, true)
1886    {
1887      @Override
1888      public LispObject execute(LispObject key, LispObject value)
1889        throws ConditionThrowable
1890      {
1891        objectTable.put(key.getStringValue(), value);
1892        return NIL;
1893      }
1894    };
1895
1896  public static final Symbol internSpecial(String name, Package pkg,
1897                                           LispObject value)
1898  {
1899    Symbol symbol = pkg.intern(name);
1900    symbol.setSpecial(true);
1901    symbol.setSymbolValue(value);
1902    return symbol;
1903  }
1904
1905  public static final Symbol internConstant(String name, Package pkg,
1906                                            LispObject value)
1907  {
1908    Symbol symbol = pkg.intern(name);
1909    symbol.initializeConstant(value);
1910    return symbol;
1911  }
1912
1913  public static final Symbol exportSpecial(String name, Package pkg,
1914                                           LispObject value)
1915  {
1916    Symbol symbol = pkg.intern(name);
1917    try
1918      {
1919        pkg.export(symbol); // FIXME Inefficient!
1920      }
1921    catch (ConditionThrowable t)
1922      {
1923        Debug.trace(t);
1924      }
1925    symbol.setSpecial(true);
1926    symbol.setSymbolValue(value);
1927    return symbol;
1928  }
1929
1930  public static final Symbol exportConstant(String name, Package pkg,
1931                                            LispObject value)
1932  {
1933    Symbol symbol = pkg.intern(name);
1934    try
1935      {
1936        pkg.export(symbol); // FIXME Inefficient!
1937      }
1938    catch (ConditionThrowable t)
1939      {
1940        Debug.trace(t);
1941      }
1942    symbol.initializeConstant(value);
1943    return symbol;
1944  }
1945
1946  static
1947  {
1948    String userDir = System.getProperty("user.dir");
1949    if (userDir != null && userDir.length() > 0)
1950      {
1951        if (userDir.charAt(userDir.length() - 1) != File.separatorChar)
1952          userDir = userDir.concat(File.separator);
1953      }
1954    // This string will be converted to a pathname when Pathname.java is loaded.
1955    Symbol.DEFAULT_PATHNAME_DEFAULTS.initializeSpecial(new SimpleString(userDir));
1956  }
1957
1958  static
1959  {
1960    Symbol._PACKAGE_.initializeSpecial(PACKAGE_CL_USER);
1961  }
1962
1963  public static final Package getCurrentPackage()
1964  {
1965    return (Package) Symbol._PACKAGE_.symbolValueNoThrow();
1966  }
1967
1968  private static Stream stdin = new Stream(System.in, Symbol.CHARACTER, true);
1969
1970  private static Stream stdout = new Stream(System.out, Symbol.CHARACTER, true);
1971
1972  static
1973  {
1974    Symbol.STANDARD_INPUT.initializeSpecial(stdin);
1975    Symbol.STANDARD_OUTPUT.initializeSpecial(stdout);
1976    Symbol.ERROR_OUTPUT.initializeSpecial(stdout);
1977    Symbol.TRACE_OUTPUT.initializeSpecial(stdout);
1978    Symbol.TERMINAL_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
1979    Symbol.QUERY_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
1980    Symbol.DEBUG_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
1981  }
1982
1983  public static final void resetIO(Stream in, Stream out)
1984  {
1985    stdin = in;
1986    stdout = out;
1987    Symbol.STANDARD_INPUT.setSymbolValue(stdin);
1988    Symbol.STANDARD_OUTPUT.setSymbolValue(stdout);
1989    Symbol.ERROR_OUTPUT.setSymbolValue(stdout);
1990    Symbol.TRACE_OUTPUT.setSymbolValue(stdout);
1991    Symbol.TERMINAL_IO.setSymbolValue(new TwoWayStream(stdin, stdout, true));
1992    Symbol.QUERY_IO.setSymbolValue(new TwoWayStream(stdin, stdout, true));
1993    Symbol.DEBUG_IO.setSymbolValue(new TwoWayStream(stdin, stdout, true));
1994  }
1995
1996  // Used in org/armedbear/j/JLisp.java.
1997  public static final void resetIO()
1998  {
1999    resetIO(new Stream(System.in, Symbol.CHARACTER, true),
2000            new Stream(System.out, Symbol.CHARACTER, true));
2001  }
2002
2003  public static final TwoWayStream getTerminalIO()
2004  {
2005    return (TwoWayStream) Symbol.TERMINAL_IO.symbolValueNoThrow();
2006  }
2007
2008  public static final Stream getStandardInput()
2009  {
2010    return (Stream) Symbol.STANDARD_INPUT.symbolValueNoThrow();
2011  }
2012
2013  public static final Stream getStandardOutput() throws ConditionThrowable
2014  {
2015    return checkCharacterOutputStream(Symbol.STANDARD_OUTPUT.symbolValue());
2016  }
2017
2018  static
2019  {
2020    Symbol.CURRENT_READTABLE.initializeSpecial(new Readtable());
2021  }
2022
2023  // ### +standard-readtable+
2024  // internal symbol
2025  public static final Symbol STANDARD_READTABLE =
2026    internConstant("+STANDARD-READTABLE+", PACKAGE_SYS, new Readtable());
2027
2028  public static final Readtable currentReadtable() throws ConditionThrowable
2029  {
2030    return (Readtable) Symbol.CURRENT_READTABLE.symbolValue();
2031  }
2032
2033  static
2034  {
2035    Symbol.READ_SUPPRESS.initializeSpecial(NIL);
2036    Symbol.DEBUGGER_HOOK.initializeSpecial(NIL);
2037  }
2038
2039  static
2040  {
2041    Symbol.MOST_POSITIVE_FIXNUM.initializeConstant(Fixnum.getInstance(Integer.MAX_VALUE));
2042    Symbol.MOST_NEGATIVE_FIXNUM.initializeConstant(Fixnum.getInstance(Integer.MIN_VALUE));
2043    Symbol.MOST_POSITIVE_JAVA_LONG.initializeConstant(Bignum.getInstance(Long.MAX_VALUE));
2044    Symbol.MOST_NEGATIVE_JAVA_LONG.initializeConstant(Bignum.getInstance(Long.MIN_VALUE));
2045  }
2046
2047  public static void exit(int status)
2048  {
2049    Interpreter interpreter = Interpreter.getInstance();
2050    if (interpreter != null)
2051      interpreter.kill(status);
2052  }
2053
2054  // ### t
2055  public static final Symbol T = Symbol.T;
2056  static
2057  {
2058    T.initializeConstant(T);
2059  }
2060
2061  static
2062  {
2063    Symbol.READ_EVAL.initializeSpecial(T);
2064  }
2065
2066  // ### *features*
2067  static
2068  {
2069    Symbol.FEATURES.initializeSpecial(NIL);
2070    String osName = System.getProperty("os.name");
2071    if (osName.startsWith("Linux"))
2072      {
2073        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2074                                             Keyword.ABCL,
2075                                             Keyword.COMMON_LISP,
2076                                             Keyword.ANSI_CL,
2077                                             Keyword.UNIX,
2078                                             Keyword.LINUX,
2079                                             Keyword.CDR6));
2080      }
2081    else if (osName.startsWith("SunOS"))
2082      {
2083        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2084                                             Keyword.ABCL,
2085                                             Keyword.COMMON_LISP,
2086                                             Keyword.ANSI_CL,
2087                                             Keyword.UNIX,
2088                                             Keyword.SUNOS,
2089                                             Keyword.CDR6));
2090      }
2091    else if (osName.startsWith("Mac OS X"))
2092      {
2093        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2094                                             Keyword.ABCL,
2095                                             Keyword.COMMON_LISP,
2096                                             Keyword.ANSI_CL,
2097                                             Keyword.UNIX,
2098                                             Keyword.DARWIN,
2099                                             Keyword.CDR6));
2100      }
2101    else if (osName.startsWith("FreeBSD"))
2102      {
2103        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2104                                             Keyword.ABCL,
2105                                             Keyword.COMMON_LISP,
2106                                             Keyword.ANSI_CL,
2107                                             Keyword.UNIX,
2108                                             Keyword.FREEBSD,
2109                                             Keyword.CDR6));
2110      }
2111    else if (osName.startsWith("OpenBSD"))
2112      {
2113        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2114                                             Keyword.ABCL,
2115                                             Keyword.COMMON_LISP,
2116                                             Keyword.ANSI_CL,
2117                                             Keyword.UNIX,
2118                                             Keyword.OPENBSD,
2119                                             Keyword.CDR6));
2120      }
2121    else if (osName.startsWith("NetBSD"))
2122      {
2123        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2124                                             Keyword.ABCL,
2125                                             Keyword.COMMON_LISP,
2126                                             Keyword.ANSI_CL,
2127                                             Keyword.UNIX,
2128                                             Keyword.NETBSD,
2129                                             Keyword.CDR6));
2130      }
2131    else if (osName.startsWith("Windows"))
2132      {
2133        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2134                                             Keyword.ABCL,
2135                                             Keyword.COMMON_LISP,
2136                                             Keyword.ANSI_CL,
2137                                             Keyword.WINDOWS,
2138                                             Keyword.CDR6));
2139      }
2140    else
2141      {
2142        Symbol.FEATURES.setSymbolValue(list(Keyword.ARMEDBEAR,
2143                                             Keyword.ABCL,
2144                                             Keyword.COMMON_LISP,
2145                                             Keyword.ANSI_CL,
2146                                             Keyword.CDR6));
2147      }
2148  }
2149  static
2150  {
2151    final String version = System.getProperty("java.version");
2152    if (version.startsWith("1.5"))
2153      {
2154        Symbol.FEATURES.setSymbolValue(new Cons(Keyword.JAVA_1_5,
2155                                                Symbol.FEATURES.getSymbolValue()));
2156      }
2157    else if (version.startsWith("1.6"))
2158      {
2159        Symbol.FEATURES.setSymbolValue(new Cons(Keyword.JAVA_1_6,
2160                                                Symbol.FEATURES.getSymbolValue()));
2161      }
2162    else if (version.startsWith("1.7"))
2163      {
2164        Symbol.FEATURES.setSymbolValue(new Cons(Keyword.JAVA_1_7,
2165                                                Symbol.FEATURES.getSymbolValue()));
2166      }
2167  }
2168  static
2169  {
2170    String os_arch = System.getProperty("os.arch");
2171    if(os_arch != null) {
2172      if (os_arch.equals("amd64"))
2173        Symbol.FEATURES.setSymbolValue(new Cons(Keyword.X86_64,
2174                                                Symbol.FEATURES.getSymbolValue()));
2175      else if (os_arch.equals("x86"))
2176        Symbol.FEATURES.setSymbolValue(new Cons(Keyword.X86,
2177                                                Symbol.FEATURES.getSymbolValue()));
2178    }
2179  }
2180
2181  static
2182  {
2183    Symbol.MODULES.initializeSpecial(NIL);
2184  }
2185
2186  static
2187  {
2188    Symbol.LOAD_VERBOSE.initializeSpecial(NIL);
2189    Symbol.LOAD_PRINT.initializeSpecial(NIL);
2190    Symbol.LOAD_PATHNAME.initializeSpecial(NIL);
2191    Symbol.LOAD_TRUENAME.initializeSpecial(NIL);
2192    Symbol.COMPILE_VERBOSE.initializeSpecial(T);
2193    Symbol.COMPILE_PRINT.initializeSpecial(T);
2194    Symbol._COMPILE_FILE_PATHNAME_.initializeSpecial(NIL);
2195    Symbol.COMPILE_FILE_TRUENAME.initializeSpecial(NIL);
2196  }
2197
2198  // ### *load-depth*
2199  // internal symbol
2200  public static final Symbol _LOAD_DEPTH_ =
2201    internSpecial("*LOAD-DEPTH*", PACKAGE_SYS, Fixnum.ZERO);
2202
2203  // ### *load-stream*
2204  // internal symbol
2205  public static final Symbol _LOAD_STREAM_ =
2206    internSpecial("*LOAD-STREAM*", PACKAGE_SYS, NIL);
2207
2208  // ### *source*
2209  // internal symbol
2210  public static final Symbol _SOURCE_ =
2211    exportSpecial("*SOURCE*", PACKAGE_SYS, NIL);
2212
2213  // ### *source-position*
2214  // internal symbol
2215  public static final Symbol _SOURCE_POSITION_ =
2216    exportSpecial("*SOURCE-POSITION*", PACKAGE_SYS, NIL);
2217
2218  // ### *autoload-verbose*
2219  // internal symbol
2220  public static final Symbol _AUTOLOAD_VERBOSE_ =
2221    exportSpecial("*AUTOLOAD-VERBOSE*", PACKAGE_EXT, NIL);
2222
2223  // ### *compile-file-type*
2224  public static final String COMPILE_FILE_TYPE = "abcl";
2225  public static final Symbol _COMPILE_FILE_TYPE_ =
2226    internConstant("*COMPILE-FILE-TYPE*", PACKAGE_SYS,
2227                   new SimpleString(COMPILE_FILE_TYPE));
2228
2229  // ### *compile-file-zip*
2230  public static final Symbol _COMPILE_FILE_ZIP_ =
2231    exportSpecial("*COMPILE-FILE-ZIP*", PACKAGE_SYS, T);
2232
2233  static
2234  {
2235    Symbol.MACROEXPAND_HOOK.initializeSpecial(Symbol.FUNCALL);
2236  }
2237
2238  public static final int ARRAY_DIMENSION_MAX = Integer.MAX_VALUE;
2239  static
2240  {
2241    // ### array-dimension-limit
2242    Symbol.ARRAY_DIMENSION_LIMIT.initializeConstant(Fixnum.getInstance(ARRAY_DIMENSION_MAX));
2243  }
2244
2245  // ### char-code-limit
2246  // "The upper exclusive bound on the value returned by the function CHAR-CODE."
2247  public static final int CHAR_MAX = 256;
2248  static
2249  {
2250    Symbol.CHAR_CODE_LIMIT.initializeConstant(Fixnum.getInstance(CHAR_MAX));
2251  }
2252
2253  static
2254  {
2255    Symbol.READ_BASE.initializeSpecial(Fixnum.constants[10]);
2256  }
2257
2258  static
2259  {
2260    Symbol.READ_DEFAULT_FLOAT_FORMAT.initializeSpecial(Symbol.SINGLE_FLOAT);
2261  }
2262
2263  // Printer control variables.
2264  static
2265  {
2266    Symbol.PRINT_ARRAY.initializeSpecial(T);
2267    Symbol.PRINT_BASE.initializeSpecial(Fixnum.constants[10]);
2268    Symbol.PRINT_CASE.initializeSpecial(Keyword.UPCASE);
2269    Symbol.PRINT_CIRCLE.initializeSpecial(NIL);
2270    Symbol.PRINT_ESCAPE.initializeSpecial(T);
2271    Symbol.PRINT_GENSYM.initializeSpecial(T);
2272    Symbol.PRINT_LENGTH.initializeSpecial(NIL);
2273    Symbol.PRINT_LEVEL.initializeSpecial(NIL);
2274    Symbol.PRINT_LINES.initializeSpecial(NIL);
2275    Symbol.PRINT_MISER_WIDTH.initializeSpecial(NIL);
2276    Symbol.PRINT_PPRINT_DISPATCH.initializeSpecial(NIL);
2277    Symbol.PRINT_PRETTY.initializeSpecial(NIL);
2278    Symbol.PRINT_RADIX.initializeSpecial(NIL);
2279    Symbol.PRINT_READABLY.initializeSpecial(NIL);
2280    Symbol.PRINT_RIGHT_MARGIN.initializeSpecial(NIL);
2281  }
2282
2283  public static final Symbol _PRINT_STRUCTURE_ =
2284    exportSpecial("*PRINT-STRUCTURE*", PACKAGE_EXT, T);
2285
2286  // ### *current-print-length*
2287  public static final Symbol _CURRENT_PRINT_LENGTH_ =
2288    exportSpecial("*CURRENT-PRINT-LENGTH*", PACKAGE_SYS, Fixnum.ZERO);
2289
2290  // ### *current-print-level*
2291  public static final Symbol _CURRENT_PRINT_LEVEL_ =
2292    exportSpecial("*CURRENT-PRINT-LEVEL*", PACKAGE_SYS, Fixnum.ZERO);
2293
2294  public static final Symbol _PRINT_FASL_ =
2295    internSpecial("*PRINT-FASL*", PACKAGE_SYS, NIL);
2296
2297  static
2298  {
2299    Symbol._RANDOM_STATE_.initializeSpecial(new RandomState());
2300  }
2301
2302  static
2303  {
2304    Symbol.STAR.initializeSpecial(NIL);
2305    Symbol.STAR_STAR.initializeSpecial(NIL);
2306    Symbol.STAR_STAR_STAR.initializeSpecial(NIL);
2307    Symbol.MINUS.initializeSpecial(NIL);
2308    Symbol.PLUS.initializeSpecial(NIL);
2309    Symbol.PLUS_PLUS.initializeSpecial(NIL);
2310    Symbol.PLUS_PLUS_PLUS.initializeSpecial(NIL);
2311    Symbol.SLASH.initializeSpecial(NIL);
2312    Symbol.SLASH_SLASH.initializeSpecial(NIL);
2313    Symbol.SLASH_SLASH_SLASH.initializeSpecial(NIL);
2314  }
2315
2316  // Floating point constants.
2317  static
2318  {
2319    Symbol.PI.initializeConstant(new DoubleFloat(Math.PI));
2320    Symbol.SHORT_FLOAT_EPSILON.initializeConstant(new SingleFloat((float)5.960465E-8));
2321    Symbol.SINGLE_FLOAT_EPSILON.initializeConstant(new SingleFloat((float)5.960465E-8));
2322    Symbol.DOUBLE_FLOAT_EPSILON.initializeConstant(new DoubleFloat((double)1.1102230246251568E-16));
2323    Symbol.LONG_FLOAT_EPSILON.initializeConstant(new DoubleFloat((double)1.1102230246251568E-16));
2324    Symbol.SHORT_FLOAT_NEGATIVE_EPSILON.initializeConstant(new SingleFloat(2.9802326e-8f));
2325    Symbol.SINGLE_FLOAT_NEGATIVE_EPSILON.initializeConstant(new SingleFloat(2.9802326e-8f));
2326    Symbol.DOUBLE_FLOAT_NEGATIVE_EPSILON.initializeConstant(new DoubleFloat((double)5.551115123125784E-17));
2327    Symbol.LONG_FLOAT_NEGATIVE_EPSILON.initializeConstant(new DoubleFloat((double)5.551115123125784E-17));
2328    Symbol.MOST_POSITIVE_SHORT_FLOAT.initializeConstant(new SingleFloat(Float.MAX_VALUE));
2329    Symbol.MOST_POSITIVE_SINGLE_FLOAT.initializeConstant(new SingleFloat(Float.MAX_VALUE));
2330    Symbol.MOST_POSITIVE_DOUBLE_FLOAT.initializeConstant(new DoubleFloat(Double.MAX_VALUE));
2331    Symbol.MOST_POSITIVE_LONG_FLOAT.initializeConstant(new DoubleFloat(Double.MAX_VALUE));
2332    Symbol.LEAST_POSITIVE_SHORT_FLOAT.initializeConstant(new SingleFloat(Float.MIN_VALUE));
2333    Symbol.LEAST_POSITIVE_SINGLE_FLOAT.initializeConstant(new SingleFloat(Float.MIN_VALUE));
2334    Symbol.LEAST_POSITIVE_DOUBLE_FLOAT.initializeConstant(new DoubleFloat(Double.MIN_VALUE));
2335    Symbol.LEAST_POSITIVE_LONG_FLOAT.initializeConstant(new DoubleFloat(Double.MIN_VALUE));
2336    Symbol.LEAST_POSITIVE_NORMALIZED_SHORT_FLOAT.initializeConstant(new SingleFloat(1.17549435e-38f));
2337    Symbol.LEAST_POSITIVE_NORMALIZED_SINGLE_FLOAT.initializeConstant(new SingleFloat(1.17549435e-38f));
2338    Symbol.LEAST_POSITIVE_NORMALIZED_DOUBLE_FLOAT.initializeConstant(new DoubleFloat(2.2250738585072014e-308d));
2339    Symbol.LEAST_POSITIVE_NORMALIZED_LONG_FLOAT.initializeConstant(new DoubleFloat(2.2250738585072014e-308d));
2340    Symbol.MOST_NEGATIVE_SHORT_FLOAT.initializeConstant(new SingleFloat(- Float.MAX_VALUE));
2341    Symbol.MOST_NEGATIVE_SINGLE_FLOAT.initializeConstant(new SingleFloat(- Float.MAX_VALUE));
2342    Symbol.MOST_NEGATIVE_DOUBLE_FLOAT.initializeConstant(new DoubleFloat(- Double.MAX_VALUE));
2343    Symbol.MOST_NEGATIVE_LONG_FLOAT.initializeConstant(new DoubleFloat(- Double.MAX_VALUE));
2344    Symbol.LEAST_NEGATIVE_SHORT_FLOAT.initializeConstant(new SingleFloat(- Float.MIN_VALUE));
2345    Symbol.LEAST_NEGATIVE_SINGLE_FLOAT.initializeConstant(new SingleFloat(- Float.MIN_VALUE));
2346    Symbol.LEAST_NEGATIVE_DOUBLE_FLOAT.initializeConstant(new DoubleFloat(- Double.MIN_VALUE));
2347    Symbol.LEAST_NEGATIVE_LONG_FLOAT.initializeConstant(new DoubleFloat(- Double.MIN_VALUE));
2348    Symbol.LEAST_NEGATIVE_NORMALIZED_SHORT_FLOAT.initializeConstant(new SingleFloat(-1.17549435e-38f));
2349    Symbol.LEAST_NEGATIVE_NORMALIZED_SINGLE_FLOAT.initializeConstant(new SingleFloat(-1.17549435e-38f));
2350    Symbol.LEAST_NEGATIVE_NORMALIZED_DOUBLE_FLOAT.initializeConstant(new DoubleFloat(-2.2250738585072014e-308d));
2351    Symbol.LEAST_NEGATIVE_NORMALIZED_LONG_FLOAT.initializeConstant(new DoubleFloat(-2.2250738585072014e-308d));
2352  }
2353
2354  static
2355  {
2356    Symbol.BOOLE_CLR.initializeConstant(Fixnum.ZERO);
2357    Symbol.BOOLE_SET.initializeConstant(Fixnum.ONE);
2358    Symbol.BOOLE_1.initializeConstant(Fixnum.TWO);
2359    Symbol.BOOLE_2.initializeConstant(Fixnum.constants[3]);
2360    Symbol.BOOLE_C1.initializeConstant(Fixnum.constants[4]);
2361    Symbol.BOOLE_C2.initializeConstant(Fixnum.constants[5]);
2362    Symbol.BOOLE_AND.initializeConstant(Fixnum.constants[6]);
2363    Symbol.BOOLE_IOR.initializeConstant(Fixnum.constants[7]);
2364    Symbol.BOOLE_XOR.initializeConstant(Fixnum.constants[8]);
2365    Symbol.BOOLE_EQV.initializeConstant(Fixnum.constants[9]);
2366    Symbol.BOOLE_NAND.initializeConstant(Fixnum.constants[10]);
2367    Symbol.BOOLE_NOR.initializeConstant(Fixnum.constants[11]);
2368    Symbol.BOOLE_ANDC1.initializeConstant(Fixnum.constants[12]);
2369    Symbol.BOOLE_ANDC2.initializeConstant(Fixnum.constants[13]);
2370    Symbol.BOOLE_ORC1.initializeConstant(Fixnum.constants[14]);
2371    Symbol.BOOLE_ORC2.initializeConstant(Fixnum.constants[15]);
2372  }
2373
2374  static
2375  {
2376    // ### call-arguments-limit
2377    Symbol.CALL_ARGUMENTS_LIMIT.initializeConstant(Fixnum.constants[50]);
2378  }
2379
2380  static
2381  {
2382    // ### lambda-parameters-limit
2383    Symbol.LAMBDA_PARAMETERS_LIMIT.initializeConstant(Fixnum.constants[50]);
2384  }
2385
2386  static
2387  {
2388    // ### multiple-values-limit
2389    Symbol.MULTIPLE_VALUES_LIMIT.initializeConstant(Fixnum.constants[20]);
2390  }
2391
2392  static
2393  {
2394    // ### internal-time-units-per-second
2395    Symbol.INTERNAL_TIME_UNITS_PER_SECOND.initializeConstant(Fixnum.getInstance(1000));
2396  }
2397
2398  // ### call-registers-limit
2399  public static final Symbol CALL_REGISTERS_LIMIT =
2400    exportConstant("CALL-REGISTERS-LIMIT", PACKAGE_SYS,
2401                   Fixnum.constants[CALL_REGISTERS_MAX]);
2402
2403  // ### *warn-on-redefinition*
2404  public static final Symbol _WARN_ON_REDEFINITION_ =
2405    exportSpecial("*WARN-ON-REDEFINITION*", PACKAGE_EXT, T);
2406
2407  // ### *saved-backtrace*
2408  public static final Symbol _SAVED_BACKTRACE_ =
2409    exportSpecial("*SAVED-BACKTRACE*", PACKAGE_EXT, NIL);
2410
2411  // ### *batch-mode*
2412  public static final Symbol _BATCH_MODE_ =
2413    exportSpecial("*BATCH-MODE*", PACKAGE_EXT, NIL);
2414
2415  // ### *noinform*
2416  public static final Symbol _NOINFORM_ =
2417    exportSpecial("*NOINFORM*", PACKAGE_SYS, NIL);
2418
2419  // ### *disassembler*
2420  public static final Symbol _DISASSEMBLER_ =
2421    exportSpecial("*DISASSEMBLER*", PACKAGE_EXT,
2422                  new SimpleString("jad -a -p")); // or "jad -dis -p"
2423
2424  // ### *speed* compiler policy
2425  public static final Symbol _SPEED_ =
2426    exportSpecial("*SPEED*", PACKAGE_SYS, Fixnum.ONE);
2427
2428  // ### *space* compiler policy
2429  public static final Symbol _SPACE_ =
2430    exportSpecial("*SPACE*", PACKAGE_SYS, Fixnum.ONE);
2431
2432  // ### *safety* compiler policy
2433  public static final Symbol _SAFETY_ =
2434    exportSpecial("*SAFETY*", PACKAGE_SYS, Fixnum.ONE);
2435
2436  // ### *debug* compiler policy
2437  public static final Symbol _DEBUG_ =
2438    exportSpecial("*DEBUG*", PACKAGE_SYS, Fixnum.ONE);
2439
2440  // ### *explain* compiler policy
2441  public static final Symbol _EXPLAIN_ =
2442    exportSpecial("*EXPLAIN*", PACKAGE_SYS, NIL);
2443
2444  // ### *enable-inline-expansion*
2445  public static final Symbol _ENABLE_INLINE_EXPANSION_ =
2446    exportSpecial("*ENABLE-INLINE-EXPANSION*", PACKAGE_EXT, T);
2447
2448  // ### *require-stack-frame*
2449  public static final Symbol _REQUIRE_STACK_FRAME_ =
2450    exportSpecial("*REQUIRE-STACK-FRAME*", PACKAGE_EXT, NIL);
2451
2452  static
2453  {
2454    Symbol.SUPPRESS_COMPILER_WARNINGS.initializeSpecial(NIL);
2455  }
2456
2457  public static final Symbol _COMPILE_FILE_ENVIRONMENT_ =
2458    exportSpecial("*COMPILE-FILE-ENVIRONMENT*", PACKAGE_SYS, NIL);
2459
2460  public static final LispObject UNBOUND_VALUE = new LispObject()
2461    {
2462      @Override
2463      public String writeToString()
2464      {
2465        return "#<UNBOUND>";
2466      }
2467    };
2468
2469  public static final LispObject NULL_VALUE = new LispObject()
2470    {
2471      @Override
2472      public String writeToString()
2473      {
2474        return "null";
2475      }
2476    };
2477
2478  public static final Symbol _SLOT_UNBOUND_ =
2479    exportConstant("+SLOT-UNBOUND+", PACKAGE_SYS, UNBOUND_VALUE);
2480
2481  public static final Symbol _CL_PACKAGE_ =
2482    exportConstant("+CL-PACKAGE+", PACKAGE_SYS, PACKAGE_CL);
2483
2484  public static final Symbol _KEYWORD_PACKAGE_ =
2485    exportConstant("+KEYWORD-PACKAGE+", PACKAGE_SYS, PACKAGE_KEYWORD);
2486
2487  // ### *backquote-count*
2488  public static final Symbol _BACKQUOTE_COUNT_ =
2489    internSpecial("*BACKQUOTE-COUNT*", PACKAGE_SYS, Fixnum.ZERO);
2490
2491  // ### *bq-vector-flag*
2492  public static final Symbol _BQ_VECTOR_FLAG_ =
2493    internSpecial("*BQ-VECTOR-FLAG*", PACKAGE_SYS, list(new Symbol("bqv")));
2494
2495  // ### *traced-names*
2496  public static final Symbol _TRACED_NAMES_ =
2497    exportSpecial("*TRACED-NAMES*", PACKAGE_SYS, NIL);
2498
2499  // Floating point traps.
2500  protected static boolean TRAP_OVERFLOW  = true;
2501  protected static boolean TRAP_UNDERFLOW = true;
2502
2503
2504  // Extentions
2505  static {
2506    Symbol._INSPECTOR_HOOK_.initializeSpecial(NIL);
2507  }
2508
2509  private static final void loadClass(String className)
2510  {
2511    try
2512      {
2513        Class.forName(className);
2514      }
2515    catch (ClassNotFoundException e)
2516      {
2517        e.printStackTrace();
2518      }
2519  }
2520
2521  static
2522  {
2523    loadClass("org.armedbear.lisp.Primitives");
2524    loadClass("org.armedbear.lisp.SpecialOperators");
2525    loadClass("org.armedbear.lisp.Extensions");
2526    loadClass("org.armedbear.lisp.CompiledClosure");
2527    loadClass("org.armedbear.lisp.Autoload");
2528    loadClass("org.armedbear.lisp.AutoloadMacro");
2529    loadClass("org.armedbear.lisp.cxr");
2530    loadClass("org.armedbear.lisp.Do");
2531    loadClass("org.armedbear.lisp.dolist");
2532    loadClass("org.armedbear.lisp.dotimes");
2533    loadClass("org.armedbear.lisp.Pathname");
2534    loadClass("org.armedbear.lisp.LispClass");
2535    loadClass("org.armedbear.lisp.BuiltInClass");
2536    loadClass("org.armedbear.lisp.StructureObject");
2537    loadClass("org.armedbear.lisp.ash");
2538    loadClass("org.armedbear.lisp.Java");
2539    cold = false;
2540  }
2541}
Note: See TracBrowser for help on using the repository browser.