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

Last change on this file was 12155, checked in by Mark Evenson, 16 years ago

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