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

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

Improve - but do not fully fix - line number counting.

Note: See the line numbers generated for clos.lisp to

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