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

Last change on this file was 14796, checked in by ehuelsmann, 9 years ago

Streams no longer are structure objects.

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