source: trunk/abcl/src/org/armedbear/lisp/Lisp.java

Last change on this file was 15770, checked in by Mark Evenson, 22 months ago

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