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

Last change on this file was 14378, checked in by Mark Evenson, 12 years ago

Backport r14369 | mevenson | 2013-02-13 20:01:20 +0100 (Wed, 13 Feb 2013) | 7 lines

Implementation of autoloader for SETF generalized references.

Fixes #296. Fixes #266. Fixes #228.

For forms which set the symbol properties of SETF-EXPANDER or
SETF-FUNCTION to function definitions, places stub of type
AutoloadGeneralizedReference? to be resolved when first invoked.

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