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