1 /* 2 * Stream.java 3 * 4 * Copyright (C) 2003-2007 Peter Graves 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 static org.armedbear.lisp.Lisp.*; 37 38 import java.io.BufferedInputStream; 39 import java.io.BufferedOutputStream; 40 import java.io.IOException; 41 import java.io.InputStream; 42 import java.io.OutputStream; 43 import java.io.OutputStreamWriter; 44 import java.io.PrintWriter; 45 import java.io.PushbackReader; 46 import java.io.Reader; 47 import java.io.StringWriter; 48 import java.io.Writer; 49 import java.math.BigInteger; 50 import java.nio.charset.Charset; 51 import java.util.BitSet; 52 53 import java.util.List; 54 import java.util.LinkedList; 55 import java.util.SortedMap; 56 import java.util.Set; 57 58 import org.armedbear.lisp.util.DecodingReader; 59 60 /** The stream class 61 * 62 * A base class for all Lisp built-in streams. 63 * 64 */ 65 public class Stream extends StructureObject { 66 protected LispObject elementType; 67 protected boolean isInputStream; 68 protected boolean isOutputStream; 69 protected boolean isCharacterStream; 70 protected boolean isBinaryStream; 71 72 private boolean pastEnd = false; 73 private boolean interactive; 74 private boolean open = true; 75 76 // Character input. 77 protected PushbackReader reader; 78 protected int offset; 79 protected int lineNumber; 80 81 // Character output. 82 private Writer writer; 83 84 /** The number of characters on the current line of output 85 * 86 * Used to determine whether additional line feeds are 87 * required when calling FRESH-LINE 88 */ 89 protected int charPos; 90 91 public enum EolStyle { 92 RAW, 93 CR, 94 CRLF, 95 LF 96 } 97 98 static final protected Symbol keywordDefault = internKeyword("DEFAULT"); 99 100 static final private Symbol keywordCodePage = internKeyword("CODE-PAGE"); 101 static final private Symbol keywordID = internKeyword("ID"); 102 103 static final private Symbol keywordEolStyle = internKeyword("EOL-STYLE"); 104 static final private Symbol keywordCR = internKeyword("CR"); 105 static final private Symbol keywordLF = internKeyword("LF"); 106 static final private Symbol keywordCRLF = internKeyword("CRLF"); 107 static final private Symbol keywordRAW = internKeyword("RAW"); 108 109 public final static EolStyle platformEolStyle = Utilities.isPlatformWindows ? EolStyle.CRLF : EolStyle.LF; 110 111 protected EolStyle eolStyle = platformEolStyle; 112 protected char eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n'; 113 protected LispObject externalFormat = keywordDefault; 114 protected String encoding = null; 115 protected char lastChar = 0; 116 117 // Binary input. 118 private InputStream in; 119 120 // Binary output. 121 private OutputStream out; 122 Stream(Symbol structureClass)123 protected Stream(Symbol structureClass) { 124 super(structureClass); 125 } 126 Stream(Symbol structureClass, InputStream stream)127 public Stream(Symbol structureClass, InputStream stream) { 128 this(structureClass); 129 initAsBinaryInputStream(stream); 130 } 131 Stream(Symbol structureClass, Reader r)132 public Stream(Symbol structureClass, Reader r) { 133 this(structureClass); 134 initAsCharacterInputStream(r); 135 } 136 Stream(Symbol structureClass, OutputStream stream)137 public Stream(Symbol structureClass, OutputStream stream) { 138 this(structureClass); 139 initAsBinaryOutputStream(stream); 140 } 141 Stream(Symbol structureClass, Writer w)142 public Stream(Symbol structureClass, Writer w) { 143 this(structureClass); 144 initAsCharacterOutputStream(w); 145 } 146 Stream(Symbol structureClass, InputStream inputStream, LispObject elementType)147 public Stream(Symbol structureClass, InputStream inputStream, LispObject elementType) { 148 this(structureClass, inputStream, elementType, keywordDefault); 149 } 150 151 152 153 // Input stream constructors. Stream(Symbol structureClass, InputStream inputStream, LispObject elementType, LispObject format)154 public Stream(Symbol structureClass, InputStream inputStream, 155 LispObject elementType, LispObject format) { 156 this(structureClass); 157 this.elementType = elementType; 158 setExternalFormat(format); 159 160 if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR) { 161 Reader r = 162 new DecodingReader(inputStream, 4096, 163 (encoding == null) 164 ? Charset.defaultCharset() 165 : Charset.forName(encoding)); 166 initAsCharacterInputStream(r); 167 } else { 168 isBinaryStream = true; 169 InputStream stream = new BufferedInputStream(inputStream); 170 initAsBinaryInputStream(stream); 171 } 172 } 173 Stream(Symbol structureClass, InputStream inputStream, LispObject elementType, boolean interactive)174 public Stream(Symbol structureClass, InputStream inputStream, LispObject elementType, boolean interactive) { 175 this(structureClass, inputStream, elementType); 176 setInteractive(interactive); 177 } 178 Stream(Symbol structureClass, OutputStream outputStream, LispObject elementType)179 public Stream(Symbol structureClass, OutputStream outputStream, LispObject elementType) { 180 this(structureClass, outputStream, elementType, keywordDefault); 181 } 182 183 // Output stream constructors. Stream(Symbol structureClass, OutputStream outputStream, LispObject elementType, LispObject format)184 public Stream(Symbol structureClass, OutputStream outputStream, LispObject elementType, LispObject format) { 185 this(structureClass); 186 this.elementType = elementType; 187 setExternalFormat(format); 188 if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR) { 189 Writer w = 190 (encoding == null) ? 191 new OutputStreamWriter(outputStream) 192 : new OutputStreamWriter(outputStream, 193 Charset.forName(encoding).newEncoder()); 194 initAsCharacterOutputStream(w); 195 } else { 196 OutputStream stream = new BufferedOutputStream(outputStream); 197 initAsBinaryOutputStream(stream); 198 } 199 } 200 Stream(Symbol structureClass, OutputStream outputStream, LispObject elementType, boolean interactive)201 public Stream(Symbol structureClass, OutputStream outputStream, 202 LispObject elementType, 203 boolean interactive) { 204 this(structureClass, outputStream, elementType); 205 setInteractive(interactive); 206 } 207 initAsCharacterInputStream(Reader reader)208 protected void initAsCharacterInputStream(Reader reader) { 209 if (! (reader instanceof PushbackReader)) 210 this.reader = new PushbackReader(reader, 5); 211 else 212 this.reader = (PushbackReader)reader; 213 214 isInputStream = true; 215 isCharacterStream = true; 216 } 217 initAsBinaryInputStream(InputStream in)218 protected void initAsBinaryInputStream(InputStream in) { 219 this.in = in; 220 isInputStream = true; 221 isBinaryStream = true; 222 } 223 initAsCharacterOutputStream(Writer writer)224 protected void initAsCharacterOutputStream(Writer writer) { 225 this.writer = writer; 226 isOutputStream = true; 227 isCharacterStream = true; 228 } 229 initAsBinaryOutputStream(OutputStream out)230 protected void initAsBinaryOutputStream(OutputStream out) { 231 this.out = out; 232 isOutputStream = true; 233 isBinaryStream = true; 234 } 235 isInputStream()236 public boolean isInputStream() { 237 return isInputStream; 238 } 239 isOutputStream()240 public boolean isOutputStream() { 241 return isOutputStream; 242 } 243 isCharacterInputStream()244 public boolean isCharacterInputStream() { 245 return isCharacterStream && isInputStream; 246 } 247 isBinaryInputStream()248 public boolean isBinaryInputStream() { 249 return isBinaryStream && isInputStream; 250 } 251 isCharacterOutputStream()252 public boolean isCharacterOutputStream() { 253 return isCharacterStream && isOutputStream; 254 } 255 isBinaryOutputStream()256 public boolean isBinaryOutputStream() { 257 return isBinaryStream && isOutputStream; 258 } 259 isInteractive()260 public boolean isInteractive() { 261 return interactive; 262 } 263 setInteractive(boolean b)264 public void setInteractive(boolean b) { 265 interactive = b; 266 } 267 getExternalFormat()268 public LispObject getExternalFormat() { 269 return externalFormat; 270 } 271 getEncoding()272 public String getEncoding() { 273 return encoding; 274 } 275 setExternalFormat(LispObject format)276 public void setExternalFormat(LispObject format) { 277 // make sure we encode any remaining buffers with the current format 278 finishOutput(); 279 280 if (format == keywordDefault) { 281 encoding = null; 282 eolStyle = platformEolStyle; 283 eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n'; 284 externalFormat = format; 285 return; 286 } 287 288 LispObject enc; 289 boolean encIsCp = false; 290 291 if (format instanceof Cons) { 292 // meaning a non-empty list 293 enc = format.car(); 294 if (enc == keywordCodePage) { 295 encIsCp = true; 296 297 enc = getf(format.cdr(), keywordID, null); 298 } 299 300 LispObject eol = getf(format.cdr(), keywordEolStyle, keywordRAW); 301 if (eol == keywordCR) 302 eolStyle = EolStyle.CR; 303 else if (eol == keywordLF) 304 eolStyle = EolStyle.LF; 305 else if (eol == keywordCRLF) 306 eolStyle = EolStyle.CRLF; 307 else if (eol != keywordRAW) 308 ; //###FIXME: raise an error 309 310 } else 311 enc = format; 312 313 if (enc.numberp()) 314 encoding = enc.toString(); 315 else if (enc instanceof AbstractString) 316 encoding = enc.getStringValue(); 317 else if (enc == keywordDefault) 318 // This allows the user to use the encoding determined by 319 // Java to be the default for the current environment 320 // while still being able to set other stream options 321 // (e.g. :EOL-STYLE) 322 encoding = null; 323 else if (enc instanceof Symbol) 324 encoding = ((Symbol)enc).getName(); 325 else 326 ; //###FIXME: raise an error! 327 328 if (encIsCp) 329 encoding = "Cp" + encoding; 330 331 eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n'; 332 externalFormat = format; 333 334 if (reader != null 335 && reader instanceof DecodingReader) 336 ((DecodingReader)reader).setCharset(Charset.forName(encoding)); 337 } 338 339 public static final Primitive STREAM_EXTERNAL_FORMAT = new pf_stream_external_format(); 340 @DocString( 341 name="stream-external-format", 342 args="stream", 343 doc="Returns the external format of STREAM." 344 ) 345 private static final class pf_stream_external_format extends Primitive { pf_stream_external_format()346 pf_stream_external_format() { 347 super("stream-external-format", "stream"); 348 } execute(LispObject arg)349 public LispObject execute(LispObject arg) { 350 if (arg instanceof Stream) { 351 return ((Stream)arg).getExternalFormat(); 352 } else { 353 return type_error(arg, Symbol.STREAM); 354 } 355 } 356 } 357 358 // DEFSETF-ed in 'setf.lisp' 359 public static final Primitive SET_STREAM_EXTERNAL_FORMAT = new pf__set_stream_external_format(); 360 @DocString( 361 name="%set-stream-external-format", 362 args="stream format" 363 ) 364 private static final class pf__set_stream_external_format extends Primitive { pf__set_stream_external_format()365 pf__set_stream_external_format() { 366 super("%set-stream-external-format", 367 PACKAGE_SYS, false, "stream external-format"); 368 } execute(LispObject stream, LispObject format)369 public LispObject execute(LispObject stream, LispObject format) { 370 Stream s = checkStream(stream); 371 s.setExternalFormat(format); 372 return format; 373 } 374 }; 375 376 public static final Primitive AVAILABLE_ENCODINGS = new pf_available_encodings(); 377 @DocString(name="available-encodings", 378 returns="encodings", 379 doc="Returns all charset encodings suitable for passing to a stream constructor available at runtime.") 380 private static final class pf_available_encodings extends Primitive { pf_available_encodings()381 pf_available_encodings() { 382 super("available-encodings", PACKAGE_SYS, true); 383 } execute()384 public LispObject execute() { 385 LispObject result = NIL; 386 for (Symbol encoding : availableEncodings()) { 387 result = result.push(encoding); 388 } 389 return result.nreverse(); 390 } 391 } 392 availableEncodings()393 static public List<Symbol> availableEncodings() { 394 List<Symbol> result = new LinkedList<Symbol>(); 395 396 SortedMap<String, Charset> available = Charset.availableCharsets(); 397 Set<String> encodings = available.keySet(); 398 for (String charset : encodings) { 399 result.add (PACKAGE_KEYWORD.intern (charset)); 400 } 401 return result; 402 } 403 isOpen()404 public boolean isOpen() { 405 return open; 406 } 407 setOpen(boolean b)408 public void setOpen(boolean b) { 409 open = b; 410 } 411 412 @Override typeOf()413 public LispObject typeOf() { 414 return Symbol.SYSTEM_STREAM; 415 } 416 417 @Override classOf()418 public LispObject classOf() { 419 return BuiltInClass.SYSTEM_STREAM; 420 } 421 422 @Override typep(LispObject typeSpecifier)423 public LispObject typep(LispObject typeSpecifier) { 424 if (typeSpecifier == Symbol.SYSTEM_STREAM) 425 return T; 426 if (typeSpecifier == Symbol.STREAM) 427 return T; 428 if (typeSpecifier == BuiltInClass.STREAM) 429 return T; 430 return super.typep(typeSpecifier); 431 } 432 getElementType()433 public LispObject getElementType() { 434 return elementType; 435 } 436 437 // Character input. getOffset()438 public int getOffset() { 439 return offset; 440 } 441 442 // Character input. getLineNumber()443 public final int getLineNumber() { 444 return lineNumber; 445 } 446 setWriter(Writer writer)447 protected void setWriter(Writer writer) { 448 this.writer = writer; 449 } 450 451 // Character output. getCharPos()452 public int getCharPos() { 453 return charPos; 454 } 455 456 // Character output. setCharPos(int n)457 public void setCharPos(int n) { 458 charPos = n; 459 } 460 461 /** Class to abstract readtable access 462 * 463 * Many of the functions below (used to) exist in 2 variants. 464 * One with hardcoded access to the FaslReadtable, the other 465 * with hardcoded access to the *readtable* variable. 466 * 467 * In order to prevent code duplication, 468 * this class abstracts access. 469 */ 470 public static abstract class ReadtableAccessor { 471 /** Given the thread passed, return the applicable readtable. */ rt(LispThread thread)472 public abstract Readtable rt(LispThread thread); 473 } 474 475 /** pre-instantiated readtable accessor for the *readtable*. */ 476 public static ReadtableAccessor currentReadtable 477 = new ReadtableAccessor() 478 { 479 public Readtable rt(LispThread thread) 480 { 481 return 482 (Readtable)Symbol.CURRENT_READTABLE.symbolValue(thread); 483 } 484 }; 485 486 /** pre-instantiated readtable accessor for the fasl readtable. */ 487 public static ReadtableAccessor faslReadtable 488 = new ReadtableAccessor() 489 { 490 public Readtable rt(LispThread thread) 491 { 492 return FaslReadtable.getInstance(); 493 } 494 }; 495 496 read(boolean eofError, LispObject eofValue, boolean recursive, LispThread thread, ReadtableAccessor rta)497 public LispObject read(boolean eofError, LispObject eofValue, 498 boolean recursive, LispThread thread, 499 ReadtableAccessor rta) 500 { 501 LispObject result = readPreservingWhitespace(eofError, eofValue, 502 recursive, thread, rta); 503 if (result != eofValue && !recursive) { 504 try { 505 if (_charReady()) { 506 int n = _readChar(); 507 if (n >= 0) { 508 char c = (char) n; // ### BUG: Codepoint conversion 509 Readtable rt = rta.rt(thread); 510 if (!rt.isWhitespace(c)) 511 _unreadChar(c); 512 } 513 } 514 } catch (IOException e) { 515 return error(new StreamError(this, e)); 516 } 517 } 518 if (!eofError && result == eofValue) return result; 519 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 520 return NIL; 521 else 522 return result; 523 } 524 525 // ### *sharp-equal-alist* 526 // internal symbol 527 private static final Symbol _SHARP_EQUAL_ALIST_ = 528 internSpecial("*SHARP-EQUAL-ALIST*", PACKAGE_SYS, NIL); 529 private static final Symbol _SHARP_SHARP_ALIST_ = 530 internSpecial("*SHARP-SHARP-ALIST*", PACKAGE_SYS, NIL); 531 readPreservingWhitespace(boolean eofError, LispObject eofValue, boolean recursive, LispThread thread, ReadtableAccessor rta)532 public LispObject readPreservingWhitespace(boolean eofError, 533 LispObject eofValue, 534 boolean recursive, 535 LispThread thread, 536 ReadtableAccessor rta) 537 538 { 539 if (recursive) { 540 final Readtable rt = rta.rt(thread); 541 while (true) { 542 int n = -1; 543 try { 544 n = _readChar(); 545 } catch (IOException e) { 546 Debug.trace(e); 547 error(new StreamError(this, e)); 548 } 549 if (n < 0) { 550 if (eofError) 551 return error(new EndOfFile(this)); 552 else 553 return eofValue; 554 } 555 char c = (char) n; // ### BUG: Codepoint conversion 556 if (rt.isWhitespace(c)) 557 continue; 558 LispObject result = processChar(thread, c, rt); 559 if (result != null) 560 return result; 561 } 562 } else { 563 final SpecialBindingsMark mark = thread.markSpecialBindings(); 564 thread.bindSpecial(_SHARP_EQUAL_ALIST_, NIL); 565 thread.bindSpecial(_SHARP_SHARP_ALIST_, NIL); 566 try { 567 return readPreservingWhitespace(eofError, eofValue, true, 568 thread, rta); 569 } finally { 570 thread.resetSpecialBindings(mark); 571 } 572 } 573 } 574 575 /** Dispatch macro function if 'c' has one associated, 576 * read a token otherwise. 577 * 578 * When the macro function returns zero values, this function 579 * returns null or the token or returned value otherwise. 580 */ processChar(LispThread thread, char c, Readtable rt)581 private final LispObject processChar(LispThread thread, 582 char c, Readtable rt) 583 { 584 final LispObject handler = rt.getReaderMacroFunction(c); 585 LispObject value; 586 587 if (handler instanceof ReaderMacroFunction) { 588 thread._values = null; 589 value = ((ReaderMacroFunction)handler).execute(this, c); 590 } 591 else if (handler != null && handler != NIL) { 592 thread._values = null; 593 value = handler.execute(this, LispCharacter.getInstance(c)); 594 } 595 else 596 return readToken(c, rt); 597 598 // If we're looking at zero return values, set 'value' to null 599 if (value == NIL) { 600 LispObject[] values = thread._values; 601 if (values != null && values.length == 0) { 602 value = null; 603 thread._values = null; // reset 'no values' indicator 604 } 605 } 606 return value; 607 } 608 readPathname(ReadtableAccessor rta)609 public LispObject readPathname(ReadtableAccessor rta) { 610 LispObject obj = read(true, NIL, false, 611 LispThread.currentThread(), rta); 612 if (obj instanceof AbstractString) { 613 return Pathname.parseNamestring((AbstractString)obj); 614 } 615 if (obj.listp()) 616 return Pathname.makePathname(obj); 617 return error(new TypeError("#p requires a string argument.")); 618 } 619 readSymbol()620 public LispObject readSymbol() { 621 final Readtable rt = 622 (Readtable) Symbol.CURRENT_READTABLE.symbolValue(LispThread.currentThread()); 623 return readSymbol(rt); 624 } 625 readSymbol(Readtable rt)626 public LispObject readSymbol(Readtable rt) { 627 final StringBuilder sb = new StringBuilder(); 628 final BitSet flags = _readToken(sb, rt); 629 return new Symbol(rt.getReadtableCase() == Keyword.INVERT 630 ? invert(sb.toString(), flags) 631 : sb.toString()); 632 } 633 readStructure(ReadtableAccessor rta)634 public LispObject readStructure(ReadtableAccessor rta) { 635 final LispThread thread = LispThread.currentThread(); 636 LispObject obj = read(true, NIL, true, thread, rta); 637 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 638 return NIL; 639 if (obj.listp()) { 640 Symbol structure = checkSymbol(obj.car()); 641 LispClass c = LispClass.findClass(structure); 642 if (!(c instanceof StructureClass)) 643 return error(new ReaderError(structure.getName() + 644 " is not a defined structure type.", 645 this)); 646 LispObject args = obj.cdr(); 647 Symbol DEFSTRUCT_DEFAULT_CONSTRUCTOR = 648 PACKAGE_SYS.intern("DEFSTRUCT-DEFAULT-CONSTRUCTOR"); 649 LispObject constructor = 650 DEFSTRUCT_DEFAULT_CONSTRUCTOR.getSymbolFunctionOrDie().execute(structure); 651 final int length = args.length(); 652 if ((length % 2) != 0) 653 return error(new ReaderError("Odd number of keyword arguments following #S: " + 654 obj.princToString(), 655 this)); 656 LispObject[] array = new LispObject[length]; 657 LispObject rest = args; 658 for (int i = 0; i < length; i += 2) { 659 LispObject key = rest.car(); 660 if (key instanceof Symbol && ((Symbol)key).getPackage() == PACKAGE_KEYWORD) { 661 array[i] = key; 662 } else { 663 array[i] = PACKAGE_KEYWORD.intern(javaString(key)); 664 } 665 array[i + 1] = rest.cadr(); 666 rest = rest.cddr(); 667 } 668 return funcall(constructor.getSymbolFunctionOrDie(), array, 669 thread); 670 } 671 return error(new ReaderError("Non-list following #S: " + 672 obj.princToString(), 673 this)); 674 } 675 readString(char terminator, ReadtableAccessor rta)676 public LispObject readString(char terminator, ReadtableAccessor rta) 677 { 678 final LispThread thread = LispThread.currentThread(); 679 final Readtable rt = rta.rt(thread); 680 StringBuilder sb = new StringBuilder(); 681 try 682 { 683 while (true) { 684 int n = _readChar(); 685 if (n < 0) 686 return error(new EndOfFile(this)); 687 688 char c = (char) n; // ### BUG: Codepoint conversion 689 if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { 690 // Single escape. 691 n = _readChar(); 692 if (n < 0) 693 return error(new EndOfFile(this)); 694 695 sb.append((char)n); // ### BUG: Codepoint conversion 696 continue; 697 } 698 if (c == terminator) 699 break; 700 // Default. 701 sb.append(c); 702 } 703 } 704 catch (java.io.IOException e) 705 { 706 //error(new EndOfFile(stream)); 707 return new SimpleString(sb); 708 } 709 return new SimpleString(sb); 710 } 711 readList(boolean requireProperList, ReadtableAccessor rta)712 public LispObject readList(boolean requireProperList, 713 ReadtableAccessor rta) 714 { 715 final LispThread thread = LispThread.currentThread(); 716 Cons first = null; 717 Cons last = null; 718 Readtable rt; 719 try { 720 while (true) { 721 rt = rta.rt(thread); 722 char c = flushWhitespace(rt); 723 if (c == ')') { 724 return first == null ? NIL : first; 725 } 726 if (c == '.') { 727 int n = _readChar(); 728 if (n < 0) 729 return error(new EndOfFile(this)); 730 char nextChar = (char) n; // ### BUG: Codepoint conversion 731 if (isTokenDelimiter(nextChar, rt)) { 732 if (last == null) { 733 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 734 return NIL; 735 else 736 return error(new ReaderError("Nothing appears before . in list.", 737 this)); 738 } 739 _unreadChar(nextChar); 740 LispObject obj = read(true, NIL, true, thread, rta); 741 if (requireProperList) { 742 if (!obj.listp()) 743 error(new ReaderError("The value " + 744 obj.princToString() + 745 " is not of type " + 746 Symbol.LIST.princToString() + ".", 747 this)); 748 } 749 last.cdr = obj; 750 continue; 751 } 752 // normal token beginning with '.' 753 _unreadChar(nextChar); 754 } 755 756 LispObject obj = processChar(thread, c, rt); 757 if (obj == null) 758 continue; 759 760 761 if (first == null) { 762 first = new Cons(obj); 763 last = first; 764 } else { 765 Cons newCons = new Cons(obj); 766 last.cdr = newCons; 767 last = newCons; 768 } 769 } 770 } catch (IOException e) { 771 error(new StreamError(this, e)); 772 return null; 773 } 774 } 775 isTokenDelimiter(char c, Readtable rt)776 private static final boolean isTokenDelimiter(char c, Readtable rt) 777 778 { 779 byte type = rt.getSyntaxType(c); 780 781 return type == Readtable.SYNTAX_TYPE_TERMINATING_MACRO || 782 type == Readtable.SYNTAX_TYPE_WHITESPACE; 783 784 } 785 readDispatchChar(char dispChar, ReadtableAccessor rta)786 public LispObject readDispatchChar(char dispChar, 787 ReadtableAccessor rta) 788 { 789 int numArg = -1; 790 char c = 0; 791 try { 792 while (true) { 793 int n = _readChar(); 794 if (n < 0) 795 return error(new EndOfFile(this)); 796 c = (char) n; // ### BUG: Codepoint conversion 797 if (c < '0' || c > '9') 798 break; 799 if (numArg < 0) 800 numArg = 0; 801 numArg = numArg * 10 + c - '0'; 802 } 803 } catch (IOException e) { 804 error(new StreamError(this, e)); 805 } 806 final LispThread thread = LispThread.currentThread(); 807 final Readtable rt = rta.rt(thread); 808 LispObject fun = rt.getDispatchMacroCharacter(dispChar, c); 809 if (fun != NIL) { 810 LispObject result; 811 812 thread._values = null; 813 if (fun instanceof DispatchMacroFunction) 814 return ((DispatchMacroFunction)fun).execute(this, c, numArg); 815 else 816 return 817 thread.execute(fun, this, LispCharacter.getInstance(c), 818 (numArg < 0) ? NIL : Fixnum.getInstance(numArg)); 819 } 820 821 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 822 return null; 823 824 return error(new ReaderError("No dispatch function defined for #\\" + c, 825 this)); 826 } 827 readSharpLeftParen(char c, int n, ReadtableAccessor rta)828 public LispObject readSharpLeftParen(char c, int n, 829 ReadtableAccessor rta) 830 { 831 final LispThread thread = LispThread.currentThread(); 832 LispObject list = readList(true, rta); 833 if (_BACKQUOTE_COUNT_.symbolValue(thread).zerop()) { 834 if (n >= 0) { 835 LispObject[] array = new LispObject[n]; 836 for (int i = 0; i < n; i++) { 837 array[i] = list.car(); 838 if (list.cdr() != NIL) 839 list = list.cdr(); 840 } 841 return new SimpleVector(array); 842 } else 843 return new SimpleVector(list); 844 } 845 return new Cons(_BQ_VECTOR_FLAG_.symbolValue(thread), list); 846 } 847 readSharpStar(char ignored, int n, ReadtableAccessor rta)848 public LispObject readSharpStar(char ignored, int n, 849 ReadtableAccessor rta) 850 { 851 final LispThread thread = LispThread.currentThread(); 852 final Readtable rt = rta.rt(thread); 853 854 final boolean suppress = 855 (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL); 856 StringBuilder sb = new StringBuilder(); 857 try 858 { 859 while (true) { 860 int ch = _readChar(); 861 if (ch < 0) 862 break; 863 char c = (char) ch; 864 if (c == '0' || c == '1') 865 sb.append(c); 866 else { 867 int syntaxType = rt.getSyntaxType(c); 868 if (syntaxType == Readtable.SYNTAX_TYPE_WHITESPACE || 869 syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) { 870 _unreadChar(c); 871 break; 872 } else if (!suppress) { 873 String name = LispCharacter.charToName(c); 874 if (name == null) 875 name = "#\\" + c; 876 error(new ReaderError("Illegal element for bit-vector: " + name, 877 this)); 878 } 879 } 880 } 881 } 882 catch (java.io.IOException e) 883 { 884 error(new ReaderError("IO error: ", 885 this)); 886 return NIL; 887 } 888 889 if (suppress) 890 return NIL; 891 if (n >= 0) { 892 // n was supplied. 893 final int length = sb.length(); 894 if (length == 0) { 895 if (n > 0) 896 return error(new ReaderError("No element specified for bit vector of length " + 897 n + '.', 898 this)); 899 } 900 if (n > length) { 901 final char c = sb.charAt(length - 1); 902 for (int i = length; i < n; i++) 903 sb.append(c); 904 } else if (n < length) { 905 return error(new ReaderError("Bit vector is longer than specified length: #" + 906 n + '*' + sb.toString(), 907 this)); 908 } 909 } 910 return new SimpleBitVector(sb.toString()); 911 } 912 913 readSharpDot(char c, int n, ReadtableAccessor rta)914 public LispObject readSharpDot(char c, int n, 915 ReadtableAccessor rta) 916 { 917 final LispThread thread = LispThread.currentThread(); 918 if (Symbol.READ_EVAL.symbolValue(thread) == NIL) 919 return error(new ReaderError("Can't read #. when *READ-EVAL* is NIL.", 920 this)); 921 else 922 return eval(read(true, NIL, true, thread, rta), 923 new Environment(), thread); 924 } 925 readCharacterLiteral(Readtable rt, LispThread thread)926 public LispObject readCharacterLiteral(Readtable rt, LispThread thread) 927 928 { 929 try { 930 int n = _readChar(); 931 if (n < 0) 932 return error(new EndOfFile(this)); 933 char c = (char) n; // ### BUG: Codepoint conversion 934 StringBuilder sb = new StringBuilder(String.valueOf(c)); 935 while (true) { 936 n = _readChar(); 937 if (n < 0) 938 break; 939 c = (char) n; // ### BUG: Codepoint conversion 940 if (rt.isWhitespace(c)) 941 break; 942 if (rt.getSyntaxType(c) == 943 Readtable.SYNTAX_TYPE_TERMINATING_MACRO) { 944 _unreadChar(c); 945 break; 946 } 947 sb.append(c); 948 } 949 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 950 return NIL; 951 if (sb.length() == 1) 952 return LispCharacter.getInstance(sb.charAt(0)); 953 String token = sb.toString(); 954 n = LispCharacter.nameToChar(token); 955 if (n >= 0) 956 return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion 957 return error(new LispError("Unrecognized character name: \"" + token + '"')); 958 } catch (IOException e) { 959 return error(new StreamError(this, e)); 960 } 961 } 962 skipBalancedComment()963 public void skipBalancedComment() { 964 try { 965 while (true) { 966 int n = _readChar(); 967 if (n < 0) 968 return; 969 if (n == '|') { 970 n = _readChar(); 971 if (n == '#') 972 return; 973 else 974 _unreadChar(n); 975 } else if (n == '#') { 976 n = _readChar(); 977 if (n == '|') 978 skipBalancedComment(); // Nested comment. Recurse! 979 else 980 _unreadChar(n); 981 } 982 } 983 } catch (IOException e) { 984 error(new StreamError(this, e)); 985 } 986 } 987 readArray(int rank, ReadtableAccessor rta)988 public LispObject readArray(int rank, ReadtableAccessor rta) { 989 final LispThread thread = LispThread.currentThread(); 990 LispObject obj = read(true, NIL, true, thread, rta); 991 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 992 return NIL; 993 switch (rank) { 994 case -1: 995 return error(new ReaderError("No dimensions argument to #A.", this)); 996 case 0: 997 return new ZeroRankArray(T, obj, false); 998 case 1: { 999 if (obj.listp() || obj instanceof AbstractVector) 1000 return new SimpleVector(obj); 1001 return error(new ReaderError(obj.princToString() + " is not a sequence.", 1002 this)); 1003 } 1004 default: 1005 return new SimpleArray_T(rank, obj); 1006 } 1007 } 1008 readComplex(ReadtableAccessor rta)1009 public LispObject readComplex(ReadtableAccessor rta) { 1010 final LispThread thread = LispThread.currentThread(); 1011 LispObject obj = read(true, NIL, true, thread, rta); 1012 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 1013 return NIL; 1014 if (obj instanceof Cons && obj.length() == 2) 1015 return Complex.getInstance(obj.car(), obj.cadr()); 1016 // Error. 1017 StringBuilder sb = new StringBuilder("Invalid complex number format"); 1018 if (this instanceof FileStream) { 1019 Pathname p = ((FileStream)this).getPathname(); 1020 if (p != null) { 1021 String namestring = p.getNamestring(); 1022 if (namestring != null) { 1023 sb.append(" in #P\""); 1024 sb.append(namestring); 1025 sb.append('"'); 1026 } 1027 } 1028 sb.append(" at offset "); 1029 sb.append(_getFilePosition()); 1030 } 1031 sb.append(": #C"); 1032 sb.append(obj.printObject()); 1033 return error(new ReaderError(sb.toString(), this)); 1034 } 1035 readMultipleEscape(Readtable rt)1036 private String readMultipleEscape(Readtable rt) { 1037 StringBuilder sb = new StringBuilder(); 1038 try { 1039 while (true) { 1040 int n = _readChar(); 1041 if (n < 0) 1042 return serror(new EndOfFile(this)); 1043 1044 char c = (char) n; // ### BUG: Codepoint conversion 1045 byte syntaxType = rt.getSyntaxType(c); 1046 if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { 1047 n = _readChar(); 1048 if (n < 0) 1049 return serror(new EndOfFile(this)); 1050 1051 sb.append((char)n); // ### BUG: Codepoint conversion 1052 continue; 1053 } 1054 if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) 1055 break; 1056 sb.append(c); 1057 } 1058 } catch (IOException e) { 1059 return serror(new StreamError(this, e)); 1060 } 1061 return sb.toString(); 1062 } 1063 findUnescapedSingleColon(String s, BitSet flags)1064 private static final int findUnescapedSingleColon(String s, BitSet flags) { 1065 if (flags == null) 1066 return s.indexOf(':'); 1067 final int limit = s.length(); 1068 for (int i = 0; i < limit; i++) { 1069 if (s.charAt(i) == ':' && !flags.get(i)) { 1070 return i; 1071 } 1072 } 1073 return -1; 1074 } 1075 findUnescapedDoubleColon(String s, BitSet flags)1076 private static final int findUnescapedDoubleColon(String s, BitSet flags) { 1077 if (flags == null) 1078 return s.indexOf("::"); 1079 final int limit = s.length() - 1; 1080 for (int i = 0; i < limit; i++) { 1081 if (s.charAt(i) == ':' && !flags.get(i)) { 1082 if (s.charAt(i + 1) == ':' && !flags.get(i + 1)) { 1083 return i; 1084 } 1085 } 1086 } 1087 return -1; 1088 } 1089 readToken(char c, Readtable rt)1090 private final LispObject readToken(char c, Readtable rt) 1091 1092 { 1093 StringBuilder sb = new StringBuilder(String.valueOf(c)); 1094 final LispThread thread = LispThread.currentThread(); 1095 BitSet flags = _readToken(sb, rt); 1096 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 1097 return NIL; 1098 final LispObject readtableCase = rt.getReadtableCase(); 1099 final String token = sb.toString(); 1100 final boolean invert = readtableCase == Keyword.INVERT; 1101 final int length = token.length(); 1102 if (length > 0) { 1103 final char firstChar = token.charAt(0); 1104 if (flags == null) { 1105 if (firstChar == '.') { 1106 // Section 2.3.3: "If a token consists solely of dots (with 1107 // no escape characters), then an error of type READER- 1108 // ERROR is signaled, except in one circumstance: if the 1109 // token is a single dot and appears in a situation where 1110 // dotted pair notation permits a dot, then it is accepted 1111 // as part of such syntax and no error is signaled." 1112 boolean ok = false; 1113 for (int i = length; i-- > 1;) { 1114 if (token.charAt(i) != '.') { 1115 ok = true; 1116 break; 1117 } 1118 } 1119 if (!ok) { 1120 final String message; 1121 if (length > 1) 1122 message = "Too many dots."; 1123 else 1124 message = "Dot context error."; 1125 return error(new ReaderError(message, this)); 1126 } 1127 } 1128 final int radix = getReadBase(thread); 1129 if ("+-.0123456789".indexOf(firstChar) >= 0) { 1130 LispObject number = makeNumber(token, length, radix); 1131 if (number != null) 1132 return number; 1133 } else if (Character.digit(firstChar, radix) >= 0) { 1134 LispObject number = makeNumber(token, length, radix); 1135 if (number != null) 1136 return number; 1137 } 1138 } 1139 1140 String symbolName; 1141 String packageName = null; 1142 BitSet symbolFlags; 1143 BitSet packageFlags = null; 1144 Package pkg = null; 1145 boolean internSymbol = true; 1146 if (firstChar == ':' && (flags == null || !flags.get(0))) { 1147 symbolName = token.substring(1); 1148 pkg = PACKAGE_KEYWORD; 1149 if (flags != null) 1150 symbolFlags = flags.get(1, flags.size()); 1151 else 1152 symbolFlags = null; 1153 } else { 1154 int index = findUnescapedDoubleColon(token, flags); 1155 if (index > 0) { 1156 packageName = token.substring(0, index); 1157 packageFlags = (flags != null) ? flags.get(0, index) : null; 1158 symbolName = token.substring(index + 2); 1159 symbolFlags = (flags != null) ? flags.get(index+2, flags.size()) : null; 1160 } else { 1161 index = findUnescapedSingleColon(token, flags); 1162 if (index > 0) { 1163 packageName = token.substring(0, index); 1164 packageFlags = (flags != null) ? flags.get(0, index) : null; 1165 symbolName = token.substring(index + 1); 1166 symbolFlags = (flags != null) ? flags.get(index+2, flags.size()) : null; 1167 internSymbol = false; 1168 } else { 1169 pkg = (Package)Symbol._PACKAGE_.symbolValue(thread); 1170 symbolName = token; 1171 symbolFlags = flags; 1172 } 1173 } 1174 } 1175 if (pkg == null) { 1176 if (invert) 1177 packageName = invert(packageName, packageFlags); 1178 1179 pkg = getCurrentPackage().findPackage(packageName); 1180 if (pkg == null) 1181 return error(new ReaderError("The package \"" + packageName + "\" can't be found.", this)); 1182 } 1183 if (invert) 1184 symbolName = invert(symbolName, symbolFlags); 1185 1186 if (internSymbol) { 1187 return pkg.intern(symbolName); 1188 } else { 1189 Symbol symbol = pkg.findExternalSymbol(symbolName); 1190 if (symbol != null) 1191 return symbol; 1192 1193 // Error! 1194 if (pkg.findInternalSymbol(symbolName) != null) { 1195 return error(new ReaderError("The symbol \"~A\" is not external in package ~A.", 1196 this, 1197 new SimpleString(symbolName), 1198 new SimpleString(packageName))); 1199 } else { 1200 return error(new ReaderError("The symbol \"~A\" was not found in package ~A.", 1201 this, 1202 new SimpleString(symbolName), 1203 new SimpleString(packageName))); 1204 } 1205 } 1206 } else { // token.length == 0 1207 Package pkg = (Package)Symbol._PACKAGE_.symbolValue(thread); 1208 return pkg.intern(""); 1209 } 1210 } 1211 _readToken(StringBuilder sb, Readtable rt)1212 private final BitSet _readToken(StringBuilder sb, Readtable rt) 1213 1214 { 1215 BitSet flags = null; 1216 final LispObject readtableCase = rt.getReadtableCase(); 1217 if (sb.length() > 0) { 1218 Debug.assertTrue(sb.length() == 1); 1219 char c = sb.charAt(0); 1220 byte syntaxType = rt.getSyntaxType(c); 1221 if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { 1222 int n = -1; 1223 try { 1224 n = _readChar(); 1225 } catch (IOException e) { 1226 error(new StreamError(this, e)); 1227 return flags; 1228 } 1229 if (n < 0) { 1230 error(new EndOfFile(this)); 1231 return null; // Not reached 1232 } 1233 1234 sb.setCharAt(0, (char) n); // ### BUG: Codepoint conversion 1235 flags = new BitSet(1); 1236 flags.set(0); 1237 } else if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) { 1238 sb.setLength(0); 1239 sb.append(readMultipleEscape(rt)); 1240 flags = new BitSet(sb.length()); 1241 flags.set(0, sb.length()); 1242 } else if (rt.isInvalid(c)) { 1243 rt.checkInvalid(c, this); // Signals a reader-error. 1244 } else if (readtableCase == Keyword.UPCASE) { 1245 sb.setCharAt(0, LispCharacter.toUpperCase(c)); 1246 } else if (readtableCase == Keyword.DOWNCASE) { 1247 sb.setCharAt(0, LispCharacter.toLowerCase(c)); 1248 } 1249 } 1250 try { 1251 while (true) { 1252 int n = _readChar(); 1253 if (n < 0) 1254 break; 1255 char c = (char) n; // ### BUG: Codepoint conversion 1256 if (rt.isWhitespace(c)) { 1257 _unreadChar(n); 1258 break; 1259 } 1260 byte syntaxType = rt.getSyntaxType(c); 1261 if (syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) { 1262 _unreadChar(c); 1263 break; 1264 } 1265 rt.checkInvalid(c, this); 1266 if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { 1267 n = _readChar(); 1268 if (n < 0) 1269 break; 1270 sb.append((char)n); // ### BUG: Codepoint conversion 1271 if (flags == null) 1272 flags = new BitSet(sb.length()); 1273 flags.set(sb.length() - 1); 1274 continue; 1275 } 1276 if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) { 1277 int begin = sb.length(); 1278 sb.append(readMultipleEscape(rt)); 1279 int end = sb.length(); 1280 if (flags == null) 1281 flags = new BitSet(sb.length()); 1282 flags.set(begin, end); 1283 continue; 1284 } 1285 if (readtableCase == Keyword.UPCASE) 1286 c = LispCharacter.toUpperCase(c); 1287 else if (readtableCase == Keyword.DOWNCASE) 1288 c = LispCharacter.toLowerCase(c); 1289 sb.append(c); 1290 } 1291 } catch (IOException e) { 1292 error(new StreamError(this, e)); 1293 return flags; 1294 } 1295 1296 return flags; 1297 } 1298 invert(String s, BitSet flags)1299 public static final String invert(String s, BitSet flags) { 1300 // Section 23.1.2: "When the readtable case is :INVERT, then if all of 1301 // the unescaped letters in the extended token are of the same case, 1302 // those (unescaped) letters are converted to the opposite case." 1303 final int limit = s.length(); 1304 final int LOWER = 1; 1305 final int UPPER = 2; 1306 int state = 0; 1307 for (int i = 0; i < limit; i++) { 1308 // We only care about unescaped characters. 1309 if (flags != null && flags.get(i)) 1310 continue; 1311 char c = s.charAt(i); 1312 if (Character.isUpperCase(c)) { 1313 if (state == LOWER) 1314 return s; // Mixed case. 1315 state = UPPER; 1316 } 1317 if (Character.isLowerCase(c)) { 1318 if (state == UPPER) 1319 return s; // Mixed case. 1320 state = LOWER; 1321 } 1322 } 1323 StringBuilder sb = new StringBuilder(limit); 1324 for (int i = 0; i < limit; i++) { 1325 char c = s.charAt(i); 1326 if (flags != null && flags.get(i)) // Escaped. 1327 sb.append(c); 1328 else if (Character.isUpperCase(c)) 1329 sb.append(Character.toLowerCase(c)); 1330 else if (Character.isLowerCase(c)) 1331 sb.append(Character.toUpperCase(c)); 1332 else 1333 sb.append(c); 1334 } 1335 return sb.toString(); 1336 } 1337 getReadBase(LispThread thread)1338 private static final int getReadBase(LispThread thread) 1339 1340 { 1341 final int readBase; 1342 final LispObject readBaseObject = Symbol.READ_BASE.symbolValue(thread); 1343 if (readBaseObject instanceof Fixnum) { 1344 readBase = ((Fixnum)readBaseObject).value; 1345 } else 1346 // The value of *READ-BASE* is not a Fixnum. 1347 return ierror(new LispError("The value of *READ-BASE* is not " + 1348 "of type '(INTEGER 2 36).")); 1349 1350 if (readBase < 2 || readBase > 36) 1351 return ierror(new LispError("The value of *READ-BASE* is not " + 1352 "of type '(INTEGER 2 36).")); 1353 1354 return readBase; 1355 } 1356 makeNumber(String token, int length, int radix)1357 private final LispObject makeNumber(String token, int length, int radix) 1358 { 1359 if (length == 0) 1360 return null; 1361 if (token.indexOf('/') >= 0) 1362 return makeRatio(token, radix); 1363 if (token.charAt(length - 1) == '.') { 1364 radix = 10; 1365 token = token.substring(0, --length); 1366 } 1367 boolean numeric = true; 1368 if (radix == 10) { 1369 for (int i = length; i-- > 0;) { 1370 char c = token.charAt(i); 1371 if (c < '0' || c > '9') { 1372 if (i > 0 || (c != '-' && c != '+')) { 1373 numeric = false; 1374 break; 1375 } 1376 } 1377 } 1378 } else { 1379 for (int i = length; i-- > 0;) { 1380 char c = token.charAt(i); 1381 if (Character.digit(c, radix) < 0) { 1382 if (i > 0 || (c != '-' && c != '+')) { 1383 numeric = false; 1384 break; 1385 } 1386 } 1387 } 1388 } 1389 if (!numeric) // Can't be an integer. 1390 return makeFloat(token, length); 1391 if (token.charAt(0) == '+') 1392 token = token.substring(1); 1393 try { 1394 int n = Integer.parseInt(token, radix); 1395 return (n >= 0 && n <= 255) ? Fixnum.constants[n] : Fixnum.getInstance(n); 1396 } catch (NumberFormatException e) {} 1397 // parseInt() failed. 1398 try { 1399 return Bignum.getInstance(token, radix); 1400 } catch (NumberFormatException e) {} 1401 // Not a number. 1402 return null; 1403 } 1404 makeRatio(String token, int radix)1405 private final LispObject makeRatio(String token, int radix) 1406 1407 { 1408 final int index = token.indexOf('/'); 1409 if (index < 0) 1410 return null; 1411 try { 1412 BigInteger numerator = 1413 new BigInteger(token.substring(0, index), radix); 1414 BigInteger denominator = 1415 new BigInteger(token.substring(index + 1), radix); 1416 // Check the denominator here, before calling number(), so we can 1417 // signal a READER-ERROR, as required by ANSI, instead of DIVISION- 1418 // BY-ZERO. 1419 if (denominator.signum() == 0) 1420 error(new ReaderError("Division by zero.", this)); 1421 return number(numerator, denominator); 1422 } catch (NumberFormatException e) { 1423 return null; 1424 } 1425 } 1426 makeFloat(final String token, final int length)1427 private static final LispObject makeFloat(final String token, 1428 final int length) 1429 { 1430 if (length == 0) 1431 return null; 1432 StringBuilder sb = new StringBuilder(); 1433 int i = 0; 1434 boolean maybe = false; 1435 char marker = 0; 1436 char c = token.charAt(i); 1437 if (c == '-' || c == '+') { 1438 sb.append(c); 1439 ++i; 1440 } 1441 while (i < length) { 1442 c = token.charAt(i); 1443 if (c == '.' || (c >= '0' && c <= '9')) { 1444 if (c == '.') 1445 maybe = true; 1446 sb.append(c); 1447 ++i; 1448 } else 1449 break; 1450 } 1451 if (i < length) { 1452 c = token.charAt(i); 1453 if ("esfdlESFDL".indexOf(c) >= 0) { 1454 // Exponent marker. 1455 maybe = true; 1456 marker = LispCharacter.toUpperCase(c); 1457 if (marker == 'S') 1458 marker = 'F'; 1459 else if (marker == 'L') 1460 marker = 'D'; 1461 else if (marker == 'E') { 1462 LispObject format = Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(); 1463 if (format == Symbol.SINGLE_FLOAT || format == Symbol.SHORT_FLOAT) 1464 marker = 'F'; 1465 else 1466 marker = 'D'; 1467 } 1468 sb.append('E'); 1469 ++i; 1470 } 1471 } 1472 if (!maybe) 1473 return null; 1474 // Append rest of token. 1475 sb.append(token.substring(i)); 1476 c = sb.charAt(sb.length()-1); 1477 if (! ('0' <= c && c <= '9')) 1478 // we need to check that the last item is a number: 1479 // the Double.parseDouble routine accepts numbers ending in 'D' 1480 // like 1e2d. The same is true for Float.parseFloat and the 'F' 1481 // character. However, these are not valid Lisp floats. 1482 return null; 1483 try { 1484 if (marker == 0) { 1485 LispObject format = Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(); 1486 if (format == Symbol.SINGLE_FLOAT || format == Symbol.SHORT_FLOAT) 1487 marker = 'F'; 1488 else 1489 marker = 'D'; 1490 } 1491 if (marker == 'D') 1492 return new DoubleFloat(Double.parseDouble(sb.toString())); 1493 else 1494 return new SingleFloat(Float.parseFloat(sb.toString())); 1495 } catch (NumberFormatException e) { 1496 return null; 1497 } 1498 } 1499 readRadix(int radix, ReadtableAccessor rta)1500 public LispObject readRadix(int radix, ReadtableAccessor rta) { 1501 StringBuilder sb = new StringBuilder(); 1502 final LispThread thread = LispThread.currentThread(); 1503 final Readtable rt = rta.rt(thread); 1504 boolean escaped = (_readToken(sb, rt) != null); 1505 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 1506 return NIL; 1507 if (escaped) 1508 return error(new ReaderError("Illegal syntax for number.", this)); 1509 String s = sb.toString(); 1510 if (s.indexOf('/') >= 0) 1511 return makeRatio(s, radix); 1512 // Integer.parseInt() below handles a prefixed '-' character correctly, but 1513 // does not accept a prefixed '+' character, so we skip over it here 1514 if (s.charAt(0) == '+') 1515 s = s.substring(1); 1516 try { 1517 int n = Integer.parseInt(s, radix); 1518 return (n >= 0 && n <= 255) ? Fixnum.constants[n] : Fixnum.getInstance(n); 1519 } catch (NumberFormatException e) {} 1520 // parseInt() failed. 1521 try { 1522 return Bignum.getInstance(s, radix); 1523 } catch (NumberFormatException e) {} 1524 // Not a number. 1525 return error(new LispError()); 1526 } 1527 flushWhitespace(Readtable rt)1528 private char flushWhitespace(Readtable rt) { 1529 try { 1530 while (true) { 1531 int n = _readChar(); 1532 if (n < 0) 1533 return (char)ierror(new EndOfFile(this)); 1534 1535 char c = (char) n; // ### BUG: Codepoint conversion 1536 if (!rt.isWhitespace(c)) 1537 return c; 1538 } 1539 } catch (IOException e) { 1540 error(new StreamError(this, e)); 1541 return 0; 1542 } 1543 } 1544 readDelimitedList(char delimiter)1545 public LispObject readDelimitedList(char delimiter) 1546 1547 { 1548 final LispThread thread = LispThread.currentThread(); 1549 LispObject result = NIL; 1550 while (true) { 1551 Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); 1552 char c = flushWhitespace(rt); 1553 if (c == delimiter) 1554 break; 1555 1556 LispObject obj = processChar(thread, c, rt); 1557 if (obj != null) 1558 result = new Cons(obj, result); 1559 } 1560 if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) 1561 return NIL; 1562 else 1563 return result.nreverse(); 1564 } 1565 1566 // read-line &optional stream eof-error-p eof-value recursive-p 1567 // => line, missing-newline-p 1568 // recursive-p is ignored readLine(boolean eofError, LispObject eofValue)1569 public LispObject readLine(boolean eofError, LispObject eofValue) 1570 1571 { 1572 final LispThread thread = LispThread.currentThread(); 1573 StringBuilder sb = new StringBuilder(); 1574 try { 1575 while (true) { 1576 int n = _readChar(); 1577 if (n < 0) { 1578 if (sb.length() == 0) { 1579 if (eofError) 1580 return error(new EndOfFile(this)); 1581 return thread.setValues(eofValue, T); 1582 } 1583 return thread.setValues(new SimpleString(sb), T); 1584 } 1585 if (n == '\n') 1586 return thread.setValues(new SimpleString(sb), NIL); 1587 else 1588 sb.append((char)n); // ### BUG: Codepoint conversion 1589 } 1590 } catch (IOException e) { 1591 return error(new StreamError(this, e)); 1592 } 1593 } 1594 1595 // read-char &optional stream eof-error-p eof-value recursive-p => char 1596 // recursive-p is ignored readChar()1597 public LispObject readChar() { 1598 try { 1599 int n = _readChar(); 1600 if (n < 0) 1601 return error(new EndOfFile(this)); 1602 return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion 1603 } catch (IOException e) { 1604 return error(new StreamError(this, e)); 1605 } 1606 1607 } 1608 readChar(boolean eofError, LispObject eofValue)1609 public LispObject readChar(boolean eofError, LispObject eofValue) 1610 1611 { 1612 try { 1613 int n = _readChar(); 1614 if (n < 0) { 1615 if (eofError) 1616 return error(new EndOfFile(this)); 1617 else 1618 return eofValue; 1619 } 1620 return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion 1621 } catch (IOException e) { 1622 return error(new StreamError(this, e)); 1623 } 1624 } 1625 1626 // read-char-no-hang &optional stream eof-error-p eof-value recursive-p => char 1627 // recursive-p is ignored readCharNoHang(boolean eofError, LispObject eofValue)1628 public LispObject readCharNoHang(boolean eofError, LispObject eofValue) 1629 1630 { 1631 try { 1632 return _charReady() ? readChar(eofError, eofValue) : NIL; 1633 } catch (IOException e) { 1634 return error(new StreamError(this, e)); 1635 } 1636 } 1637 1638 1639 // unread-char character &optional input-stream => nil unreadChar(LispCharacter c)1640 public LispObject unreadChar(LispCharacter c) { 1641 try { 1642 _unreadChar(c.value); 1643 return NIL; 1644 } catch (IOException e) { 1645 return error(new StreamError(this, e)); 1646 } 1647 } 1648 finishOutput()1649 public LispObject finishOutput() { 1650 _finishOutput(); 1651 return NIL; 1652 } 1653 1654 // clear-input &optional input-stream => nil clearInput()1655 public LispObject clearInput() { 1656 _clearInput(); 1657 return NIL; 1658 } 1659 getFilePosition()1660 public LispObject getFilePosition() { 1661 long pos = _getFilePosition(); 1662 return pos >= 0 ? number(pos) : NIL; 1663 } 1664 setFilePosition(LispObject arg)1665 public LispObject setFilePosition(LispObject arg) { 1666 return _setFilePosition(arg) ? T : NIL; 1667 } 1668 1669 // close stream &key abort => result 1670 // Must return true if stream was open, otherwise implementation-dependent. close(LispObject abort)1671 public LispObject close(LispObject abort) { 1672 _close(); 1673 return T; 1674 } 1675 1676 // read-byte stream &optional eof-error-p eof-value => byte 1677 // Reads an 8-bit byte. readByte(boolean eofError, LispObject eofValue)1678 public LispObject readByte(boolean eofError, LispObject eofValue) 1679 1680 { 1681 int n = _readByte(); 1682 if (n < 0) { 1683 if (eofError) 1684 return error(new EndOfFile(this)); 1685 else 1686 return eofValue; 1687 } 1688 return Fixnum.constants[n]; 1689 } 1690 terpri()1691 public LispObject terpri() { 1692 _writeChar('\n'); 1693 return NIL; 1694 } 1695 freshLine()1696 public LispObject freshLine() { 1697 if (charPos == 0) 1698 return NIL; 1699 _writeChar('\n'); 1700 return T; 1701 } 1702 print(char c)1703 public void print(char c) { 1704 _writeChar(c); 1705 } 1706 1707 // PRIN1 produces output suitable for input to READ. 1708 // Binds *PRINT-ESCAPE* to true. prin1(LispObject obj)1709 public void prin1(LispObject obj) { 1710 LispThread thread = LispThread.currentThread(); 1711 final SpecialBindingsMark mark = thread.markSpecialBindings(); 1712 thread.bindSpecial(Symbol.PRINT_ESCAPE, T); 1713 try { 1714 _writeString(obj.printObject()); 1715 } finally { 1716 thread.resetSpecialBindings(mark); 1717 } 1718 } 1719 listen()1720 public LispObject listen() { 1721 if (pastEnd) 1722 return NIL; 1723 try { 1724 if (isCharacterInputStream()) { 1725 if (! _charReady()) 1726 return NIL; 1727 1728 int n = _readChar(); 1729 if (n < 0) 1730 return NIL; 1731 1732 _unreadChar(n); 1733 1734 return T; 1735 } else if (isInputStream()) { 1736 if (! _byteReady()) 1737 return NIL; 1738 1739 return T; 1740 } else 1741 return error(new StreamError(this, "Not an input stream")); 1742 } catch (IOException e) { 1743 return error(new StreamError(this, e)); 1744 } 1745 } 1746 fileLength()1747 public LispObject fileLength() { 1748 return type_error(this, Symbol.FILE_STREAM); 1749 } 1750 fileStringLength(LispObject arg)1751 public LispObject fileStringLength(LispObject arg) { 1752 if (arg instanceof LispCharacter) { 1753 if (Utilities.isPlatformWindows) { 1754 if (((LispCharacter)arg).value == '\n') 1755 return Fixnum.TWO; 1756 } 1757 return Fixnum.ONE; 1758 } 1759 if (arg instanceof AbstractString) { 1760 if (Utilities.isPlatformWindows) { 1761 int fileStringLength = 0; 1762 char[] chars = ((AbstractString)arg).getStringChars(); 1763 for (int i = chars.length; i-- > 0;) { 1764 if (chars[i] == '\n') 1765 fileStringLength += 2; 1766 else 1767 ++fileStringLength; 1768 } 1769 return number(fileStringLength); 1770 1771 } 1772 return number(arg.length()); 1773 } 1774 return error(new TypeError(arg.princToString() + 1775 " is neither a string nor a character.")); 1776 } 1777 1778 /** Reads a character off an underlying stream 1779 * 1780 * @return a character, or -1 at end-of-file 1781 */ _readChar()1782 protected int _readChar() throws IOException { 1783 if (reader == null) 1784 streamNotCharacterInputStream(); 1785 1786 int n = reader.read(); 1787 1788 if (n < 0) { 1789 pastEnd = true; 1790 return -1; 1791 } 1792 1793 ++offset; 1794 if (n == '\r' && eolStyle == EolStyle.CRLF) { 1795 n = _readChar(); 1796 if (n != '\n') { 1797 _unreadChar(n); 1798 return '\r'; 1799 } else 1800 return '\n'; 1801 } 1802 1803 if (n == eolChar) { 1804 ++lineNumber; 1805 return '\n'; 1806 } 1807 1808 return n; 1809 } 1810 1811 /** Puts a character back into the (underlying) stream 1812 * 1813 * @param n 1814 */ _unreadChar(int n)1815 protected void _unreadChar(int n) throws IOException { 1816 if (reader == null) 1817 streamNotCharacterInputStream(); 1818 1819 --offset; 1820 if (n == '\n') { 1821 n = eolChar; 1822 --lineNumber; 1823 } 1824 1825 reader.unread(n); 1826 pastEnd = false; 1827 } 1828 1829 1830 /** Returns a boolean indicating input readily available 1831 * 1832 * @return true if a character is available 1833 */ _charReady()1834 protected boolean _charReady() throws IOException { 1835 if (reader == null) 1836 streamNotCharacterInputStream(); 1837 return reader.ready(); 1838 } 1839 _byteReady()1840 protected boolean _byteReady() throws IOException { 1841 if (in == null) 1842 streamNotInputStream(); 1843 return (in.available() != 0); 1844 } 1845 1846 /** Writes a character into the underlying stream, 1847 * updating charPos while doing so 1848 * 1849 * @param c 1850 */ _writeChar(char c)1851 public void _writeChar(char c) { 1852 try { 1853 if (c == '\n') { 1854 if (eolStyle == EolStyle.CRLF && lastChar != '\r') 1855 writer.write('\r'); 1856 1857 writer.write(eolChar); 1858 lastChar = eolChar; 1859 writer.flush(); 1860 charPos = 0; 1861 } else { 1862 writer.write(c); 1863 lastChar = c; 1864 ++charPos; 1865 } 1866 } catch (NullPointerException e) { 1867 // writer is null 1868 streamNotCharacterOutputStream(); 1869 } catch (IOException e) { 1870 error(new StreamError(this, e)); 1871 } 1872 } 1873 1874 /** Writes a series of characters in the underlying stream, 1875 * updating charPos while doing so 1876 * 1877 * @param chars 1878 * @param start 1879 * @param end 1880 */ _writeChars(char[] chars, int start, int end)1881 public void _writeChars(char[] chars, int start, int end) 1882 1883 { 1884 try { 1885 if (eolStyle != EolStyle.RAW) { 1886 for (int i = start; i < end; i++) 1887 //###FIXME: the number of writes can be greatly reduced by 1888 // writing the space between newlines as chunks. 1889 _writeChar(chars[i]); 1890 return; 1891 } 1892 1893 writer.write(chars, start, end - start); 1894 if (start < end) 1895 lastChar = chars[end-1]; 1896 1897 int index = -1; 1898 for (int i = end; i-- > start;) { 1899 if (chars[i] == '\n') { 1900 index = i; 1901 break; 1902 } 1903 } 1904 if (index < 0) { 1905 // No newline. 1906 charPos += (end - start); 1907 } else { 1908 charPos = end - (index + 1); 1909 writer.flush(); 1910 } 1911 } catch (NullPointerException e) { 1912 if (writer == null) 1913 streamNotCharacterOutputStream(); 1914 else 1915 throw e; 1916 } catch (IOException e) { 1917 error(new StreamError(this, e)); 1918 } 1919 } 1920 1921 /** Writes a string to the underlying stream, 1922 * updating charPos while doing so 1923 * 1924 * @param s 1925 */ _writeString(String s)1926 public void _writeString(String s) { 1927 try { 1928 _writeChars(s.toCharArray(), 0, s.length()); 1929 } catch (NullPointerException e) { 1930 if (writer == null) 1931 streamNotCharacterOutputStream(); 1932 else 1933 throw e; 1934 } 1935 } 1936 1937 /** Writes a string to the underlying stream, appending 1938 * a new line and updating charPos while doing so 1939 * 1940 * @param s 1941 */ _writeLine(String s)1942 public void _writeLine(String s) { 1943 try { 1944 _writeString(s); 1945 _writeChar('\n'); 1946 } catch (NullPointerException e) { 1947 // writer is null 1948 streamNotCharacterOutputStream(); 1949 } 1950 } 1951 1952 // Reads an 8-bit byte. 1953 /** Reads an 8-bit byte off the underlying stream 1954 * 1955 * @return 1956 */ _readByte()1957 public int _readByte() { 1958 try { 1959 int n = in.read(); 1960 if (n < 0) 1961 pastEnd = true; 1962 1963 return n; // Reads an 8-bit byte. 1964 } catch (IOException e) { 1965 return ierror(new StreamError(this, e)); 1966 } 1967 } 1968 1969 // Writes an 8-bit byte. 1970 /** Writes an 8-bit byte off the underlying stream 1971 * 1972 * @param n 1973 */ _writeByte(int n)1974 public void _writeByte(int n) { 1975 try { 1976 out.write(n); // Writes an 8-bit byte. 1977 } catch (NullPointerException e) { 1978 // out is null 1979 streamNotBinaryOutputStream(); 1980 } catch (IOException e) { 1981 error(new StreamError(this, e)); 1982 } 1983 } 1984 1985 /** Flushes any buffered output in the (underlying) stream 1986 * 1987 */ _finishOutput()1988 public void _finishOutput() { 1989 try { 1990 if (writer != null) 1991 writer.flush(); 1992 if (out != null) 1993 out.flush(); 1994 } catch (IOException e) { 1995 error(new StreamError(this, e)); 1996 } 1997 } 1998 1999 /** Reads all input from the underlying stream, 2000 * until _charReady() indicates no more input to be available 2001 * 2002 */ _clearInput()2003 public void _clearInput() { 2004 if (reader != null) { 2005 int c = 0; 2006 try { 2007 while (_charReady() && (c >= 0)) 2008 c = _readChar(); 2009 } catch (IOException e) { 2010 error(new StreamError(this, e)); 2011 } 2012 } else if (in != null) { 2013 try { 2014 int n = 0; 2015 while (in.available() > 0) 2016 n = in.read(); 2017 2018 if (n < 0) 2019 pastEnd = true; 2020 } catch (IOException e) { 2021 error(new StreamError(this, e)); 2022 } 2023 } 2024 } 2025 2026 /** Returns a (non-negative) file position integer or a negative value 2027 * if the position cannot be determined. 2028 * 2029 * @return non-negative value as a position spec 2030 * @return negative value for 'unspecified' 2031 */ _getFilePosition()2032 protected long _getFilePosition() { 2033 return -1; 2034 } 2035 2036 /** Sets the file position based on a position designator passed in arg 2037 * 2038 * @param arg File position specifier as described in the CLHS 2039 * @return true on success, false on failure 2040 */ _setFilePosition(LispObject arg)2041 protected boolean _setFilePosition(LispObject arg) { 2042 return false; 2043 } 2044 2045 /** Closes the stream and underlying streams 2046 * 2047 */ _close()2048 public void _close() { 2049 try { 2050 if (reader != null) 2051 reader.close(); 2052 if (in != null) 2053 in.close(); 2054 if (writer != null) 2055 writer.close(); 2056 if (out != null) 2057 out.close(); 2058 setOpen(false); 2059 } catch (IOException e) { 2060 error(new StreamError(this, e)); 2061 } 2062 } 2063 printStackTrace(Throwable t)2064 public void printStackTrace(Throwable t) { 2065 StringWriter sw = new StringWriter(); 2066 PrintWriter pw = new PrintWriter(sw); 2067 t.printStackTrace(pw); 2068 try { 2069 writer.write(sw.toString()); 2070 writer.write('\n'); 2071 lastChar = '\n'; 2072 writer.flush(); 2073 charPos = 0; 2074 } catch (IOException e) { 2075 error(new StreamError(this, e)); 2076 } 2077 } 2078 streamNotInputStream()2079 protected LispObject streamNotInputStream() { 2080 return error(new StreamError(this, princToString() + " is not an input stream.")); 2081 } 2082 streamNotCharacterInputStream()2083 protected LispObject streamNotCharacterInputStream() { 2084 return error(new StreamError(this, princToString() + " is not a character input stream.")); 2085 } 2086 streamNotOutputStream()2087 protected LispObject streamNotOutputStream() { 2088 return error(new StreamError(this, princToString() + " is not an output stream.")); 2089 } 2090 streamNotBinaryOutputStream()2091 protected LispObject streamNotBinaryOutputStream() { 2092 return error(new StreamError(this, princToString() + " is not a binary output stream.")); 2093 } 2094 streamNotCharacterOutputStream()2095 protected LispObject streamNotCharacterOutputStream() { 2096 return error(new StreamError(this, princToString() + " is not a character output stream.")); 2097 } 2098 2099 // ### %stream-write-char character output-stream => character 2100 // OUTPUT-STREAM must be a real stream, not an output stream designator! 2101 private static final Primitive _WRITE_CHAR = 2102 new Primitive("%stream-write-char", PACKAGE_SYS, true, 2103 "character output-stream") { 2104 @Override 2105 public LispObject execute(LispObject first, LispObject second) 2106 2107 { 2108 checkStream(second)._writeChar(LispCharacter.getValue(first)); 2109 return first; 2110 } 2111 }; 2112 2113 // ### %write-char character output-stream => character 2114 private static final Primitive _STREAM_WRITE_CHAR = 2115 new Primitive("%write-char", PACKAGE_SYS, false, 2116 "character output-stream") { 2117 @Override 2118 public LispObject execute(LispObject first, LispObject second) 2119 2120 { 2121 final char c = LispCharacter.getValue(first); 2122 if (second == T) 2123 second = Symbol.TERMINAL_IO.symbolValue(); 2124 else if (second == NIL) 2125 second = Symbol.STANDARD_OUTPUT.symbolValue(); 2126 final Stream stream = checkStream(second); 2127 stream._writeChar(c); 2128 return first; 2129 } 2130 }; 2131 2132 // ### %write-string string output-stream start end => string 2133 private static final Primitive _WRITE_STRING = 2134 new Primitive("%write-string", PACKAGE_SYS, false, 2135 "string output-stream start end") { 2136 @Override 2137 public LispObject execute(LispObject first, LispObject second, 2138 LispObject third, LispObject fourth) 2139 2140 { 2141 final AbstractString s = checkString(first); 2142 char[] chars = s.chars(); 2143 final Stream out = outSynonymOf(second); 2144 final int start = Fixnum.getValue(third); 2145 final int end; 2146 if (fourth == NIL) 2147 end = chars.length; 2148 else { 2149 end = Fixnum.getValue(fourth); 2150 } 2151 checkBounds(start, end, chars.length); 2152 out._writeChars(chars, start, end); 2153 return first; 2154 } 2155 }; 2156 2157 // ### %finish-output output-stream => nil 2158 private static final Primitive _FINISH_OUTPUT = 2159 new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream") { 2160 @Override 2161 public LispObject execute(LispObject arg) { 2162 return finishOutput(arg); 2163 } 2164 }; 2165 2166 // ### %force-output output-stream => nil 2167 private static final Primitive _FORCE_OUTPUT = 2168 new Primitive("%force-output", PACKAGE_SYS, false, "output-stream") { 2169 @Override 2170 public LispObject execute(LispObject arg) { 2171 return finishOutput(arg); 2172 } 2173 }; 2174 finishOutput(LispObject arg)2175 static final LispObject finishOutput(LispObject arg) 2176 2177 { 2178 final LispObject out; 2179 if (arg == T) 2180 out = Symbol.TERMINAL_IO.symbolValue(); 2181 else if (arg == NIL) 2182 out = Symbol.STANDARD_OUTPUT.symbolValue(); 2183 else 2184 out = arg; 2185 return checkStream(out).finishOutput(); 2186 } 2187 2188 // ### clear-input &optional input-stream => nil 2189 private static final Primitive CLEAR_INPUT = 2190 new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream") { 2191 @Override 2192 public LispObject execute(LispObject[] args) { 2193 if (args.length > 1) 2194 return error(new WrongNumberOfArgumentsException(this, -1, 1)); 2195 final Stream in; 2196 if (args.length == 0) 2197 in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()); 2198 else 2199 in = inSynonymOf(args[0]); 2200 in.clearInput(); 2201 return NIL; 2202 } 2203 }; 2204 2205 // ### %clear-output output-stream => nil 2206 // "If any of these operations does not make sense for output-stream, then 2207 // it does nothing." 2208 private static final Primitive _CLEAR_OUTPUT = 2209 new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream") { 2210 @Override 2211 public LispObject execute(LispObject arg) { 2212 if (arg == T) // *TERMINAL-IO* 2213 return NIL; 2214 if (arg == NIL) // *STANDARD-OUTPUT* 2215 return NIL; 2216 if (arg instanceof Stream) 2217 return NIL; 2218 return type_error(arg, Symbol.STREAM); 2219 } 2220 }; 2221 2222 // ### close stream &key abort => result 2223 private static final Primitive CLOSE = 2224 new Primitive(Symbol.CLOSE, "stream &key abort") { 2225 @Override 2226 public LispObject execute(LispObject arg) { 2227 return checkStream(arg).close(NIL); 2228 } 2229 2230 @Override 2231 public LispObject execute(LispObject first, LispObject second, 2232 LispObject third) 2233 2234 { 2235 final Stream stream = checkStream(first); 2236 if (second == Keyword.ABORT) 2237 return stream.close(third); 2238 return program_error("Unrecognized keyword argument " 2239 + second.princToString() + "."); 2240 } 2241 }; 2242 2243 // ### out-synonym-of stream-designator => stream 2244 private static final Primitive OUT_SYNONYM_OF = 2245 new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator") { 2246 @Override 2247 public LispObject execute (LispObject arg) { 2248 if (arg instanceof Stream) 2249 return arg; 2250 if (arg == T) 2251 return Symbol.TERMINAL_IO.symbolValue(); 2252 if (arg == NIL) 2253 return Symbol.STANDARD_OUTPUT.symbolValue(); 2254 return arg; 2255 } 2256 }; 2257 2258 // ### write-8-bits 2259 // write-8-bits byte stream => nil 2260 private static final Primitive WRITE_8_BITS = 2261 new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream") { 2262 @Override 2263 public LispObject execute (LispObject first, LispObject second) 2264 2265 { 2266 int n = Fixnum.getValue(first); 2267 if (n < 0 || n > 255) 2268 return type_error(first, UNSIGNED_BYTE_8); 2269 checkStream(second)._writeByte(n); 2270 return NIL; 2271 } 2272 }; 2273 2274 // ### read-8-bits 2275 // read-8-bits stream &optional eof-error-p eof-value => byte 2276 private static final Primitive READ_8_BITS = 2277 new Primitive("read-8-bits", PACKAGE_SYS, true, 2278 "stream &optional eof-error-p eof-value") { 2279 @Override 2280 public LispObject execute (LispObject first, LispObject second, 2281 LispObject third) 2282 2283 { 2284 return checkBinaryInputStream(first).readByte((second != NIL), 2285 third); 2286 } 2287 2288 @Override 2289 public LispObject execute (LispObject[] args) { 2290 int length = args.length; 2291 if (length < 1 || length > 3) 2292 return error(new WrongNumberOfArgumentsException(this, 1, 3)); 2293 final Stream in = checkBinaryInputStream(args[0]); 2294 boolean eofError = length > 1 ? (args[1] != NIL) : true; 2295 LispObject eofValue = length > 2 ? args[2] : NIL; 2296 return in.readByte(eofError, eofValue); 2297 } 2298 }; 2299 2300 // ### read-line &optional input-stream eof-error-p eof-value recursive-p 2301 // => line, missing-newline-p 2302 private static final Primitive READ_LINE = 2303 new Primitive(Symbol.READ_LINE, 2304 "&optional input-stream eof-error-p eof-value recursive-p") { 2305 @Override 2306 public LispObject execute() { 2307 final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(); 2308 final Stream stream = checkStream(obj); 2309 return stream.readLine(true, NIL); 2310 } 2311 @Override 2312 public LispObject execute(LispObject arg) { 2313 if (arg == T) 2314 arg = Symbol.TERMINAL_IO.symbolValue(); 2315 else if (arg == NIL) 2316 arg = Symbol.STANDARD_INPUT.symbolValue(); 2317 final Stream stream = checkStream(arg); 2318 return stream.readLine(true, NIL); 2319 } 2320 @Override 2321 public LispObject execute(LispObject first, LispObject second) 2322 2323 { 2324 if (first == T) 2325 first = Symbol.TERMINAL_IO.symbolValue(); 2326 else if (first == NIL) 2327 first = Symbol.STANDARD_INPUT.symbolValue(); 2328 final Stream stream = checkStream(first); 2329 return stream.readLine(second != NIL, NIL); 2330 } 2331 @Override 2332 public LispObject execute(LispObject first, LispObject second, 2333 LispObject third) 2334 2335 { 2336 if (first == T) 2337 first = Symbol.TERMINAL_IO.symbolValue(); 2338 else if (first == NIL) 2339 first = Symbol.STANDARD_INPUT.symbolValue(); 2340 final Stream stream = checkStream(first); 2341 return stream.readLine(second != NIL, third); 2342 } 2343 @Override 2344 public LispObject execute(LispObject first, LispObject second, 2345 LispObject third, LispObject fourth) 2346 2347 { 2348 // recursive-p is ignored 2349 if (first == T) 2350 first = Symbol.TERMINAL_IO.symbolValue(); 2351 else if (first == NIL) 2352 first = Symbol.STANDARD_INPUT.symbolValue(); 2353 final Stream stream = checkStream(first); 2354 return stream.readLine(second != NIL, third); 2355 } 2356 }; 2357 2358 // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace 2359 // => object, position 2360 private static final Primitive _READ_FROM_STRING = 2361 new Primitive("%read-from-string", PACKAGE_SYS, false) { 2362 @Override 2363 public LispObject execute(LispObject first, LispObject second, 2364 LispObject third, LispObject fourth, 2365 LispObject fifth, LispObject sixth) 2366 2367 { 2368 String s = first.getStringValue(); 2369 boolean eofError = (second != NIL); 2370 boolean preserveWhitespace = (sixth != NIL); 2371 final int startIndex; 2372 if (fourth != NIL) 2373 startIndex = Fixnum.getValue(fourth); 2374 else 2375 startIndex = 0; 2376 final int endIndex; 2377 if (fifth != NIL) 2378 endIndex = Fixnum.getValue(fifth); 2379 else 2380 endIndex = s.length(); 2381 StringInputStream in = 2382 new StringInputStream(s, startIndex, endIndex); 2383 final LispThread thread = LispThread.currentThread(); 2384 LispObject result; 2385 if (preserveWhitespace) 2386 result = in.readPreservingWhitespace(eofError, third, false, 2387 thread, currentReadtable); 2388 else 2389 result = in.read(eofError, third, false, thread, currentReadtable); 2390 return thread.setValues(result, Fixnum.getInstance(in.getOffset())); 2391 } 2392 }; 2393 2394 // ### read &optional input-stream eof-error-p eof-value recursive-p => object 2395 private static final Primitive READ = 2396 new Primitive(Symbol.READ, 2397 "&optional input-stream eof-error-p eof-value recursive-p") { 2398 @Override 2399 public LispObject execute() { 2400 final LispThread thread = LispThread.currentThread(); 2401 final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread); 2402 final Stream stream = checkStream(obj); 2403 return stream.read(true, NIL, false, thread, currentReadtable); 2404 } 2405 @Override 2406 public LispObject execute(LispObject arg) { 2407 final LispThread thread = LispThread.currentThread(); 2408 if (arg == T) 2409 arg = Symbol.TERMINAL_IO.symbolValue(thread); 2410 else if (arg == NIL) 2411 arg = Symbol.STANDARD_INPUT.symbolValue(thread); 2412 final Stream stream = checkStream(arg); 2413 return stream.read(true, NIL, false, thread, currentReadtable); 2414 } 2415 @Override 2416 public LispObject execute(LispObject first, LispObject second) 2417 2418 { 2419 final LispThread thread = LispThread.currentThread(); 2420 if (first == T) 2421 first = Symbol.TERMINAL_IO.symbolValue(thread); 2422 else if (first == NIL) 2423 first = Symbol.STANDARD_INPUT.symbolValue(thread); 2424 final Stream stream = checkStream(first); 2425 return stream.read(second != NIL, NIL, false, thread, currentReadtable); 2426 } 2427 @Override 2428 public LispObject execute(LispObject first, LispObject second, 2429 LispObject third) 2430 2431 { 2432 final LispThread thread = LispThread.currentThread(); 2433 if (first == T) 2434 first = Symbol.TERMINAL_IO.symbolValue(thread); 2435 else if (first == NIL) 2436 first = Symbol.STANDARD_INPUT.symbolValue(thread); 2437 final Stream stream = checkStream(first); 2438 return stream.read(second != NIL, third, false, thread, currentReadtable); 2439 } 2440 @Override 2441 public LispObject execute(LispObject first, LispObject second, 2442 LispObject third, LispObject fourth) 2443 2444 { 2445 final LispThread thread = LispThread.currentThread(); 2446 if (first == T) 2447 first = Symbol.TERMINAL_IO.symbolValue(thread); 2448 else if (first == NIL) 2449 first = Symbol.STANDARD_INPUT.symbolValue(thread); 2450 final Stream stream = checkStream(first); 2451 return stream.read(second != NIL, third, fourth != NIL, 2452 thread, currentReadtable); 2453 } 2454 }; 2455 2456 // ### read-preserving-whitespace 2457 // &optional input-stream eof-error-p eof-value recursive-p => object 2458 private static final Primitive READ_PRESERVING_WHITESPACE = 2459 new Primitive(Symbol.READ_PRESERVING_WHITESPACE, 2460 "&optional input-stream eof-error-p eof-value recursive-p") { 2461 @Override 2462 public LispObject execute(LispObject[] args) { 2463 int length = args.length; 2464 if (length > 4) 2465 return error(new WrongNumberOfArgumentsException(this, -1, 4)); 2466 Stream stream = 2467 length > 0 ? inSynonymOf(args[0]) : getStandardInput(); 2468 boolean eofError = length > 1 ? (args[1] != NIL) : true; 2469 LispObject eofValue = length > 2 ? args[2] : NIL; 2470 boolean recursive = length > 3 ? (args[3] != NIL) : false; 2471 return stream.readPreservingWhitespace(eofError, eofValue, 2472 recursive, 2473 LispThread.currentThread(), 2474 currentReadtable); 2475 } 2476 }; 2477 2478 // ### read-char &optional input-stream eof-error-p eof-value recursive-p 2479 // => char 2480 private static final Primitive READ_CHAR = 2481 new Primitive(Symbol.READ_CHAR, 2482 "&optional input-stream eof-error-p eof-value recursive-p") { 2483 @Override 2484 public LispObject execute() { 2485 return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar(); 2486 } 2487 @Override 2488 public LispObject execute(LispObject arg) { 2489 return inSynonymOf(arg).readChar(); 2490 } 2491 @Override 2492 public LispObject execute(LispObject first, LispObject second) 2493 2494 { 2495 return inSynonymOf(first).readChar(second != NIL, NIL); 2496 } 2497 @Override 2498 public LispObject execute(LispObject first, LispObject second, 2499 LispObject third) 2500 2501 { 2502 return inSynonymOf(first).readChar(second != NIL, third); 2503 } 2504 @Override 2505 public LispObject execute(LispObject first, LispObject second, 2506 LispObject third, LispObject fourth) 2507 2508 { 2509 return inSynonymOf(first).readChar(second != NIL, third); 2510 } 2511 }; 2512 2513 // ### read-char-no-hang &optional input-stream eof-error-p eof-value 2514 // recursive-p => char 2515 private static final Primitive READ_CHAR_NO_HANG = 2516 new Primitive("read-char-no-hang", "&optional input-stream eof-error-p eof-value recursive-p") { 2517 2518 @Override 2519 public LispObject execute(LispObject[] args) { 2520 int length = args.length; 2521 if (length > 4) 2522 error(new WrongNumberOfArgumentsException(this, -1, 4)); 2523 Stream stream = 2524 length > 0 ? inSynonymOf(args[0]) : getStandardInput(); 2525 boolean eofError = length > 1 ? (args[1] != NIL) : true; 2526 LispObject eofValue = length > 2 ? args[2] : NIL; 2527 // recursive-p is ignored 2528 // boolean recursive = length > 3 ? (args[3] != NIL) : false; 2529 return stream.readCharNoHang(eofError, eofValue); 2530 } 2531 }; 2532 2533 // ### read-delimited-list char &optional input-stream recursive-p => list 2534 private static final Primitive READ_DELIMITED_LIST = 2535 new Primitive("read-delimited-list", "char &optional input-stream recursive-p") { 2536 2537 @Override 2538 public LispObject execute(LispObject[] args) { 2539 int length = args.length; 2540 if (length < 1 || length > 3) 2541 error(new WrongNumberOfArgumentsException(this, 1, 3)); 2542 char c = LispCharacter.getValue(args[0]); 2543 Stream stream = 2544 length > 1 ? inSynonymOf(args[1]) : getStandardInput(); 2545 return stream.readDelimitedList(c); 2546 } 2547 }; 2548 2549 2550 // ### unread-char character &optional input-stream => nil 2551 private static final Primitive UNREAD_CHAR = 2552 new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream") { 2553 @Override 2554 public LispObject execute(LispObject arg) { 2555 return getStandardInput().unreadChar(checkCharacter(arg)); 2556 } 2557 @Override 2558 public LispObject execute(LispObject first, LispObject second) 2559 2560 { 2561 Stream stream = inSynonymOf(second); 2562 return stream.unreadChar(checkCharacter(first)); 2563 } 2564 }; 2565 2566 // ### write-vector-unsigned-byte-8 2567 private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 = 2568 new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true, 2569 "vector stream start end") { 2570 @Override 2571 public LispObject execute(LispObject first, LispObject second, 2572 LispObject third, LispObject fourth) 2573 2574 { 2575 final AbstractVector v = checkVector(first); 2576 final Stream stream = checkStream(second); 2577 int start = Fixnum.getValue(third); 2578 int end = Fixnum.getValue(fourth); 2579 for (int i = start; i < end; i++) 2580 stream._writeByte(v.aref(i)); 2581 return v; 2582 } 2583 }; 2584 2585 // ### read-vector-unsigned-byte-8 vector stream start end => position 2586 private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 = 2587 new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true, 2588 "vector stream start end") { 2589 @Override 2590 public LispObject execute(LispObject first, LispObject second, 2591 LispObject third, LispObject fourth) 2592 2593 { 2594 AbstractVector v = checkVector(first); 2595 Stream stream = checkBinaryInputStream(second); 2596 int start = Fixnum.getValue(third); 2597 int end = Fixnum.getValue(fourth); 2598 if (!v.getElementType().equal(UNSIGNED_BYTE_8)) 2599 return type_error(first, list(Symbol.VECTOR, 2600 UNSIGNED_BYTE_8)); 2601 for (int i = start; i < end; i++) { 2602 int n = stream._readByte(); 2603 if (n < 0) { 2604 // End of file. 2605 return Fixnum.getInstance(i); 2606 } 2607 v.aset(i, n); 2608 } 2609 return fourth; 2610 } 2611 }; 2612 2613 // ### file-position 2614 private static final Primitive FILE_POSITION = 2615 new Primitive("file-position", "stream &optional position-spec") { 2616 @Override 2617 public LispObject execute(LispObject arg) { 2618 return checkStream(arg).getFilePosition(); 2619 } 2620 @Override 2621 public LispObject execute(LispObject first, LispObject second) 2622 2623 { 2624 return checkStream(first).setFilePosition(second); 2625 } 2626 }; 2627 2628 // ### stream-line-number 2629 private static final Primitive STREAM_LINE_NUMBER = 2630 new Primitive("stream-line-number", PACKAGE_SYS, false, "stream") { 2631 @Override 2632 public LispObject execute(LispObject arg) { 2633 return Fixnum.getInstance(checkStream(arg).getLineNumber() + 1); 2634 } 2635 }; 2636 2637 // ### stream-offset 2638 private static final Primitive STREAM_OFFSET = 2639 new Primitive("stream-offset", PACKAGE_SYS, false, "stream") { 2640 @Override 2641 public LispObject execute(LispObject arg) { 2642 return number(checkStream(arg).getOffset()); 2643 } 2644 }; 2645 2646 // ### stream-charpos stream => position 2647 private static final Primitive STREAM_CHARPOS = 2648 new Primitive("stream-charpos", PACKAGE_SYS, false) { 2649 @Override 2650 public LispObject execute(LispObject arg) { 2651 Stream stream = checkCharacterOutputStream(arg); 2652 return Fixnum.getInstance(stream.getCharPos()); 2653 } 2654 }; 2655 2656 // ### stream-%set-charpos stream newval => newval 2657 private static final Primitive STREAM_SET_CHARPOS = 2658 new Primitive("stream-%set-charpos", PACKAGE_SYS, false) { 2659 @Override 2660 public LispObject execute(LispObject first, LispObject second) 2661 2662 { 2663 Stream stream = checkCharacterOutputStream(first); 2664 stream.setCharPos(Fixnum.getValue(second)); 2665 return second; 2666 } 2667 }; 2668 getWrappedInputStream()2669 public InputStream getWrappedInputStream() { 2670 return in; 2671 } 2672 getWrappedOutputStream()2673 public OutputStream getWrappedOutputStream() { 2674 return out; 2675 } 2676 getWrappedWriter()2677 public Writer getWrappedWriter() { 2678 return writer; 2679 } 2680 getWrappedReader()2681 public PushbackReader getWrappedReader() { 2682 return reader; 2683 } 2684 2685 } 2686