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

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

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