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

Last change on this file was 11783, checked in by ehuelsmann, 16 years ago

Fix fasl reader special bindings leak.

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