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