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

Last change on this file was 13274, checked in by ehuelsmann, 14 years ago

Fix 147: *PRINT-CASE* setting affects COMPILE-FILE.

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