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

Last change on this file was 12255, checked in by ehuelsmann, 16 years ago

Rename ConditionThrowable? to ControlTransfer? and remove

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