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

Last change on this file was 13721, checked in by Mark Evenson, 14 years ago

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