Changeset 12362


Ignore:
Timestamp:
01/11/10 20:03:29 (11 years ago)
Author:
vvoutilainen
Message:

Make Stream extend StructureObject?, modify Stream derivatives
to set a StructureClass? symbol when invoking the superclass
constructor. Fix clinit order in Lisp.java to cope. Some
structure-classes need refining, at least TwoWayStream? needs
to allow (but not force) its derivatives to set a structure
class other than TWO-WAY-STREAM (SOCKET-STREAM being one
specific example). Thanks to Alessio Stalla and Erik Huelsmann
for helping with getting this patch into a state where
ansi tests run again.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
21 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/BroadcastStream.java

    r12288 r12362  
    4242    private BroadcastStream(Stream[] streams)
    4343    {
     44        super(Symbol.BROADCAST_STREAM);
    4445        this.streams = streams;
    4546        isOutputStream = true;
  • trunk/abcl/src/org/armedbear/lisp/ByteArrayOutputStream.java

    r12360 r12362  
    4747    private ByteArrayOutputStream(LispObject elementType)
    4848    {
     49        super(Symbol.SYSTEM_STREAM);
    4950        this.elementType = elementType;
    5051        initAsBinaryOutputStream(byteArrayOutputStream = new java.io.ByteArrayOutputStream(2048));
  • trunk/abcl/src/org/armedbear/lisp/CaseFrobStream.java

    r12288 r12362  
    4343
    4444    {
     45        super(Symbol.CASE_FROB_STREAM);
    4546        Debug.assertTrue(target.isCharacterOutputStream());
    4647        this.target = target;
  • trunk/abcl/src/org/armedbear/lisp/ConcatenatedStream.java

    r12288 r12362  
    4242    private ConcatenatedStream(LispObject streams)
    4343    {
     44        super(Symbol.CONCATENATED_STREAM);
    4445        this.streams = streams;
    4546        isInputStream = true;
  • trunk/abcl/src/org/armedbear/lisp/EchoStream.java

    r12288 r12362  
    4545    public EchoStream(Stream in, Stream out)
    4646    {
     47        super(Symbol.ECHO_STREAM);
    4748        this.in = in;
    4849        this.out = out;
     
    5152    public EchoStream(Stream in, Stream out, boolean interactive)
    5253    {
     54        super(Symbol.ECHO_STREAM);
    5355        this.in = in;
    5456        this.out = out;
  • trunk/abcl/src/org/armedbear/lisp/FileStream.java

    r12323 r12362  
    7171         *    http://www.weitz.de/flexi-streams/#make-external-format
    7272         */
     73        super(Symbol.FILE_STREAM);
    7374        final File file = new File(namestring);
    7475        String mode = null;
  • trunk/abcl/src/org/armedbear/lisp/FillPointerOutputStream.java

    r12288 r12362  
    4242    private FillPointerOutputStream(ComplexString string)
    4343    {
     44        super(Symbol.SYSTEM_STREAM);
    4445        elementType = Symbol.CHARACTER;
    4546        isOutputStream = true;
  • trunk/abcl/src/org/armedbear/lisp/Interpreter.java

    r12312 r12362  
    139139        this.inputStream = inputStream;
    140140        this.outputStream = outputStream;
    141         resetIO(new Stream(inputStream, Symbol.CHARACTER),
    142                 new Stream(outputStream, Symbol.CHARACTER));
     141        resetIO(new Stream(Symbol.SYSTEM_STREAM, inputStream, Symbol.CHARACTER),
     142                new Stream(Symbol.SYSTEM_STREAM, outputStream, Symbol.CHARACTER));
    143143        if (!initialDirectory.endsWith(File.separator))
    144144            initialDirectory = initialDirectory.concat(File.separator);
  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r12331 r12362  
    21842184  }
    21852185
    2186   private static Stream stdin = new Stream(System.in, Symbol.CHARACTER, true);
    2187 
    2188   private static Stream stdout = new Stream(System.out, Symbol.CHARACTER, true);
    2189 
    2190   static
    2191   {
    2192     Symbol.STANDARD_INPUT.initializeSpecial(stdin);
    2193     Symbol.STANDARD_OUTPUT.initializeSpecial(stdout);
    2194     Symbol.ERROR_OUTPUT.initializeSpecial(stdout);
    2195     Symbol.TRACE_OUTPUT.initializeSpecial(stdout);
    2196     Symbol.TERMINAL_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
    2197     Symbol.QUERY_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
    2198     Symbol.DEBUG_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
    2199   }
     2186
    22002187
    22012188  public static final void resetIO(Stream in, Stream out)
     
    22152202  public static final void resetIO()
    22162203  {
    2217     resetIO(new Stream(System.in, Symbol.CHARACTER, true),
    2218             new Stream(System.out, Symbol.CHARACTER, true));
     2204    resetIO(new Stream(Symbol.SYSTEM_STREAM, System.in, Symbol.CHARACTER, true),
     2205            new Stream(Symbol.SYSTEM_STREAM, System.out, Symbol.CHARACTER, true));
    22192206  }
    22202207
     
    27682755    cold = false;
    27692756  }
     2757
     2758    private static Stream stdin = new Stream(Symbol.SYSTEM_STREAM, System.in, Symbol.CHARACTER, true);
     2759
     2760    private static Stream stdout = new Stream(Symbol.SYSTEM_STREAM,System.out, Symbol.CHARACTER, true);
     2761
     2762  static
     2763  {
     2764    Symbol.STANDARD_INPUT.initializeSpecial(stdin);
     2765    Symbol.STANDARD_OUTPUT.initializeSpecial(stdout);
     2766    Symbol.ERROR_OUTPUT.initializeSpecial(stdout);
     2767    Symbol.TRACE_OUTPUT.initializeSpecial(stdout);
     2768    Symbol.TERMINAL_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
     2769    Symbol.QUERY_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
     2770    Symbol.DEBUG_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
     2771  }
     2772
    27702773}
  • trunk/abcl/src/org/armedbear/lisp/Load.java

    r12344 r12362  
    263263
    264264          return loadFileFromStream(null, truename,
    265                                     new Stream(in, Symbol.CHARACTER),
     265                                    new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER),
    266266                                    verbose, print, false, returnLastResult);
    267267        }
     
    414414                    try {
    415415                        return loadFileFromStream(pathname, truename,
    416                                                   new Stream(in, Symbol.CHARACTER),
     416                                                  new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER),
    417417                                                  verbose, print, auto);
    418418                    }
  • trunk/abcl/src/org/armedbear/lisp/SlimeInputStream.java

    r12298 r12362  
    4545    public SlimeInputStream(Function f, Stream ostream)
    4646    {
     47        super(Symbol.SLIME_INPUT_STREAM);
    4748        elementType = Symbol.CHARACTER;
    4849        isInputStream = true;
  • trunk/abcl/src/org/armedbear/lisp/SlimeOutputStream.java

    r12288 r12362  
    4545    private SlimeOutputStream(Function f)
    4646    {
     47        super(Symbol.SLIME_OUTPUT_STREAM);
    4748        this.elementType = Symbol.CHARACTER;
    4849        isInputStream = false;
  • trunk/abcl/src/org/armedbear/lisp/Stream.java

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

    r12288 r12362  
    5555    public StringInputStream(String s, int start, int end)
    5656    {
     57        super(Symbol.STRING_INPUT_STREAM);
    5758        elementType = Symbol.CHARACTER;
    5859        setExternalFormat(keywordDefault);
  • trunk/abcl/src/org/armedbear/lisp/StringOutputStream.java

    r12288 r12362  
    4949    private StringOutputStream(LispObject elementType)
    5050    {
     51        super(Symbol.STRING_OUTPUT_STREAM);
    5152        this.elementType = elementType;
    5253        this.eolStyle = EolStyle.RAW;
  • trunk/abcl/src/org/armedbear/lisp/StructureObject.java

    r12288 r12362  
    3636import static org.armedbear.lisp.Lisp.*;
    3737
    38 public final class StructureObject extends LispObject
     38public class StructureObject extends LispObject
    3939{
    4040  private final StructureClass structureClass;
    4141  private final LispObject[] slots;
     42
     43  public StructureObject(Symbol symbol)
     44
     45  {
     46      structureClass = (StructureClass) LispClass.findClass(symbol/*, true*/); // Might return null.
     47    if (structureClass == null) {
     48        System.err.println("No mitens sitten: " + BuiltInClass.SYSTEM_STREAM.toString());
     49        System.err.println("joopa joo:" + Symbol.SYSTEM_STREAM.name);
     50        System.err.println("Oh noes, structure object got a null class:" + symbol.toString() + ", symbol name:" + symbol.name );
     51    }
     52    slots = new LispObject[0];
     53  }
    4254
    4355  public StructureObject(Symbol symbol, LispObject[] slots)
  • trunk/abcl/src/org/armedbear/lisp/SynonymStream.java

    r12288 r12362  
    4242    private SynonymStream(Symbol symbol)
    4343    {
     44        super(Symbol.SYNONYM_STREAM);
    4445        this.symbol = symbol;
    4546    }
  • trunk/abcl/src/org/armedbear/lisp/TwoWayStream.java

    r12288 r12362  
    4343    public TwoWayStream(Stream in, Stream out)
    4444    {
     45        super(Symbol.TWO_WAY_STREAM);
    4546        this.in = in;
    4647        this.out = out;
  • trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java

    r12035 r12362  
    77
    88import org.armedbear.lisp.Stream;
    9 
    109/**
    1110 * A bidirectional stream that captures input from a modal dialog. The dialog reports a label (prompt line)
     
    5554   */
    5655  protected DialogPromptStream() {
     56    super(org.armedbear.lisp.Symbol.SYSTEM_STREAM);
    5757    initAsCharacterOutputStream(writtenSoFar);
    5858    initAsCharacterInputStream(reader);
  • trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

    r12332 r12362  
    8282
    8383    public void setStandardInput(InputStream stream, LispThread thread) {
    84   thread.setSpecialVariable(Symbol.STANDARD_INPUT, new Stream(stream, Symbol.CHARACTER, true));
     84  thread.setSpecialVariable(Symbol.STANDARD_INPUT, new Stream(Symbol.SYSTEM_STREAM, stream, Symbol.CHARACTER, true));
    8585    }
    8686   
     
    109109  public LispObject loadFromClasspath(String classpathResource) {
    110110    InputStream istream = getClass().getResourceAsStream(classpathResource);
    111     Stream stream = new Stream(istream, Symbol.CHARACTER);
     111    Stream stream = new Stream(Symbol.SYSTEM_STREAM, istream, Symbol.CHARACTER);
    112112    return load(stream);
    113113  }
     
    237237      in = new ReaderInputStream(ctx.getReader());
    238238      out = new WriterOutputStream(ctx.getWriter());
    239       Stream outStream = new Stream(out, Symbol.CHARACTER);
    240       Stream inStream  = new Stream(in,  Symbol.CHARACTER);
     239      Stream outStream = new Stream(Symbol.SYSTEM_STREAM, out, Symbol.CHARACTER);
     240      Stream inStream  = new Stream(Symbol.SYSTEM_STREAM, in,  Symbol.CHARACTER);
    241241      retVal = evaluator.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
    242242               makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
  • trunk/abcl/src/org/armedbear/lisp/socket_stream.java

    r12288 r12362  
    5454        try {
    5555             Stream in =
    56                  new Stream(socket.getInputStream(), elementType, third);
     56                 new Stream(Symbol.SYSTEM_STREAM, socket.getInputStream(), elementType, third);
    5757             Stream out =
    58                  new Stream(socket.getOutputStream(), elementType, third);
     58                 new Stream(Symbol.SYSTEM_STREAM, socket.getOutputStream(), elementType, third);
    5959             return new SocketStream(socket, in, out);
    6060        }
Note: See TracChangeset for help on using the changeset viewer.