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

Last change on this file was 14552, checked in by ehuelsmann, 12 years ago

Inline calls to jrun-exception-protected
(used by handler-bind to catch out of memory conditions).

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