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

Last change on this file was 12513, checked in by ehuelsmann, 15 years ago

Remove 'private' keyword to eliminate the Java requirement

for the compiler to generate synthetic accessors: functions that
don't appear in the source but do appear in the class file.

Patch by: Douglas Miles <dmiles _at_ users.sf.net>

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