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

Last change on this file was 14358, checked in by Mark Evenson, 12 years ago

Backport r14357 | mevenson | 2013-01-16 13:27:33 +0100 (Wed, 16 Jan 2013) | 3 lines.

Fixes #294: Reader doesn't recognize terminating characters in some cases.

Patch and test by Stas.

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