Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

Lisp.java

Visit:

Last change on this file was 15770, checked in by Mark Evenson, 4 months ago
Have coerceToPathname use Gray stream PATHNAME generic
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 111.2 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: