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

Last change on this file was 12810, checked in by Mark Evenson, 15 years ago

PATHNAME without namestring now has a non-printable representation.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 86.7 KB
Line 
1/*
2 * Stream.java
3 *
4 * Copyright (C) 2003-2007 Peter Graves
5 * $Id: Stream.java 12810 2010-07-17 10:26:33Z 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
458    public LispObject readPreservingWhitespace(boolean eofError,
459                                               LispObject eofValue,
460                                               boolean recursive,
461                                               LispThread thread,
462                                               ReadtableAccessor rta)
463
464    {
465        if (recursive) {
466            final Readtable rt = rta.rt(thread);
467            while (true) {
468                int n = -1;
469                try {
470                    n = _readChar();
471                } catch (IOException e) {
472                    Debug.trace(e);
473                    error(new StreamError(this, e));
474                }
475                if (n < 0) {
476                    if (eofError)
477                        return error(new EndOfFile(this));
478                    else
479                        return eofValue;
480                }
481                char c = (char) n; // ### BUG: Codepoint conversion
482                if (rt.isWhitespace(c))
483                    continue;
484                LispObject result = processChar(thread, c, rt);
485                if (result != null)
486                    return result;
487            }
488        } else {
489            final SpecialBindingsMark mark = thread.markSpecialBindings();
490            thread.bindSpecial(_SHARP_EQUAL_ALIST_, NIL);
491            try {
492                return readPreservingWhitespace(eofError, eofValue, true,
493                                                thread, rta);
494            } finally {
495                thread.resetSpecialBindings(mark);
496            }
497        }
498    }
499
500    /** Dispatch macro function if 'c' has one associated,
501     * read a token otherwise.
502     *
503     * When the macro function returns zero values, this function
504     * returns null or the token or returned value otherwise.
505     */
506    private final LispObject processChar(LispThread thread,
507                                         char c, Readtable rt)
508    {
509        final LispObject handler = rt.getReaderMacroFunction(c);
510        LispObject value;
511
512        if (handler instanceof ReaderMacroFunction) {
513            thread._values = null;
514            value = ((ReaderMacroFunction)handler).execute(this, c);
515        }
516        else if (handler != null && handler != NIL) {
517            thread._values = null;
518            value = handler.execute(this, LispCharacter.getInstance(c));
519        }
520        else
521            return readToken(c, rt);
522
523        // If we're looking at zero return values, set 'value' to null
524        if (value == NIL) {
525            LispObject[] values = thread._values;
526            if (values != null && values.length == 0) {
527                value = null;
528                thread._values = null; // reset 'no values' indicator
529            }
530        }
531        return value;
532    }
533
534    public LispObject readPathname(ReadtableAccessor rta) {
535        LispObject obj = read(true, NIL, false,
536                              LispThread.currentThread(), rta);
537        if (obj instanceof AbstractString) {
538            return Pathname.parseNamestring((AbstractString)obj);
539        }
540        if (obj.listp())
541            return Pathname.makePathname(obj);
542        return error(new TypeError("#p requires a string argument."));
543    }
544
545    public LispObject readSymbol() {
546        final Readtable rt =
547            (Readtable) Symbol.CURRENT_READTABLE.symbolValue(LispThread.currentThread());
548        StringBuilder sb = new StringBuilder();
549        _readToken(sb, rt);
550        return new Symbol(sb.toString());
551    }
552
553    public LispObject readSymbol(Readtable rt) {
554        StringBuilder sb = new StringBuilder();
555        _readToken(sb, rt);
556        return new Symbol(sb.toString());
557    }
558
559    public LispObject readStructure(ReadtableAccessor rta) {
560        final LispThread thread = LispThread.currentThread();
561        LispObject obj = read(true, NIL, true, thread, rta);
562        if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
563            return NIL;
564        if (obj.listp()) {
565            Symbol structure = checkSymbol(obj.car());
566            LispClass c = LispClass.findClass(structure);
567            if (!(c instanceof StructureClass))
568                return error(new ReaderError(structure.getName() +
569                                             " is not a defined structure type.",
570                                             this));
571            LispObject args = obj.cdr();
572            Symbol DEFSTRUCT_DEFAULT_CONSTRUCTOR =
573                PACKAGE_SYS.intern("DEFSTRUCT-DEFAULT-CONSTRUCTOR");
574            LispObject constructor =
575                DEFSTRUCT_DEFAULT_CONSTRUCTOR.getSymbolFunctionOrDie().execute(structure);
576            final int length = args.length();
577            if ((length % 2) != 0)
578                return error(new ReaderError("Odd number of keyword arguments following #S: " +
579                                             obj.writeToString(),
580                                             this));
581            LispObject[] array = new LispObject[length];
582            LispObject rest = args;
583            for (int i = 0; i < length; i += 2) {
584                LispObject key = rest.car();
585                if (key instanceof Symbol && ((Symbol)key).getPackage() == PACKAGE_KEYWORD) {
586                    array[i] = key;
587                } else {
588                    array[i] = PACKAGE_KEYWORD.intern(javaString(key));
589                }
590                array[i + 1] = rest.cadr();
591                rest = rest.cddr();
592            }
593            return funcall(constructor.getSymbolFunctionOrDie(), array,
594                           thread);
595        }
596        return error(new ReaderError("Non-list following #S: " +
597                                     obj.writeToString(),
598                                     this));
599    }
600
601    public LispObject readString(char terminator, ReadtableAccessor rta)
602    {
603      final LispThread thread = LispThread.currentThread();
604      final Readtable rt = rta.rt(thread);
605      StringBuilder sb = new StringBuilder();
606      try
607      {
608        while (true) {
609          int n = _readChar();
610          if (n < 0)
611            return error(new EndOfFile(this));
612
613          char c = (char) n; // ### BUG: Codepoint conversion
614          if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
615            // Single escape.
616            n = _readChar();
617            if (n < 0)
618              return error(new EndOfFile(this));
619
620            sb.append((char)n); // ### BUG: Codepoint conversion
621            continue;
622          }
623          if (c == terminator)
624            break;
625          // Default.
626          sb.append(c);
627        }
628      }
629      catch (java.io.IOException e)
630      {
631        //error(new EndOfFile(stream));
632        return new SimpleString(sb);
633      }
634      return new SimpleString(sb);
635    }
636
637    public LispObject readList(boolean requireProperList,
638                               ReadtableAccessor rta)
639    {
640        final LispThread thread = LispThread.currentThread();
641        Cons first = null;
642        Cons last = null;
643        Readtable rt;
644        try {
645            while (true) {
646                rt = rta.rt(thread);
647                char c = flushWhitespace(rt);
648                if (c == ')') {
649                    return first == null ? NIL : first;
650                }
651                if (c == '.') {
652                    int n = _readChar();
653                    if (n < 0)
654                        return error(new EndOfFile(this));
655                    char nextChar = (char) n; // ### BUG: Codepoint conversion
656                    if (isTokenDelimiter(nextChar, rt)) {
657                        if (last == null) {
658                            if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
659                                return NIL;
660                            else
661                                return error(new ReaderError("Nothing appears before . in list.",
662                                                             this));
663                        }
664                        _unreadChar(nextChar);
665                        LispObject obj = read(true, NIL, true, thread, rta);
666                        if (requireProperList) {
667                            if (!obj.listp())
668                                error(new ReaderError("The value " +
669                                                      obj.writeToString() +
670                                                      " is not of type " +
671                                                      Symbol.LIST.writeToString() + ".",
672                                                      this));
673                        }
674                        last.cdr = obj;
675                        continue;
676                    }
677                    // normal token beginning with '.'
678                    _unreadChar(nextChar);
679                }
680
681                LispObject obj = processChar(thread, c, rt);
682                if (obj == null)
683                    continue;
684
685
686                if (first == null) {
687                    first = new Cons(obj);
688                    last = first;
689                } else {
690                    Cons newCons = new Cons(obj);
691                    last.cdr = newCons;
692                    last = newCons;
693                }
694            }
695        } catch (IOException e) {
696            error(new StreamError(this, e));
697            return null;
698        }
699    }
700
701    private static final boolean isTokenDelimiter(char c, Readtable rt)
702
703    {
704        switch (c) {
705        case '"':
706        case '\'':
707        case '(':
708        case ')':
709        case ',':
710        case ';':
711        case '`':
712            return true;
713        default:
714            return rt.isWhitespace(c);
715        }
716    }
717
718    public LispObject readDispatchChar(char dispChar,
719                                       ReadtableAccessor rta)
720    {
721        int numArg = -1;
722        char c = 0;
723        try {
724            while (true) {
725                int n = _readChar();
726                if (n < 0)
727                    return error(new EndOfFile(this));
728                c = (char) n; // ### BUG: Codepoint conversion
729                if (c < '0' || c > '9')
730                    break;
731                if (numArg < 0)
732                    numArg = 0;
733                numArg = numArg * 10 + c - '0';
734            }
735        } catch (IOException e) {
736            error(new StreamError(this, e));
737        }
738        final LispThread thread = LispThread.currentThread();
739        final Readtable rt = rta.rt(thread);
740        LispObject fun = rt.getDispatchMacroCharacter(dispChar, c);
741        if (fun != NIL) {
742            LispObject result;
743
744            thread._values = null;
745            if (fun instanceof DispatchMacroFunction)
746                return ((DispatchMacroFunction)fun).execute(this, c, numArg);
747            else
748                return
749                    thread.execute(fun, this, LispCharacter.getInstance(c),
750                       (numArg < 0) ? NIL : Fixnum.getInstance(numArg));
751        }
752
753        if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
754            return null;
755
756        return error(new ReaderError("No dispatch function defined for #\\" + c,
757                                     this));
758    }
759
760    public LispObject readSharpLeftParen(char c, int n, 
761                                         ReadtableAccessor rta) 
762    {
763        final LispThread thread = LispThread.currentThread();
764        LispObject list = readList(true, rta);
765        if (_BACKQUOTE_COUNT_.symbolValue(thread).zerop()) {
766            if (n >= 0) {
767                LispObject[] array = new LispObject[n];
768                for (int i = 0; i < n; i++) {
769                    array[i] = list.car();
770                    if (list.cdr() != NIL)
771                        list = list.cdr();
772                }
773                return new SimpleVector(array);
774            } else
775                return new SimpleVector(list);
776        }
777        return new Cons(_BQ_VECTOR_FLAG_.symbolValue(thread), list);
778    }
779
780    public LispObject readSharpStar(char ignored, int n, 
781                                    ReadtableAccessor rta) 
782    {
783        final LispThread thread = LispThread.currentThread();
784        final Readtable rt = rta.rt(thread);
785
786        final boolean suppress =
787            (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL);
788        StringBuilder sb = new StringBuilder();
789        try 
790            {
791    while (true) {
792                    int ch = _readChar();
793                    if (ch < 0)
794                        break;
795                    char c = (char) ch;
796                    if (c == '0' || c == '1')
797                        sb.append(c);
798                    else {
799                        int syntaxType = rt.getSyntaxType(c);
800                        if (syntaxType == Readtable.SYNTAX_TYPE_WHITESPACE ||
801                            syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) {
802                            _unreadChar(c);
803                            break;
804                        } else if (!suppress) {
805                            String name = LispCharacter.charToName(c);
806                            if (name == null)
807                                name = "#\\" + c;
808                            error(new ReaderError("Illegal element for bit-vector: " + name,
809                                                  this));
810                        }
811                    }
812    }
813            }
814        catch (java.io.IOException e)
815            {
816    error(new ReaderError("IO error: ",
817              this));
818    return NIL;
819            }
820       
821        if (suppress)
822            return NIL;
823        if (n >= 0) {
824            // n was supplied.
825            final int length = sb.length();
826            if (length == 0) {
827                if (n > 0)
828                    return error(new ReaderError("No element specified for bit vector of length " +
829                                                 n + '.',
830                                                 this));
831            }
832            if (n > length) {
833                final char c = sb.charAt(length - 1);
834                for (int i = length; i < n; i++)
835                    sb.append(c);
836            } else if (n < length) {
837                return error(new ReaderError("Bit vector is longer than specified length: #" +
838                                             n + '*' + sb.toString(),
839                                             this));
840            }
841        }
842        return new SimpleBitVector(sb.toString());
843    }
844
845
846    public LispObject readSharpDot(char c, int n, 
847                                   ReadtableAccessor rta) 
848    {
849        final LispThread thread = LispThread.currentThread();
850        if (Symbol.READ_EVAL.symbolValue(thread) == NIL)
851            return error(new ReaderError("Can't read #. when *READ-EVAL* is NIL.",
852                                         this));
853        else
854            return eval(read(true, NIL, true, thread, rta),
855                        new Environment(), thread);
856    }
857
858    public LispObject readCharacterLiteral(Readtable rt, LispThread thread)
859
860    {
861        try {
862            int n = _readChar();
863            if (n < 0)
864                return error(new EndOfFile(this));
865            char c = (char) n; // ### BUG: Codepoint conversion
866            StringBuilder sb = new StringBuilder(String.valueOf(c));
867            while (true) {
868                n = _readChar();
869                if (n < 0)
870                    break;
871                c = (char) n; // ### BUG: Codepoint conversion
872                if (rt.isWhitespace(c))
873                    break;
874                if (c == '(' || c == ')') {
875                    _unreadChar(c);
876                    break;
877                }
878                sb.append(c);
879            }
880            if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
881                return NIL;
882            if (sb.length() == 1)
883                return LispCharacter.getInstance(sb.charAt(0));
884            String token = sb.toString();
885            n = LispCharacter.nameToChar(token);
886            if (n >= 0)
887                return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion
888            return error(new LispError("Unrecognized character name: \"" + token + '"'));
889        } catch (IOException e) {
890            return error(new StreamError(this, e));
891        }
892    }
893
894    public void skipBalancedComment() {
895        try {
896            while (true) {
897                int n = _readChar();
898                if (n < 0)
899                    return;
900                if (n == '|') {
901                    n = _readChar();
902                    if (n == '#')
903                        return;
904                    else
905                        _unreadChar(n);
906                } else if (n == '#') {
907                    n = _readChar();
908                    if (n == '|')
909                        skipBalancedComment(); // Nested comment. Recurse!
910                    else
911                        _unreadChar(n);
912                }
913            }
914        } catch (IOException e) {
915            error(new StreamError(this, e));
916        }
917    }
918
919    public LispObject readArray(int rank, ReadtableAccessor rta) {
920        final LispThread thread = LispThread.currentThread();
921        LispObject obj = read(true, NIL, true, thread, rta);
922        if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
923            return NIL;
924        switch (rank) {
925        case -1:
926            return error(new ReaderError("No dimensions argument to #A.", this));
927        case 0:
928            return new ZeroRankArray(T, obj, false);
929        case 1: {
930            if (obj.listp() || obj instanceof AbstractVector)
931                return new SimpleVector(obj);
932            return error(new ReaderError(obj.writeToString() + " is not a sequence.",
933                                         this));
934        }
935        default:
936            return new SimpleArray_T(rank, obj);
937        }
938    }
939
940    public LispObject readComplex(ReadtableAccessor rta) {
941        final LispThread thread = LispThread.currentThread();
942        LispObject obj = read(true, NIL, true, thread, rta);
943        if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
944            return NIL;
945        if (obj instanceof Cons && obj.length() == 2)
946            return Complex.getInstance(obj.car(), obj.cadr());
947        // Error.
948        StringBuilder sb = new StringBuilder("Invalid complex number format");
949        if (this instanceof FileStream) {
950            Pathname p = ((FileStream)this).getPathname();
951            if (p != null) {
952                String namestring = p.getNamestring();
953                if (namestring != null) {
954                    sb.append(" in #P\"");
955                    sb.append(namestring);
956                    sb.append('"');
957                }
958            }
959            sb.append(" at offset ");
960            sb.append(_getFilePosition());
961        }
962        sb.append(": #C");
963        sb.append(obj.writeToString());
964        return error(new ReaderError(sb.toString(), this));
965    }
966
967    private String readMultipleEscape(Readtable rt) {
968        StringBuilder sb = new StringBuilder();
969        try {
970            while (true) {
971                int n = _readChar();
972                if (n < 0)
973                    return serror(new EndOfFile(this));
974
975                char c = (char) n; // ### BUG: Codepoint conversion
976                byte syntaxType = rt.getSyntaxType(c);
977                if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
978                    n = _readChar();
979                    if (n < 0)
980                        return serror(new EndOfFile(this));
981
982                    sb.append((char)n); // ### BUG: Codepoint conversion
983                    continue;
984                }
985                if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE)
986                    break;
987                sb.append(c);
988            }
989        } catch (IOException e) {
990            return serror(new StreamError(this, e));
991        }
992        return sb.toString();
993    }
994
995    private static final int findUnescapedSingleColon(String s, BitSet flags) {
996        if (flags == null)
997            return s.indexOf(':');
998        final int limit = s.length();
999        for (int i = 0; i < limit; i++) {
1000            if (s.charAt(i) == ':' && !flags.get(i)) {
1001                return i;
1002            }
1003        }
1004        return -1;
1005    }
1006
1007    private static final int findUnescapedDoubleColon(String s, BitSet flags) {
1008        if (flags == null)
1009            return s.indexOf("::");
1010        final int limit = s.length() - 1;
1011        for (int i = 0; i < limit; i++) {
1012            if (s.charAt(i) == ':' && !flags.get(i)) {
1013                if (s.charAt(i + 1) == ':' && !flags.get(i + 1)) {
1014                    return i;
1015                }
1016            }
1017        }
1018        return -1;
1019    }
1020
1021    private final LispObject readToken(char c, Readtable rt)
1022
1023    {
1024        StringBuilder sb = new StringBuilder(String.valueOf(c));
1025        final LispThread thread = LispThread.currentThread();
1026        BitSet flags = _readToken(sb, rt);
1027        if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
1028            return NIL;
1029        final LispObject readtableCase = rt.getReadtableCase();
1030        final String token;
1031        if (readtableCase == Keyword.INVERT)
1032            token = invert(sb.toString(), flags);
1033        else
1034            token = sb.toString();
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            if (firstChar == ':')
1074                if (flags == null || !flags.get(0))
1075                    return PACKAGE_KEYWORD.intern(token.substring(1));
1076            int index = findUnescapedDoubleColon(token, flags);
1077            if (index > 0) {
1078                String packageName = token.substring(0, index);
1079                String symbolName = token.substring(index + 2);
1080                Package pkg = Packages.findPackage(packageName);
1081                if (pkg == null)
1082                    return error(new LispError("Package \"" + packageName +
1083                                               "\" not found."));
1084                return pkg.intern(symbolName);
1085            }
1086            index = findUnescapedSingleColon(token, flags);
1087            if (index > 0) {
1088                final String packageName = token.substring(0, index);
1089                Package pkg = Packages.findPackage(packageName);
1090                if (pkg == null)
1091                    return error(new PackageError("Package \"" + packageName +
1092                                                  "\" not found."));
1093                final String symbolName = token.substring(index + 1);
1094                final SimpleString s = new SimpleString(symbolName);
1095                Symbol symbol = pkg.findExternalSymbol(s);
1096                if (symbol != null)
1097                    return symbol;
1098                // Error!
1099                if (pkg.findInternalSymbol(s) != null)
1100                    return error(new ReaderError("The symbol \"" + symbolName +
1101                                                 "\" is not external in package " +
1102                                                 packageName + '.',
1103                                                 this));
1104                else
1105                    return error(new ReaderError("The symbol \"" + symbolName +
1106                                                 "\" was not found in package " +
1107                                                 packageName + '.',
1108                                                 this));
1109            }
1110        }
1111        // Intern token in current package.
1112        return ((Package)Symbol._PACKAGE_.symbolValue(thread)).intern(new SimpleString(token));
1113    }
1114
1115    private final BitSet _readToken(StringBuilder sb, Readtable rt)
1116
1117    {
1118        BitSet flags = null;
1119        final LispObject readtableCase = rt.getReadtableCase();
1120        if (sb.length() > 0) {
1121            Debug.assertTrue(sb.length() == 1);
1122            char c = sb.charAt(0);
1123            byte syntaxType = rt.getSyntaxType(c);
1124            if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
1125                int n = -1;
1126                try {
1127                    n = _readChar();
1128                } catch (IOException e) {
1129                    error(new StreamError(this, e));
1130                    return flags;
1131                }
1132                if (n < 0) {
1133                    error(new EndOfFile(this));
1134                    return null; // Not reached
1135                }
1136
1137                sb.setCharAt(0, (char) n); // ### BUG: Codepoint conversion
1138                flags = new BitSet(1);
1139                flags.set(0);
1140            } else if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) {
1141                sb.setLength(0);
1142                sb.append(readMultipleEscape(rt));
1143                flags = new BitSet(sb.length());
1144                flags.set(0, sb.length());
1145            } else if (rt.isInvalid(c)) {
1146                rt.checkInvalid(c, this); // Signals a reader-error.
1147            } else if (readtableCase == Keyword.UPCASE) {
1148                sb.setCharAt(0, LispCharacter.toUpperCase(c));
1149            } else if (readtableCase == Keyword.DOWNCASE) {
1150                sb.setCharAt(0, LispCharacter.toLowerCase(c));
1151            }
1152        }
1153        try {
1154            while (true) {
1155                int n = _readChar();
1156                if (n < 0)
1157                    break;
1158                char c = (char) n; // ### BUG: Codepoint conversion
1159                if (rt.isWhitespace(c)) {
1160                    _unreadChar(n);
1161                    break;
1162                }
1163                byte syntaxType = rt.getSyntaxType(c);
1164                if (syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) {
1165                    _unreadChar(c);
1166                    break;
1167                }
1168                rt.checkInvalid(c, this);
1169                if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
1170                    n = _readChar();
1171                    if (n < 0)
1172                        break;
1173                    sb.append((char)n); // ### BUG: Codepoint conversion
1174                    if (flags == null)
1175                        flags = new BitSet(sb.length());
1176                    flags.set(sb.length() - 1);
1177                    continue;
1178                }
1179                if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) {
1180                    int begin = sb.length();
1181                    sb.append(readMultipleEscape(rt));
1182                    int end = sb.length();
1183                    if (flags == null)
1184                        flags = new BitSet(sb.length());
1185                    flags.set(begin, end);
1186                    continue;
1187                }
1188                if (readtableCase == Keyword.UPCASE)
1189                    c = LispCharacter.toUpperCase(c);
1190                else if (readtableCase == Keyword.DOWNCASE)
1191                    c = LispCharacter.toLowerCase(c);
1192                sb.append(c);
1193            }
1194        } catch (IOException e) {
1195            error(new StreamError(this, e));
1196            return flags;
1197        }
1198
1199        return flags;
1200    }
1201
1202    public static final String invert(String s, BitSet flags) {
1203        // Section 23.1.2: "When the readtable case is :INVERT, then if all of
1204        // the unescaped letters in the extended token are of the same case,
1205        // those (unescaped) letters are converted to the opposite case."
1206        final int limit = s.length();
1207        final int LOWER = 1;
1208        final int UPPER = 2;
1209        int state = 0;
1210        for (int i = 0; i < limit; i++) {
1211            // We only care about unescaped characters.
1212            if (flags != null && flags.get(i))
1213                continue;
1214            char c = s.charAt(i);
1215            if (Character.isUpperCase(c)) {
1216                if (state == LOWER)
1217                    return s; // Mixed case.
1218                state = UPPER;
1219            }
1220            if (Character.isLowerCase(c)) {
1221                if (state == UPPER)
1222                    return s; // Mixed case.
1223                state = LOWER;
1224            }
1225        }
1226        StringBuilder sb = new StringBuilder(limit);
1227        for (int i = 0; i < limit; i++) {
1228            char c = s.charAt(i);
1229            if (flags != null && flags.get(i)) // Escaped.
1230                sb.append(c);
1231            else if (Character.isUpperCase(c))
1232                sb.append(Character.toLowerCase(c));
1233            else if (Character.isLowerCase(c))
1234                sb.append(Character.toUpperCase(c));
1235            else
1236                sb.append(c);
1237        }
1238        return sb.toString();
1239    }
1240
1241    private static final int getReadBase(LispThread thread)
1242
1243    {
1244        final int readBase;
1245        final LispObject readBaseObject = Symbol.READ_BASE.symbolValue(thread);
1246        if (readBaseObject instanceof Fixnum) {
1247            readBase = ((Fixnum)readBaseObject).value;
1248        } else
1249            // The value of *READ-BASE* is not a Fixnum.
1250            return ierror(new LispError("The value of *READ-BASE* is not " +
1251                                        "of type '(INTEGER 2 36)."));
1252
1253        if (readBase < 2 || readBase > 36)
1254            return ierror(new LispError("The value of *READ-BASE* is not " +
1255                                        "of type '(INTEGER 2 36)."));
1256
1257        return readBase;
1258    }
1259
1260    private final LispObject makeNumber(String token, int length, int radix)
1261    {
1262        if (length == 0)
1263            return null;
1264        if (token.indexOf('/') >= 0)
1265            return makeRatio(token, radix);
1266        if (token.charAt(length - 1) == '.') {
1267            radix = 10;
1268            token = token.substring(0, --length);
1269        }
1270        boolean numeric = true;
1271        if (radix == 10) {
1272            for (int i = length; i-- > 0;) {
1273                char c = token.charAt(i);
1274                if (c < '0' || c > '9') {
1275                    if (i > 0 || (c != '-' && c != '+')) {
1276                        numeric = false;
1277                        break;
1278                    }
1279                }
1280            }
1281        } else {
1282            for (int i = length; i-- > 0;) {
1283                char c = token.charAt(i);
1284                if (Character.digit(c, radix) < 0) {
1285                    if (i > 0 || (c != '-' && c != '+')) {
1286                        numeric = false;
1287                        break;
1288                    }
1289                }
1290            }
1291        }
1292        if (!numeric) // Can't be an integer.
1293            return makeFloat(token, length);
1294        if (token.charAt(0) == '+')
1295            token = token.substring(1);
1296        try {
1297            int n = Integer.parseInt(token, radix);
1298            return (n >= 0 && n <= 255) ? Fixnum.constants[n] : Fixnum.getInstance(n);
1299        } catch (NumberFormatException e) {}
1300        // parseInt() failed.
1301        try {
1302            return Bignum.getInstance(token, radix);
1303        } catch (NumberFormatException e) {}
1304        // Not a number.
1305        return null;
1306    }
1307
1308    private final LispObject makeRatio(String token, int radix)
1309
1310    {
1311        final int index = token.indexOf('/');
1312        if (index < 0)
1313            return null;
1314        try {
1315            BigInteger numerator =
1316                new BigInteger(token.substring(0, index), radix);
1317            BigInteger denominator =
1318                new BigInteger(token.substring(index + 1), radix);
1319            // Check the denominator here, before calling number(), so we can
1320            // signal a READER-ERROR, as required by ANSI, instead of DIVISION-
1321            // BY-ZERO.
1322            if (denominator.signum() == 0)
1323                error(new ReaderError("Division by zero.", this));
1324            return number(numerator, denominator);
1325        } catch (NumberFormatException e) {
1326            return null;
1327        }
1328    }
1329
1330    private static final LispObject makeFloat(final String token,
1331            final int length)
1332
1333    {
1334        if (length == 0)
1335            return null;
1336        StringBuilder sb = new StringBuilder();
1337        int i = 0;
1338        boolean maybe = false;
1339        char marker = 0;
1340        char c = token.charAt(i);
1341        if (c == '-' || c == '+') {
1342            sb.append(c);
1343            ++i;
1344        }
1345        while (i < length) {
1346            c = token.charAt(i);
1347            if (c == '.' || (c >= '0' && c <= '9')) {
1348                if (c == '.')
1349                    maybe = true;
1350                sb.append(c);
1351                ++i;
1352            } else
1353                break;
1354        }
1355        if (i < length) {
1356            c = token.charAt(i);
1357            if ("esfdlESFDL".indexOf(c) >= 0) {
1358                // Exponent marker.
1359                maybe = true;
1360                marker = LispCharacter.toUpperCase(c);
1361                if (marker == 'S')
1362                    marker = 'F';
1363                else if (marker == 'L')
1364                    marker = 'D';
1365                else if (marker == 'E') {
1366                    LispObject format = Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue();
1367                    if (format == Symbol.SINGLE_FLOAT || format == Symbol.SHORT_FLOAT)
1368                        marker = 'F';
1369                    else
1370                        marker = 'D';
1371                }
1372                sb.append('E');
1373                ++i;
1374            }
1375        }
1376        if (!maybe)
1377            return null;
1378        // Append rest of token.
1379        sb.append(token.substring(i));
1380        try {
1381            if (marker == 0) {
1382                LispObject format = Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue();
1383                if (format == Symbol.SINGLE_FLOAT || format == Symbol.SHORT_FLOAT)
1384                    marker = 'F';
1385                else
1386                    marker = 'D';
1387            }
1388            if (marker == 'D')
1389                return new DoubleFloat(Double.parseDouble(sb.toString()));
1390            else
1391                return new SingleFloat(Float.parseFloat(sb.toString()));
1392        } catch (NumberFormatException e) {
1393            return null;
1394        }
1395    }
1396
1397    public LispObject readRadix(int radix, ReadtableAccessor rta) {
1398        StringBuilder sb = new StringBuilder();
1399        final LispThread thread = LispThread.currentThread();
1400        final Readtable rt = rta.rt(thread);
1401        boolean escaped = (_readToken(sb, rt) != null);
1402        if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
1403            return NIL;
1404        if (escaped)
1405            return error(new ReaderError("Illegal syntax for number.", this));
1406        String s = sb.toString();
1407        if (s.indexOf('/') >= 0)
1408            return makeRatio(s, radix);
1409        // Integer.parseInt() below handles a prefixed '-' character correctly, but
1410        // does not accept a prefixed '+' character, so we skip over it here
1411        if (s.charAt(0) == '+')
1412            s = s.substring(1);
1413        try {
1414            int n = Integer.parseInt(s, radix);
1415            return (n >= 0 && n <= 255) ? Fixnum.constants[n] : Fixnum.getInstance(n);
1416        } catch (NumberFormatException e) {}
1417        // parseInt() failed.
1418        try {
1419            return Bignum.getInstance(s, radix);
1420        } catch (NumberFormatException e) {}
1421        // Not a number.
1422        return error(new LispError());
1423    }
1424
1425    private char flushWhitespace(Readtable rt) {
1426        try {
1427            while (true) {
1428                int n = _readChar();
1429                if (n < 0)
1430                    return (char)ierror(new EndOfFile(this));
1431
1432                char c = (char) n; // ### BUG: Codepoint conversion
1433                if (!rt.isWhitespace(c))
1434                    return c;
1435            }
1436        } catch (IOException e) {
1437            error(new StreamError(this, e));
1438            return 0;
1439        }
1440    }
1441
1442    public LispObject readDelimitedList(char delimiter)
1443
1444    {
1445        final LispThread thread = LispThread.currentThread();
1446        LispObject result = NIL;
1447        while (true) {
1448            Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread);
1449            char c = flushWhitespace(rt);
1450            if (c == delimiter)
1451                break;
1452
1453            LispObject obj = processChar(thread, c, rt);
1454            if (obj != null)
1455                result = new Cons(obj, result);
1456        }
1457        if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
1458            return NIL;
1459        else
1460            return result.nreverse();
1461    }
1462
1463    // read-line &optional stream eof-error-p eof-value recursive-p
1464    // => line, missing-newline-p
1465    // recursive-p is ignored
1466    public LispObject readLine(boolean eofError, LispObject eofValue)
1467
1468    {
1469        final LispThread thread = LispThread.currentThread();
1470        StringBuilder sb = new StringBuilder();
1471        try {
1472            while (true) {
1473                int n = _readChar();
1474                if (n < 0) {
1475                    if (sb.length() == 0) {
1476                        if (eofError)
1477                            return error(new EndOfFile(this));
1478                        return thread.setValues(eofValue, T);
1479                    }
1480                    return thread.setValues(new SimpleString(sb), T);
1481                }
1482                if (n == '\n')
1483                    return thread.setValues(new SimpleString(sb), NIL);
1484                else
1485                    sb.append((char)n); // ### BUG: Codepoint conversion
1486            }
1487        } catch (IOException e) {
1488            return error(new StreamError(this, e));
1489        }
1490    }
1491
1492    // read-char &optional stream eof-error-p eof-value recursive-p => char
1493    // recursive-p is ignored
1494    public LispObject readChar() {
1495        try {
1496            int n = _readChar();
1497            if (n < 0)
1498                return error(new EndOfFile(this));
1499            return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion
1500        } catch (IOException e) {
1501            return error(new StreamError(this, e));
1502        }
1503
1504    }
1505
1506    public LispObject readChar(boolean eofError, LispObject eofValue)
1507
1508    {
1509        try {
1510            int n = _readChar();
1511            if (n < 0) {
1512                if (eofError)
1513                    return error(new EndOfFile(this));
1514                else
1515                    return eofValue;
1516            }
1517            return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion
1518        } catch (IOException e) {
1519            return error(new StreamError(this, e));
1520        }
1521    }
1522
1523    // read-char-no-hang &optional stream eof-error-p eof-value recursive-p => char
1524    // recursive-p is ignored
1525    public LispObject readCharNoHang(boolean eofError, LispObject eofValue)
1526
1527    {
1528        try {
1529            return _charReady() ? readChar(eofError, eofValue) : NIL;
1530        } catch (IOException e) {
1531            return error(new StreamError(this, e));
1532        }
1533    }
1534
1535
1536    // unread-char character &optional input-stream => nil
1537    public LispObject unreadChar(LispCharacter c) {
1538        try {
1539            _unreadChar(c.value);
1540            return NIL;
1541        } catch (IOException e) {
1542            return error(new StreamError(this, e));
1543        }
1544    }
1545
1546    public LispObject finishOutput() {
1547        _finishOutput();
1548        return NIL;
1549    }
1550
1551    // clear-input &optional input-stream => nil
1552    public LispObject clearInput() {
1553        _clearInput();
1554        return NIL;
1555    }
1556
1557    public LispObject getFilePosition() {
1558        long pos = _getFilePosition();
1559        return pos >= 0 ? number(pos) : NIL;
1560    }
1561
1562    public LispObject setFilePosition(LispObject arg) {
1563        return _setFilePosition(arg) ? T : NIL;
1564    }
1565
1566    // close stream &key abort => result
1567    // Must return true if stream was open, otherwise implementation-dependent.
1568    public LispObject close(LispObject abort) {
1569        _close();
1570        return T;
1571    }
1572
1573    @Override
1574    public String toString() {
1575        return unreadableString("STREAM");
1576    }
1577
1578    // read-byte stream &optional eof-error-p eof-value => byte
1579    // Reads an 8-bit byte.
1580    public LispObject readByte(boolean eofError, LispObject eofValue)
1581
1582    {
1583        int n = _readByte();
1584        if (n < 0) {
1585            if (eofError)
1586                return error(new EndOfFile(this));
1587            else
1588                return eofValue;
1589        }
1590        return Fixnum.constants[n];
1591    }
1592
1593    public LispObject terpri() {
1594        _writeChar('\n');
1595        return NIL;
1596    }
1597
1598    public LispObject freshLine() {
1599        if (charPos == 0)
1600            return NIL;
1601        _writeChar('\n');
1602        return T;
1603    }
1604
1605    public void print(char c) {
1606        _writeChar(c);
1607    }
1608
1609    // PRIN1 produces output suitable for input to READ.
1610    // Binds *PRINT-ESCAPE* to true.
1611    public void prin1(LispObject obj) {
1612        LispThread thread = LispThread.currentThread();
1613        final SpecialBindingsMark mark = thread.markSpecialBindings();
1614        thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
1615        try {
1616            _writeString(obj.writeToString());
1617        } finally {
1618            thread.resetSpecialBindings(mark);
1619        }
1620    }
1621
1622    public LispObject listen() {
1623        if (pastEnd)
1624            return NIL;
1625        try {
1626            if (! _charReady())
1627                return NIL;
1628
1629            int n = _readChar();
1630            if (n < 0)
1631                return NIL;
1632
1633            _unreadChar(n);
1634
1635            return T;
1636        } catch (IOException e) {
1637            return error(new StreamError(this, e));
1638        }
1639    }
1640
1641    public LispObject fileLength() {
1642        return type_error(this, Symbol.FILE_STREAM);
1643    }
1644
1645    public LispObject fileStringLength(LispObject arg) {
1646        if (arg instanceof LispCharacter) {
1647            if (Utilities.isPlatformWindows) {
1648                if (((LispCharacter)arg).value == '\n')
1649                    return Fixnum.TWO;
1650            }
1651            return Fixnum.ONE;
1652        }
1653        if (arg instanceof AbstractString) {
1654            if (Utilities.isPlatformWindows) {
1655                int fileStringLength = 0;
1656                char[] chars = ((AbstractString)arg).getStringChars();
1657                for (int i = chars.length; i-- > 0;) {
1658                    if (chars[i] == '\n')
1659                        fileStringLength += 2;
1660                    else
1661                        ++fileStringLength;
1662                }
1663                return number(fileStringLength);
1664
1665            }
1666            return number(arg.length());
1667        }
1668        return error(new TypeError(arg.writeToString() +
1669                                   " is neither a string nor a character."));
1670    }
1671
1672    /** Reads a character off an underlying stream
1673     *
1674     * @return a character, or -1 at end-of-file
1675     */
1676    protected int _readChar() throws IOException {
1677        if (reader == null)
1678            streamNotCharacterInputStream();
1679
1680        int n = reader.read();
1681
1682        if (n < 0) {
1683            pastEnd = true;
1684            return -1;
1685        }
1686
1687        ++offset;
1688        if (n == '\r' && eolStyle == EolStyle.CRLF) {
1689            n = _readChar();
1690            if (n != '\n') {
1691                _unreadChar(n);
1692                return '\r';
1693            } else
1694                return '\n';
1695        }
1696
1697        if (n == eolChar) {
1698            ++lineNumber;
1699            return '\n';
1700        }
1701
1702        return n;
1703    }
1704
1705    /** Puts a character back into the (underlying) stream
1706     *
1707     * @param n
1708     */
1709    protected void _unreadChar(int n) throws IOException {
1710        if (reader == null)
1711            streamNotCharacterInputStream();
1712
1713        --offset;
1714        if (n == '\n') {
1715            n = eolChar;
1716            --lineNumber;
1717        }
1718
1719        reader.unread(n);
1720        pastEnd = false;
1721    }
1722
1723
1724    /** Returns a boolean indicating input readily available
1725     *
1726     * @return true if a character is available
1727     */
1728    protected boolean _charReady() throws IOException {
1729        if (reader == null)
1730            streamNotCharacterInputStream();
1731        return reader.ready();
1732    }
1733
1734    /** Writes a character into the underlying stream,
1735     * updating charPos while doing so
1736     *
1737     * @param c
1738     */
1739    public void _writeChar(char c) {
1740        try {
1741            if (c == '\n') {
1742                if (eolStyle == EolStyle.CRLF && lastChar != '\r')
1743                    writer.write('\r');
1744
1745                writer.write(eolChar);
1746                lastChar = eolChar;
1747                writer.flush();
1748                charPos = 0;
1749            } else {
1750                writer.write(c);
1751                lastChar = c;
1752                ++charPos;
1753            }
1754        } catch (NullPointerException e) {
1755            // writer is null
1756            streamNotCharacterOutputStream();
1757        } catch (IOException e) {
1758            error(new StreamError(this, e));
1759        }
1760    }
1761
1762    /** Writes a series of characters in the underlying stream,
1763     * updating charPos while doing so
1764     *
1765     * @param chars
1766     * @param start
1767     * @param end
1768     */
1769    public void _writeChars(char[] chars, int start, int end)
1770
1771    {
1772        try {
1773            if (eolStyle != EolStyle.RAW) {
1774                for (int i = start; i < end; i++)
1775                    //###FIXME: the number of writes can be greatly reduced by
1776                    // writing the space between newlines as chunks.
1777                    _writeChar(chars[i]);
1778                return;
1779            }
1780
1781            writer.write(chars, start, end - start);
1782            if (start < end)
1783                lastChar = chars[end-1];
1784
1785            int index = -1;
1786            for (int i = end; i-- > start;) {
1787                if (chars[i] == '\n') {
1788                    index = i;
1789                    break;
1790                }
1791            }
1792            if (index < 0) {
1793                // No newline.
1794                charPos += (end - start);
1795            } else {
1796                charPos = end - (index + 1);
1797                writer.flush();
1798            }
1799        } catch (NullPointerException e) {
1800            if (writer == null)
1801                streamNotCharacterOutputStream();
1802            else
1803                throw e;
1804        } catch (IOException e) {
1805            error(new StreamError(this, e));
1806        }
1807    }
1808
1809    /** Writes a string to the underlying stream,
1810     * updating charPos while doing so
1811     *
1812     * @param s
1813     */
1814    public void _writeString(String s) {
1815        try {
1816            _writeChars(s.toCharArray(), 0, s.length());
1817        } catch (NullPointerException e) {
1818            if (writer == null)
1819                streamNotCharacterOutputStream();
1820            else
1821                throw e;
1822        }
1823    }
1824
1825    /** Writes a string to the underlying stream, appending
1826     * a new line and updating charPos while doing so
1827     *
1828     * @param s
1829     */
1830    public void _writeLine(String s) {
1831        try {
1832            _writeString(s);
1833            _writeChar('\n');
1834        } catch (NullPointerException e) {
1835            // writer is null
1836            streamNotCharacterOutputStream();
1837        }
1838    }
1839
1840    // Reads an 8-bit byte.
1841    /** Reads an 8-bit byte off the underlying stream
1842     *
1843     * @return
1844     */
1845    public int _readByte() {
1846        try {
1847            int n = in.read();
1848            if (n < 0)
1849                pastEnd = true;
1850
1851            return n; // Reads an 8-bit byte.
1852        } catch (IOException e) {
1853            return ierror(new StreamError(this, e));
1854        }
1855    }
1856
1857    // Writes an 8-bit byte.
1858    /** Writes an 8-bit byte off the underlying stream
1859     *
1860     * @param n
1861     */
1862    public void _writeByte(int n) {
1863        try {
1864            out.write(n); // Writes an 8-bit byte.
1865        } catch (NullPointerException e) {
1866            // out is null
1867            streamNotBinaryOutputStream();
1868        } catch (IOException e) {
1869            error(new StreamError(this, e));
1870        }
1871    }
1872
1873    /** Flushes any buffered output in the (underlying) stream
1874     *
1875     */
1876    public void _finishOutput() {
1877        try {
1878            if (writer != null)
1879                writer.flush();
1880            if (out != null)
1881                out.flush();
1882        } catch (IOException e) {
1883            error(new StreamError(this, e));
1884        }
1885    }
1886
1887    /** Reads all input from the underlying stream,
1888     * until _charReady() indicates no more input to be available
1889     *
1890     */
1891    public void _clearInput() {
1892        if (reader != null) {
1893            int c = 0;
1894            try {
1895                while (_charReady() && (c >= 0))
1896                    c = _readChar();
1897            } catch (IOException e) {
1898                error(new StreamError(this, e));
1899            }
1900        } else if (in != null) {
1901            try {
1902                int n = 0;
1903                while (in.available() > 0)
1904                    n = in.read();
1905
1906                if (n < 0)
1907                    pastEnd = true;
1908            } catch (IOException e) {
1909                error(new StreamError(this, e));
1910            }
1911        }
1912    }
1913
1914    /** Returns a (non-negative) file position integer or a negative value
1915     * if the position cannot be determined.
1916     *
1917     * @return non-negative value as a position spec
1918     * @return negative value for 'unspecified'
1919     */
1920    protected long _getFilePosition() {
1921        return -1;
1922    }
1923
1924    /** Sets the file position based on a position designator passed in arg
1925     *
1926     * @param arg File position specifier as described in the CLHS
1927     * @return true on success, false on failure
1928     */
1929    protected boolean _setFilePosition(LispObject arg) {
1930        return false;
1931    }
1932
1933    /** Closes the stream and underlying streams
1934     *
1935     */
1936    public void _close() {
1937        try {
1938            if (reader != null)
1939                reader.close();
1940            if (in != null)
1941                in.close();
1942            if (writer != null)
1943                writer.close();
1944            if (out != null)
1945                out.close();
1946            setOpen(false);
1947        } catch (IOException e) {
1948            error(new StreamError(this, e));
1949        }
1950    }
1951
1952    public void printStackTrace(Throwable t) {
1953        StringWriter sw = new StringWriter();
1954        PrintWriter pw = new PrintWriter(sw);
1955        t.printStackTrace(pw);
1956        try {
1957            writer.write(sw.toString());
1958            writer.write('\n');
1959            lastChar = '\n';
1960            writer.flush();
1961            charPos = 0;
1962        } catch (IOException e) {
1963            error(new StreamError(this, e));
1964        }
1965    }
1966
1967    protected LispObject streamNotInputStream() {
1968        return error(new StreamError(this, writeToString() + " is not an input stream."));
1969    }
1970
1971    protected LispObject streamNotCharacterInputStream() {
1972        return error(new StreamError(this, writeToString() + " is not a character input stream."));
1973    }
1974
1975    protected LispObject streamNotOutputStream() {
1976        return error(new StreamError(this, writeToString() + " is not an output stream."));
1977    }
1978
1979    protected LispObject streamNotBinaryOutputStream() {
1980        return error(new StreamError(this, writeToString() + " is not a binary output stream."));
1981    }
1982
1983    protected LispObject streamNotCharacterOutputStream() {
1984        return error(new StreamError(this, writeToString() + " is not a character output stream."));
1985    }
1986
1987    // ### %stream-write-char character output-stream => character
1988    // OUTPUT-STREAM must be a real stream, not an output stream designator!
1989    private static final Primitive _WRITE_CHAR =
1990        new Primitive("%stream-write-char", PACKAGE_SYS, true,
1991    "character output-stream") {
1992        @Override
1993        public LispObject execute(LispObject first, LispObject second)
1994
1995        {
1996            checkStream(second)._writeChar(LispCharacter.getValue(first));
1997            return first;
1998        }
1999    };
2000
2001    // ### %write-char character output-stream => character
2002    private static final Primitive _STREAM_WRITE_CHAR =
2003        new Primitive("%write-char", PACKAGE_SYS, false,
2004    "character output-stream") {
2005        @Override
2006        public LispObject execute(LispObject first, LispObject second)
2007
2008        {
2009            final char c = LispCharacter.getValue(first);
2010            if (second == T)
2011                second = Symbol.TERMINAL_IO.symbolValue();
2012            else if (second == NIL)
2013                second = Symbol.STANDARD_OUTPUT.symbolValue();
2014            final Stream stream = checkStream(second);
2015            stream._writeChar(c);
2016            return first;
2017        }
2018    };
2019
2020    // ### %write-string string output-stream start end => string
2021    private static final Primitive _WRITE_STRING =
2022        new Primitive("%write-string", PACKAGE_SYS, false,
2023    "string output-stream start end") {
2024        @Override
2025        public LispObject execute(LispObject first, LispObject second,
2026                                  LispObject third, LispObject fourth)
2027
2028        {
2029            final AbstractString s = checkString(first);
2030            char[] chars = s.chars();
2031            final Stream out = outSynonymOf(second);
2032            final int start = Fixnum.getValue(third);
2033            final int end;
2034            if (fourth == NIL)
2035                end = chars.length;
2036            else {
2037                end = Fixnum.getValue(fourth);
2038            }
2039            checkBounds(start, end, chars.length);
2040            out._writeChars(chars, start, end);
2041            return first;
2042        }
2043    };
2044
2045    // ### %finish-output output-stream => nil
2046    private static final Primitive _FINISH_OUTPUT =
2047    new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream") {
2048        @Override
2049        public LispObject execute(LispObject arg) {
2050            return finishOutput(arg);
2051        }
2052    };
2053
2054    // ### %force-output output-stream => nil
2055    private static final Primitive _FORCE_OUTPUT =
2056    new Primitive("%force-output", PACKAGE_SYS, false, "output-stream") {
2057        @Override
2058        public LispObject execute(LispObject arg) {
2059            return finishOutput(arg);
2060        }
2061    };
2062
2063    static final LispObject finishOutput(LispObject arg)
2064
2065    {
2066        final LispObject out;
2067        if (arg == T)
2068            out = Symbol.TERMINAL_IO.symbolValue();
2069        else if (arg == NIL)
2070            out = Symbol.STANDARD_OUTPUT.symbolValue();
2071        else
2072            out = arg;
2073        return checkStream(out).finishOutput();
2074    }
2075
2076    // ### clear-input &optional input-stream => nil
2077    private static final Primitive CLEAR_INPUT =
2078    new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream") {
2079        @Override
2080        public LispObject execute(LispObject[] args) {
2081            if (args.length > 1)
2082                return error(new WrongNumberOfArgumentsException(this));
2083            final Stream in;
2084            if (args.length == 0)
2085                in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
2086            else
2087                in = inSynonymOf(args[0]);
2088            in.clearInput();
2089            return NIL;
2090        }
2091    };
2092
2093    // ### %clear-output output-stream => nil
2094    // "If any of these operations does not make sense for output-stream, then
2095    // it does nothing."
2096    private static final Primitive _CLEAR_OUTPUT =
2097    new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream") {
2098        @Override
2099        public LispObject execute(LispObject arg) {
2100            if (arg == T) // *TERMINAL-IO*
2101                return NIL;
2102            if (arg == NIL) // *STANDARD-OUTPUT*
2103                return NIL;
2104            if (arg instanceof Stream)
2105                return NIL;
2106            return type_error(arg, Symbol.STREAM);
2107        }
2108    };
2109
2110    // ### close stream &key abort => result
2111    private static final Primitive CLOSE =
2112    new Primitive(Symbol.CLOSE, "stream &key abort") {
2113        @Override
2114        public LispObject execute(LispObject arg) {
2115            return checkStream(arg).close(NIL);
2116        }
2117
2118        @Override
2119        public LispObject execute(LispObject first, LispObject second,
2120                                  LispObject third)
2121
2122        {
2123            final Stream stream = checkStream(first);
2124            if (second == Keyword.ABORT)
2125                return stream.close(third);
2126            return error(new ProgramError("Unrecognized keyword argument " +
2127                                          second.writeToString() + "."));
2128        }
2129    };
2130
2131    // ### out-synonym-of stream-designator => stream
2132    private static final Primitive OUT_SYNONYM_OF =
2133    new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator") {
2134        @Override
2135        public LispObject execute (LispObject arg) {
2136            if (arg instanceof Stream)
2137                return arg;
2138            if (arg == T)
2139                return Symbol.TERMINAL_IO.symbolValue();
2140            if (arg == NIL)
2141                return Symbol.STANDARD_OUTPUT.symbolValue();
2142            return arg;
2143        }
2144    };
2145
2146    // ### write-8-bits
2147    // write-8-bits byte stream => nil
2148    private static final Primitive WRITE_8_BITS =
2149    new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream") {
2150        @Override
2151        public LispObject execute (LispObject first, LispObject second)
2152
2153        {
2154            int n = Fixnum.getValue(first);
2155            if (n < 0 || n > 255)
2156                return type_error(first, UNSIGNED_BYTE_8);
2157            checkStream(second)._writeByte(n);
2158            return NIL;
2159        }
2160    };
2161
2162    // ### read-8-bits
2163    // read-8-bits stream &optional eof-error-p eof-value => byte
2164    private static final Primitive READ_8_BITS =
2165        new Primitive("read-8-bits", PACKAGE_SYS, true,
2166    "stream &optional eof-error-p eof-value") {
2167        @Override
2168        public LispObject execute (LispObject first, LispObject second,
2169                                   LispObject third)
2170
2171        {
2172            return checkBinaryInputStream(first).readByte((second != NIL),
2173                    third);
2174        }
2175
2176        @Override
2177        public LispObject execute (LispObject[] args) {
2178            int length = args.length;
2179            if (length < 1 || length > 3)
2180                return error(new WrongNumberOfArgumentsException(this));
2181            final Stream in = checkBinaryInputStream(args[0]);
2182            boolean eofError = length > 1 ? (args[1] != NIL) : true;
2183            LispObject eofValue = length > 2 ? args[2] : NIL;
2184            return in.readByte(eofError, eofValue);
2185        }
2186    };
2187
2188    // ### read-line &optional input-stream eof-error-p eof-value recursive-p
2189    // => line, missing-newline-p
2190    private static final Primitive READ_LINE =
2191        new Primitive(Symbol.READ_LINE,
2192    "&optional input-stream eof-error-p eof-value recursive-p") {
2193        @Override
2194        public LispObject execute() {
2195            final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
2196            final Stream stream = checkStream(obj);
2197            return stream.readLine(true, NIL);
2198        }
2199        @Override
2200        public LispObject execute(LispObject arg) {
2201            if (arg == T)
2202                arg = Symbol.TERMINAL_IO.symbolValue();
2203            else if (arg == NIL)
2204                arg = Symbol.STANDARD_INPUT.symbolValue();
2205            final Stream stream = checkStream(arg);
2206            return stream.readLine(true, NIL);
2207        }
2208        @Override
2209        public LispObject execute(LispObject first, LispObject second)
2210
2211        {
2212            if (first == T)
2213                first = Symbol.TERMINAL_IO.symbolValue();
2214            else if (first == NIL)
2215                first = Symbol.STANDARD_INPUT.symbolValue();
2216            final Stream stream = checkStream(first);
2217            return stream.readLine(second != NIL, NIL);
2218        }
2219        @Override
2220        public LispObject execute(LispObject first, LispObject second,
2221                                  LispObject third)
2222
2223        {
2224            if (first == T)
2225                first = Symbol.TERMINAL_IO.symbolValue();
2226            else if (first == NIL)
2227                first = Symbol.STANDARD_INPUT.symbolValue();
2228            final Stream stream = checkStream(first);
2229            return stream.readLine(second != NIL, third);
2230        }
2231        @Override
2232        public LispObject execute(LispObject first, LispObject second,
2233                                  LispObject third, LispObject fourth)
2234
2235        {
2236            // recursive-p is ignored
2237            if (first == T)
2238                first = Symbol.TERMINAL_IO.symbolValue();
2239            else if (first == NIL)
2240                first = Symbol.STANDARD_INPUT.symbolValue();
2241            final Stream stream = checkStream(first);
2242            return stream.readLine(second != NIL, third);
2243        }
2244    };
2245
2246    // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
2247    // => object, position
2248    private static final Primitive _READ_FROM_STRING =
2249    new Primitive("%read-from-string", PACKAGE_SYS, false) {
2250        @Override
2251        public LispObject execute(LispObject first, LispObject second,
2252                                  LispObject third, LispObject fourth,
2253                                  LispObject fifth, LispObject sixth)
2254
2255        {
2256            String s = first.getStringValue();
2257            boolean eofError = (second != NIL);
2258            boolean preserveWhitespace = (sixth != NIL);
2259            final int startIndex;
2260            if (fourth != NIL)
2261                startIndex = Fixnum.getValue(fourth);
2262            else
2263                startIndex = 0;
2264            final int endIndex;
2265            if (fifth != NIL)
2266                endIndex = Fixnum.getValue(fifth);
2267            else
2268                endIndex = s.length();
2269            StringInputStream in =
2270                new StringInputStream(s, startIndex, endIndex);
2271            final LispThread thread = LispThread.currentThread();
2272            LispObject result;
2273            if (preserveWhitespace)
2274                result = in.readPreservingWhitespace(eofError, third, false,
2275                                                     thread, currentReadtable);
2276            else
2277                result = in.read(eofError, third, false, thread, currentReadtable);
2278            return thread.setValues(result, Fixnum.getInstance(in.getOffset()));
2279        }
2280    };
2281
2282    // ### read &optional input-stream eof-error-p eof-value recursive-p => object
2283    private static final Primitive READ =
2284        new Primitive(Symbol.READ,
2285    "&optional input-stream eof-error-p eof-value recursive-p") {
2286        @Override
2287        public LispObject execute() {
2288            final LispThread thread = LispThread.currentThread();
2289            final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
2290            final Stream stream = checkStream(obj);
2291            return stream.read(true, NIL, false, thread, currentReadtable);
2292        }
2293        @Override
2294        public LispObject execute(LispObject arg) {
2295            final LispThread thread = LispThread.currentThread();
2296            if (arg == T)
2297                arg = Symbol.TERMINAL_IO.symbolValue(thread);
2298            else if (arg == NIL)
2299                arg = Symbol.STANDARD_INPUT.symbolValue(thread);
2300            final Stream stream = checkStream(arg);
2301            return stream.read(true, NIL, false, thread, currentReadtable);
2302        }
2303        @Override
2304        public LispObject execute(LispObject first, LispObject second)
2305
2306        {
2307            final LispThread thread = LispThread.currentThread();
2308            if (first == T)
2309                first = Symbol.TERMINAL_IO.symbolValue(thread);
2310            else if (first == NIL)
2311                first = Symbol.STANDARD_INPUT.symbolValue(thread);
2312            final Stream stream = checkStream(first);
2313            return stream.read(second != NIL, NIL, false, thread, currentReadtable);
2314        }
2315        @Override
2316        public LispObject execute(LispObject first, LispObject second,
2317                                  LispObject third)
2318
2319        {
2320            final LispThread thread = LispThread.currentThread();
2321            if (first == T)
2322                first = Symbol.TERMINAL_IO.symbolValue(thread);
2323            else if (first == NIL)
2324                first = Symbol.STANDARD_INPUT.symbolValue(thread);
2325            final Stream stream = checkStream(first);
2326            return stream.read(second != NIL, third, false, thread, currentReadtable);
2327        }
2328        @Override
2329        public LispObject execute(LispObject first, LispObject second,
2330                                  LispObject third, LispObject fourth)
2331
2332        {
2333            final LispThread thread = LispThread.currentThread();
2334            if (first == T)
2335                first = Symbol.TERMINAL_IO.symbolValue(thread);
2336            else if (first == NIL)
2337                first = Symbol.STANDARD_INPUT.symbolValue(thread);
2338            final Stream stream = checkStream(first);
2339            return stream.read(second != NIL, third, fourth != NIL,
2340                               thread, currentReadtable);
2341        }
2342    };
2343
2344    // ### read-preserving-whitespace
2345    // &optional input-stream eof-error-p eof-value recursive-p => object
2346    private static final Primitive READ_PRESERVING_WHITESPACE =
2347        new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
2348    "&optional input-stream eof-error-p eof-value recursive-p") {
2349        @Override
2350        public LispObject execute(LispObject[] args) {
2351            int length = args.length;
2352            if (length > 4)
2353                return error(new WrongNumberOfArgumentsException(this));
2354            Stream stream =
2355                length > 0 ? inSynonymOf(args[0]) : getStandardInput();
2356            boolean eofError = length > 1 ? (args[1] != NIL) : true;
2357            LispObject eofValue = length > 2 ? args[2] : NIL;
2358            boolean recursive = length > 3 ? (args[3] != NIL) : false;
2359            return stream.readPreservingWhitespace(eofError, eofValue,
2360                                                   recursive,
2361                                                   LispThread.currentThread(),
2362                                                   currentReadtable);
2363        }
2364    };
2365
2366    // ### read-char &optional input-stream eof-error-p eof-value recursive-p
2367    // => char
2368    private static final Primitive READ_CHAR =
2369        new Primitive(Symbol.READ_CHAR,
2370    "&optional input-stream eof-error-p eof-value recursive-p") {
2371        @Override
2372        public LispObject execute() {
2373            return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
2374        }
2375        @Override
2376        public LispObject execute(LispObject arg) {
2377            return inSynonymOf(arg).readChar();
2378        }
2379        @Override
2380        public LispObject execute(LispObject first, LispObject second)
2381
2382        {
2383            return inSynonymOf(first).readChar(second != NIL, NIL);
2384        }
2385        @Override
2386        public LispObject execute(LispObject first, LispObject second,
2387                                  LispObject third)
2388
2389        {
2390            return inSynonymOf(first).readChar(second != NIL, third);
2391        }
2392        @Override
2393        public LispObject execute(LispObject first, LispObject second,
2394                                  LispObject third, LispObject fourth)
2395
2396        {
2397            return inSynonymOf(first).readChar(second != NIL, third);
2398        }
2399    };
2400
2401    // ### read-char-no-hang &optional input-stream eof-error-p eof-value
2402    // recursive-p => char
2403    private static final Primitive READ_CHAR_NO_HANG =
2404    new Primitive("read-char-no-hang", "&optional input-stream eof-error-p eof-value recursive-p") {
2405
2406        @Override
2407        public LispObject execute(LispObject[] args) {
2408            int length = args.length;
2409            if (length > 4)
2410                error(new WrongNumberOfArgumentsException(this));
2411            Stream stream =
2412                length > 0 ? inSynonymOf(args[0]) : getStandardInput();
2413            boolean eofError = length > 1 ? (args[1] != NIL) : true;
2414            LispObject eofValue = length > 2 ? args[2] : NIL;
2415            // recursive-p is ignored
2416            // boolean recursive = length > 3 ? (args[3] != NIL) : false;
2417            return stream.readCharNoHang(eofError, eofValue);
2418        }
2419    };
2420
2421    // ### read-delimited-list char &optional input-stream recursive-p => list
2422    private static final Primitive READ_DELIMITED_LIST =
2423    new Primitive("read-delimited-list", "char &optional input-stream recursive-p") {
2424
2425        @Override
2426        public LispObject execute(LispObject[] args) {
2427            int length = args.length;
2428            if (length < 1 || length > 3)
2429                error(new WrongNumberOfArgumentsException(this));
2430            char c = LispCharacter.getValue(args[0]);
2431            Stream stream =
2432                length > 1 ? inSynonymOf(args[1]) : getStandardInput();
2433            return stream.readDelimitedList(c);
2434        }
2435    };
2436
2437
2438    // ### unread-char character &optional input-stream => nil
2439    private static final Primitive UNREAD_CHAR =
2440    new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream") {
2441        @Override
2442        public LispObject execute(LispObject arg) {
2443            return getStandardInput().unreadChar(checkCharacter(arg));
2444        }
2445        @Override
2446        public LispObject execute(LispObject first, LispObject second)
2447
2448        {
2449            Stream stream = inSynonymOf(second);
2450            return stream.unreadChar(checkCharacter(first));
2451        }
2452    };
2453
2454    // ### write-vector-unsigned-byte-8
2455    private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
2456        new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
2457    "vector stream start end") {
2458        @Override
2459        public LispObject execute(LispObject first, LispObject second,
2460                                  LispObject third, LispObject fourth)
2461
2462        {
2463            final AbstractVector v = checkVector(first);
2464            final Stream stream = checkStream(second);
2465            int start = Fixnum.getValue(third);
2466            int end = Fixnum.getValue(fourth);
2467            for (int i = start; i < end; i++)
2468                stream._writeByte(v.aref(i));
2469            return v;
2470        }
2471    };
2472
2473    // ### read-vector-unsigned-byte-8 vector stream start end => position
2474    private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
2475        new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
2476    "vector stream start end") {
2477        @Override
2478        public LispObject execute(LispObject first, LispObject second,
2479                                  LispObject third, LispObject fourth)
2480
2481        {
2482            AbstractVector v = checkVector(first);
2483            Stream stream = checkBinaryInputStream(second);
2484            int start = Fixnum.getValue(third);
2485            int end = Fixnum.getValue(fourth);
2486            if (!v.getElementType().equal(UNSIGNED_BYTE_8))
2487                return type_error(first, list(Symbol.VECTOR,
2488                                              UNSIGNED_BYTE_8));
2489            for (int i = start; i < end; i++) {
2490                int n = stream._readByte();
2491                if (n < 0) {
2492                    // End of file.
2493                    return Fixnum.getInstance(i);
2494                }
2495                v.aset(i, n);
2496            }
2497            return fourth;
2498        }
2499    };
2500
2501    // ### file-position
2502    private static final Primitive FILE_POSITION =
2503    new Primitive("file-position", "stream &optional position-spec") {
2504        @Override
2505        public LispObject execute(LispObject arg) {
2506            return checkStream(arg).getFilePosition();
2507        }
2508        @Override
2509        public LispObject execute(LispObject first, LispObject second)
2510
2511        {
2512            return checkStream(first).setFilePosition(second);
2513        }
2514    };
2515
2516    // ### stream-line-number
2517    private static final Primitive STREAM_LINE_NUMBER =
2518    new Primitive("stream-line-number", PACKAGE_SYS, false, "stream") {
2519        @Override
2520        public LispObject execute(LispObject arg) {
2521            return Fixnum.getInstance(checkStream(arg).getLineNumber() + 1);
2522        }
2523    };
2524
2525    // ### stream-offset
2526    private static final Primitive STREAM_OFFSET =
2527    new Primitive("stream-offset", PACKAGE_SYS, false, "stream") {
2528        @Override
2529        public LispObject execute(LispObject arg) {
2530            return number(checkStream(arg).getOffset());
2531        }
2532    };
2533
2534    // ### stream-charpos stream => position
2535    private static final Primitive STREAM_CHARPOS =
2536    new Primitive("stream-charpos", PACKAGE_SYS, false) {
2537        @Override
2538        public LispObject execute(LispObject arg) {
2539            Stream stream = checkCharacterOutputStream(arg);
2540            return Fixnum.getInstance(stream.getCharPos());
2541        }
2542    };
2543
2544    // ### stream-%set-charpos stream newval => newval
2545    private static final Primitive STREAM_SET_CHARPOS =
2546    new Primitive("stream-%set-charpos", PACKAGE_SYS, false) {
2547        @Override
2548        public LispObject execute(LispObject first, LispObject second)
2549
2550        {
2551            Stream stream = checkCharacterOutputStream(first);
2552            stream.setCharPos(Fixnum.getValue(second));
2553            return second;
2554        }
2555    };
2556
2557    public InputStream getWrappedInputStream() {
2558  return in;
2559    }
2560
2561    public OutputStream getWrappedOutputStream() {
2562  return out;
2563    }
2564
2565    public Writer getWrappedWriter() {
2566  return writer;
2567    }
2568
2569    public PushbackReader getWrappedReader() {
2570  return reader;
2571    }
2572
2573}
Note: See TracBrowser for help on using the repository browser.