source: branches/1.0.x/abcl/src/org/armedbear/lisp/Stream.java

Last change on this file was 13772, checked in by Mark Evenson, 13 years ago

backport r13768 to fix #193 for the abcl-1.0.2 release.

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