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

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

Narrow LISP-ERROR to STORAGE-CONDITION.

Now JRUN-EXCEPTION-PROTECTED behaves like INTERACTIVE-EVAL which
should be correct.

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