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