(char-db-feature-domains): Delete `jis/alt' because it has been
[chise/xemacs-chise.git] / src / lstream.c
1 /* Generic stream implementation.
2    Copyright (C) 1995 Free Software Foundation, Inc.
3    Copyright (C) 1995 Sun Microsystems, Inc.
4    Copyright (C) 1996 Ben Wing.
5
6 This file is part of XEmacs.
7
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
12
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING.  If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA.  */
22
23 /* Synched up with: Not in FSF. */
24
25 /* Written by Ben Wing. */
26
27 #include <config.h>
28 #include "lisp.h"
29
30 #include "buffer.h"
31 #include "insdel.h"
32 #include "lstream.h"
33
34 #include "sysfile.h"
35 #include <errno.h>
36
37 /* This function provides a generic buffering stream implementation.
38    Conceptually, you send data to the stream or read data from the
39    stream, not caring what's on the other end of the stream.  The
40    other end could be another stream, a file descriptor, a stdio
41    stream, a fixed block of memory, a reallocating block of memory,
42    etc.  The main purpose of the stream is to provide a standard
43    interface and to do buffering.  Macros are defined to read
44    or write characters, so the calling functions do not have to
45    worry about blocking data together in order to achieve efficiency.
46    */
47
48 /* Note that this object is called "stream" in Lisp but "lstream"
49    in C.  The reason for this is that "stream" is too generic a name
50    for C; too much likelihood of conflict/confusion with C++, etc. */
51
52 /* Functions are as follows:
53
54 Lstream *Lstream_new (Lstream_implementation *imp, const char *mode)
55         Allocate and return a new Lstream.  This function is not
56         really meant to be called directly; rather, each stream type
57         should provide its own stream creation function, which
58         creates the stream and does any other necessary creation
59         stuff (e.g. opening a file).
60
61 void Lstream_set_buffering (Lstream *lstr, Lstream_buffering buffering,
62                             int buffering_size)
63         Change the buffering of a stream.  See lstream.h.  By default
64         the buffering is STREAM_BLOCK_BUFFERED.
65
66 int Lstream_flush (Lstream *lstr)
67         Flush out any pending unwritten data in the stream.  Clear
68         any buffered input data.  Returns 0 on success, -1 on error.
69
70 int Lstream_putc (Lstream *stream, int c)
71         Write out one byte to the stream.  This is a macro and so
72         it is very efficient.  The C argument is only evaluated once
73         but the STREAM argument is evaluated more than once.  Returns
74         0 on success, -1 on error.
75
76 int Lstream_getc (Lstream *stream)
77         Read one byte from the stream and returns it as an unsigned
78         char cast to an int, or EOF on end of file or error.
79         This is a macro and so it is very efficient.  The STREAM
80         argument is evaluated more than once.
81
82 void Lstream_ungetc (Lstream *stream, int c)
83         Push one byte back onto the input queue, cast to unsigned char.
84         This will be the next byte read from the stream.  Any number
85         of bytes can be pushed back and will be read in the reverse
86         order they were pushed back -- most recent first. (This is
87         necessary for consistency -- if there are a number of bytes
88         that have been unread and I read and unread a byte, it needs
89         to be the first to be read again.) This is a macro and so it
90         is very efficient.  The C argument is only evaluated once but
91         the STREAM argument is evaluated more than once.
92
93 int Lstream_fputc (Lstream *stream, int c)
94 int Lstream_fgetc (Lstream *stream)
95 void Lstream_fungetc (Lstream *stream, int c)
96         Function equivalents of the above macros.
97
98 Lstream_data_count Lstream_read (Lstream *stream, void *data,
99                                  Lstream_data_count size)
100         Read SIZE bytes of DATA from the stream.  Return the number of
101         bytes read.  0 means EOF. -1 means an error occurred and no
102         bytes were read.
103
104 Lstream_data_count Lstream_write (Lstream *stream, void *data,
105                                   Lstream_data_count size)
106         Write SIZE bytes of DATA to the stream.  Return the number of
107         bytes written.  -1 means an error occurred and no bytes were
108         written.
109
110 void Lstream_unread (Lstream *stream, void *data, Lstream_data_count size)
111         Push back SIZE bytes of DATA onto the input queue.  The
112         next call to Lstream_read() with the same size will read the
113         same bytes back.  Note that this will be the case even if
114         there is other pending unread data.
115
116 int Lstream_delete (Lstream *stream)
117         Frees all memory associated with the stream is freed.  Calling
118         this is not strictly necessary, but it is much more efficient
119         than having the Lstream be garbage-collected.
120
121 int Lstream_close (Lstream *stream)
122         Close the stream.  All data will be flushed out.
123
124 void Lstream_reopen (Lstream *stream)
125         Reopen a closed stream.  This enables I/O on it again.
126         This is not meant to be called except from a wrapper routine
127         that reinitializes variables and such -- the close routine
128         may well have freed some necessary storage structures, for
129         example.
130
131 void Lstream_rewind (Lstream *stream)
132         Rewind the stream to the beginning.
133 */
134
135 #define DEFAULT_BLOCK_BUFFERING_SIZE 512
136 #define MAX_READ_SIZE 512
137
138 static Lisp_Object
139 mark_lstream (Lisp_Object obj)
140 {
141   Lstream *lstr = XLSTREAM (obj);
142   return lstr->imp->marker ? (lstr->imp->marker) (obj) : Qnil;
143 }
144
145 static void
146 print_lstream (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
147 {
148   Lstream *lstr = XLSTREAM (obj);
149   char buf[200];
150
151   sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s lstream) 0x%lx>",
152            lstr->imp->name, (long) lstr);
153   write_c_string (buf, printcharfun);
154 }
155
156 static void
157 finalize_lstream (void *header, int for_disksave)
158 {
159   /* WARNING WARNING WARNING.  This function (and all finalize functions)
160      may get called more than once on the same object, and may get called
161      (at dump time) on objects that are not being released. */
162   Lstream *lstr = (Lstream *) header;
163
164 #if 0 /* this may cause weird Broken Pipes? */
165   if (for_disksave)
166     {
167       Lstream_pseudo_close (lstr);
168       return;
169     }
170 #endif
171   if (lstr->flags & LSTREAM_FL_IS_OPEN)
172     {
173       if (for_disksave)
174         {
175           if (lstr->flags & LSTREAM_FL_CLOSE_AT_DISKSAVE)
176             Lstream_close (lstr);
177         }
178       else
179         /* Just close. */
180         Lstream_close (lstr);
181     }
182 }
183
184 inline static size_t
185 aligned_sizeof_lstream (size_t lstream_type_specific_size)
186 {
187   return ALIGN_SIZE (offsetof (Lstream, data) + lstream_type_specific_size,
188                      ALIGNOF (max_align_t));
189 }
190
191 static size_t
192 sizeof_lstream (const void *header)
193 {
194   return aligned_sizeof_lstream (((const Lstream *) header)->imp->size);
195 }
196
197 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("stream", lstream,
198                                         mark_lstream, print_lstream,
199                                         finalize_lstream, 0, 0, 0,
200                                         sizeof_lstream, Lstream);
201 \f
202 void
203 Lstream_set_buffering (Lstream *lstr, Lstream_buffering buffering,
204                        int buffering_size)
205 {
206   lstr->buffering = buffering;
207   switch (buffering)
208     {
209     case LSTREAM_UNBUFFERED:
210       lstr->buffering_size = 0; break;
211     case LSTREAM_BLOCK_BUFFERED:
212       lstr->buffering_size = DEFAULT_BLOCK_BUFFERING_SIZE; break;
213     case LSTREAM_BLOCKN_BUFFERED:
214       lstr->buffering_size = buffering_size; break;
215     case LSTREAM_LINE_BUFFERED:
216     case LSTREAM_UNLIMITED:
217       lstr->buffering_size = INT_MAX; break;
218     }
219 }
220
221 static const Lstream_implementation *lstream_types[32];
222 static Lisp_Object Vlstream_free_list[32];
223 static int lstream_type_count;
224
225 Lstream *
226 Lstream_new (const Lstream_implementation *imp, const char *mode)
227 {
228   Lstream *p;
229   int i;
230
231   for (i = 0; i < lstream_type_count; i++)
232     {
233       if (lstream_types[i] == imp)
234         break;
235     }
236
237   if (i == lstream_type_count)
238     {
239       assert (lstream_type_count < countof (lstream_types));
240       lstream_types[lstream_type_count] = imp;
241       Vlstream_free_list[lstream_type_count] =
242         make_lcrecord_list (aligned_sizeof_lstream (imp->size),
243                             &lrecord_lstream);
244       lstream_type_count++;
245     }
246
247   p = XLSTREAM (allocate_managed_lcrecord (Vlstream_free_list[i]));
248   /* Zero it out, except the header. */
249   memset ((char *) p + sizeof (p->header), '\0',
250           aligned_sizeof_lstream (imp->size) - sizeof (p->header));
251   p->imp = imp;
252   Lstream_set_buffering (p, LSTREAM_BLOCK_BUFFERED, 0);
253   p->flags = LSTREAM_FL_IS_OPEN;
254
255   /* convert mode (one of "r", "w", "rc", "wc") to p->flags */
256   assert (mode[0] == 'r' || mode[0] == 'w');
257   assert (mode[1] == 'c' || mode[1] == '\0');
258   p->flags |= (mode[0] == 'r' ? LSTREAM_FL_READ : LSTREAM_FL_WRITE);
259   if (mode[1] == 'c')
260     p->flags |= LSTREAM_FL_NO_PARTIAL_CHARS;
261
262   return p;
263 }
264
265 void
266 Lstream_set_character_mode (Lstream *lstr)
267 {
268   lstr->flags |= LSTREAM_FL_NO_PARTIAL_CHARS;
269 }
270
271 void
272 Lstream_delete (Lstream *lstr)
273 {
274   int i;
275   Lisp_Object val;
276
277   XSETLSTREAM (val, lstr);
278   for (i = 0; i < lstream_type_count; i++)
279     {
280       if (lstream_types[i] == lstr->imp)
281         {
282           free_managed_lcrecord (Vlstream_free_list[i], val);
283           return;
284         }
285     }
286
287   ABORT ();
288 }
289
290 #define Lstream_internal_error(reason, lstr) \
291   Lstream_signal_simple_error ("Internal error: " reason, lstr)
292
293 static void Lstream_signal_simple_error (const char *reason, Lstream *lstr)
294 {
295   Lisp_Object obj;
296   XSETLSTREAM (obj, lstr);
297   signal_simple_error (reason, obj);
298 }
299
300 void
301 Lstream_reopen (Lstream *lstr)
302 {
303   if (lstr->flags & LSTREAM_FL_IS_OPEN)
304     Lstream_internal_error ("lstream already open", lstr);
305   lstr->flags |= LSTREAM_FL_IS_OPEN;
306 }
307
308 /* Attempt to flush out all of the buffered data for writing. */
309
310 int
311 Lstream_flush_out (Lstream *lstr)
312 {
313   Lstream_data_count num_written;
314
315   while (lstr->out_buffer_ind > 0)
316     {
317       Lstream_data_count size = lstr->out_buffer_ind;
318       if (! (lstr->flags & LSTREAM_FL_IS_OPEN))
319         Lstream_internal_error ("lstream not open", lstr);
320       if (! (lstr->flags & LSTREAM_FL_WRITE))
321         Lstream_internal_error ("lstream not open for writing", lstr);
322       if (!lstr->imp->writer)
323         Lstream_internal_error ("lstream has no writer", lstr);
324
325       if (lstr->flags & LSTREAM_FL_NO_PARTIAL_CHARS)
326         /* It's quite possible for us to get passed an incomplete
327            character at the end.  We need to spit back that
328            incomplete character. */
329         {
330           const unsigned char *data = lstr->out_buffer;
331           const unsigned char *dataend = data + size - 1;
332           assert (size > 0); /* safety check ... */
333           /* Optimize the most common case. */
334           if (!BYTE_ASCII_P (*dataend))
335             {
336               /* Go back to the beginning of the last (and possibly partial)
337                  character, and bump forward to see if the character is
338                  complete. */
339               VALIDATE_CHARPTR_BACKWARD (dataend);
340               if (dataend + REP_BYTES_BY_FIRST_BYTE (*dataend) != data + size)
341                 /* If not, chop the size down to ignore the last char
342                    and stash it away for next time. */
343                 size = dataend - data;
344               /* If we don't even have one character to write, then just
345                  skip out. */
346               if (size == 0)
347                 break;
348             }
349         }
350
351       num_written = (lstr->imp->writer) (lstr, lstr->out_buffer, size);
352       if (num_written == 0)
353         /* If nothing got written, then just hold the data.  This may
354            occur, for example, if this stream does non-blocking I/O;
355            the attempt to write the data might have resulted in an
356            EWOULDBLOCK error. */
357         return 0;
358       else if (num_written >= lstr->out_buffer_ind)
359         lstr->out_buffer_ind = 0;
360       else if (num_written > 0)
361         {
362           memmove (lstr->out_buffer, lstr->out_buffer + num_written,
363                    lstr->out_buffer_ind - num_written);
364           lstr->out_buffer_ind -= num_written;
365         }
366       else
367         /* If error, just hold the data, for similar reasons as above. */
368         return -1;
369     }
370
371   if (lstr->imp->flusher)
372     return (lstr->imp->flusher) (lstr);
373
374   return 0;
375 }
376
377 int
378 Lstream_flush (Lstream *lstr)
379 {
380   if (Lstream_flush_out (lstr) < 0)
381     return -1;
382
383   /* clear out buffered data */
384   lstr->in_buffer_current = lstr->in_buffer_ind = 0;
385   lstr->unget_buffer_ind = 0;
386
387   return 0;
388 }
389
390 /* We want to add NUM characters.  This function ensures that the
391    buffer is large enough for this (per the buffering size specified
392    in the stream) and returns the number of characters we can
393    actually write.  If FORCE is set, ignore the buffering size
394    and go ahead and make space for all the chars even if it exceeds
395    the buffering size. (This is used to deal with the possibility
396    that the stream writer might refuse to write any bytes now, e.g.
397    if it's getting EWOULDBLOCK errors.   We have to keep stocking them
398    up until they can be written, so as to avoid losing data. */
399
400 static Lstream_data_count
401 Lstream_adding (Lstream *lstr, Lstream_data_count num, int force)
402 {
403   Lstream_data_count size = num + lstr->out_buffer_ind;
404
405   if (size <= lstr->out_buffer_size)
406     return num;
407
408   /* Maybe chop it down so that we don't buffer more characters
409      than our advertised buffering size. */
410   if ((size > lstr->buffering_size) && !force)
411     {
412       size = lstr->buffering_size;
413       /* There might be more data buffered than the buffering size. */
414       if (size <= lstr->out_buffer_ind)
415         return 0;
416     }
417
418   DO_REALLOC (lstr->out_buffer, lstr->out_buffer_size, size, unsigned char);
419
420   return size - lstr->out_buffer_ind;
421 }
422
423 /* Like Lstream_write(), but does not handle line-buffering correctly. */
424
425 static Lstream_data_count
426 Lstream_write_1 (Lstream *lstr, const void *data, Lstream_data_count size)
427 {
428   const unsigned char *p = (const unsigned char *) data;
429   Lstream_data_count off = 0;
430   if (! (lstr->flags & LSTREAM_FL_IS_OPEN))
431     Lstream_internal_error ("lstream not open", lstr);
432   if (! (lstr->flags & LSTREAM_FL_WRITE))
433     Lstream_internal_error ("lstream not open for writing", lstr);
434   {
435     int couldnt_write_last_time = 0;
436
437     while (1)
438       {
439         /* Figure out how much we can add to the buffer */
440         Lstream_data_count chunk = Lstream_adding (lstr, size, 0);
441         if (chunk == 0)
442           {
443             if (couldnt_write_last_time)
444               /* Ung, we ran out of space and tried to flush
445                  the buffer, but it didn't work because the stream
446                  writer is refusing to accept any data.  So we
447                  just have to squirrel away all the rest of the
448                  stuff. */
449               chunk = Lstream_adding (lstr, size, 1);
450             else
451               couldnt_write_last_time = 1;
452           }
453         /* Do it. */
454         if (chunk > 0)
455           {
456             memcpy (lstr->out_buffer + lstr->out_buffer_ind, p + off, chunk);
457             lstr->out_buffer_ind += chunk;
458             lstr->byte_count     += chunk;
459             size -= chunk;
460             off  += chunk;
461           }
462         /* If the buffer is full and we have more to add, flush it out. */
463         if (size > 0)
464           {
465             if (Lstream_flush_out (lstr) < 0)
466               {
467                 if (off == 0)
468                   return -1;
469                 else
470                   return off;
471               }
472           }
473         else
474           break;
475       }
476   }
477   return off;
478 }
479
480 /* If the stream is not line-buffered, then we can just call
481    Lstream_write_1(), which writes in chunks.  Otherwise, we
482    repeatedly call Lstream_putc(), which knows how to handle
483    line buffering.  Returns number of bytes written. */
484
485 Lstream_data_count
486 Lstream_write (Lstream *lstr, const void *data, Lstream_data_count size)
487 {
488   Lstream_data_count i;
489   const unsigned char *p = (const unsigned char *) data;
490
491   if (size == 0)
492     return size;
493   if (lstr->buffering != LSTREAM_LINE_BUFFERED)
494     return Lstream_write_1 (lstr, data, size);
495   for (i = 0; i < size; i++)
496     {
497       if (Lstream_putc (lstr, p[i]) < 0)
498         break;
499     }
500   return i == 0 ? -1 : i;
501 }
502
503 int
504 Lstream_was_blocked_p (Lstream *lstr)
505 {
506   return lstr->imp->was_blocked_p ? lstr->imp->was_blocked_p (lstr) : 0;
507 }
508
509 static Lstream_data_count
510 Lstream_raw_read (Lstream *lstr, unsigned char *buffer,
511                   Lstream_data_count size)
512 {
513   if (! (lstr->flags & LSTREAM_FL_IS_OPEN))
514     Lstream_internal_error ("lstream not open", lstr);
515   if (! (lstr->flags & LSTREAM_FL_READ))
516     Lstream_internal_error ("lstream not open for reading", lstr);
517   if (!lstr->imp->reader)
518     Lstream_internal_error ("lstream has no reader", lstr);
519
520   return (lstr->imp->reader) (lstr, buffer, size);
521 }
522
523 /* Assuming the buffer is empty, fill it up again. */
524
525 static Lstream_data_count
526 Lstream_read_more (Lstream *lstr)
527 {
528 #if 0
529   Lstream_data_count size_needed 
530     = max (1, min (MAX_READ_SIZE, lstr->buffering_size));
531 #else
532   /* If someone requested a larger buffer size, so be it! */
533   Lstream_data_count size_needed =
534     max (1, lstr->buffering_size);
535 #endif
536   Lstream_data_count size_gotten;
537
538   DO_REALLOC (lstr->in_buffer, lstr->in_buffer_size,
539               size_needed, unsigned char);
540   size_gotten = Lstream_raw_read (lstr, lstr->in_buffer, size_needed);
541   lstr->in_buffer_current = max (0, size_gotten);
542   lstr->in_buffer_ind = 0;
543   return size_gotten < 0 ? -1 : size_gotten;
544 }
545
546 Lstream_data_count
547 Lstream_read (Lstream *lstr, void *data, Lstream_data_count size)
548 {
549   unsigned char *p = (unsigned char *) data;
550   Lstream_data_count off = 0;
551   Lstream_data_count chunk;
552   int error_occurred = 0;
553
554   if (size == 0)
555     return 0;
556
557   /* First try to get some data from the unget buffer */
558   chunk = min (size, lstr->unget_buffer_ind);
559   if (chunk > 0)
560     {
561       /* The bytes come back in reverse order. */
562       for (; off < chunk; off++)
563         p[off] = lstr->unget_buffer[--lstr->unget_buffer_ind];
564       lstr->byte_count += chunk;
565       size -= chunk;
566     }
567
568   while (size > 0)
569     {
570       /* Take whatever we can from the in buffer */
571       chunk = min (size, lstr->in_buffer_current - lstr->in_buffer_ind);
572       if (chunk > 0)
573         {
574           memcpy (p + off, lstr->in_buffer + lstr->in_buffer_ind, chunk);
575           lstr->in_buffer_ind += chunk;
576           lstr->byte_count    += chunk;
577           size -= chunk;
578           off  += chunk;
579         }
580
581       /* If we need some more, try to get some more from the stream's end */
582       if (size > 0)
583         {
584           Lstream_data_count retval = Lstream_read_more (lstr);
585           if (retval < 0)
586             error_occurred = 1;
587           if (retval <= 0)
588             break;
589         }
590     }
591
592   /* #### Beware of OFF ending up 0. */
593   if ((lstr->flags & LSTREAM_FL_NO_PARTIAL_CHARS) && off > 0)
594     {
595       /* It's quite possible for us to get passed an incomplete
596          character at the end.  We need to spit back that
597          incomplete character. */
598       const unsigned char *dataend = p + off - 1;
599       /* Optimize the most common case. */
600       if (!BYTE_ASCII_P (*dataend))
601         {
602           /* Go back to the beginning of the last (and possibly partial)
603              character, and bump forward to see if the character is
604              complete. */
605           VALIDATE_CHARPTR_BACKWARD (dataend);
606           if (dataend + REP_BYTES_BY_FIRST_BYTE (*dataend) != p + off)
607             {
608               Lstream_data_count newoff = dataend - p;
609               /* If not, chop the size down to ignore the last char
610                  and stash it away for next time. */
611               Lstream_unread (lstr, dataend, off - newoff);
612               off = newoff;
613             }
614         }
615     }
616
617   return off == 0 && error_occurred ? -1 : off;
618 }
619
620 void
621 Lstream_unread (Lstream *lstr, const void *data, Lstream_data_count size)
622 {
623   const unsigned char *p = (const unsigned char *) data;
624
625   /* Make sure buffer is big enough */
626   DO_REALLOC (lstr->unget_buffer, lstr->unget_buffer_size,
627               lstr->unget_buffer_ind + size, unsigned char);
628
629   lstr->byte_count -= size;
630
631   /* Bytes have to go on in reverse order -- they are reversed
632      again when read back. */
633   while (size--)
634     lstr->unget_buffer[lstr->unget_buffer_ind++] = p[size];
635 }
636
637 int
638 Lstream_rewind (Lstream *lstr)
639 {
640   if (!lstr->imp->rewinder)
641     Lstream_internal_error ("lstream has no rewinder", lstr);
642   if (Lstream_flush (lstr) < 0)
643     return -1;
644   lstr->byte_count = 0;
645   return (lstr->imp->rewinder) (lstr);
646 }
647
648 int
649 Lstream_seekable_p (Lstream *lstr)
650 {
651   if (!lstr->imp->rewinder)
652     return 0;
653   if (!lstr->imp->seekable_p)
654     return 1;
655   return (lstr->imp->seekable_p) (lstr);
656 }
657
658 static int
659 Lstream_pseudo_close (Lstream *lstr)
660 {
661   if (! (lstr->flags & LSTREAM_FL_IS_OPEN))
662     Lstream_internal_error ("lstream is not open", lstr);
663
664   /* don't check errors here -- best not to risk file descriptor loss */
665   return Lstream_flush (lstr);
666 }
667
668 int
669 Lstream_close (Lstream *lstr)
670 {
671   int rc = 0;
672
673   if (lstr->flags & LSTREAM_FL_IS_OPEN)
674     {
675       rc = Lstream_pseudo_close (lstr);
676       /*
677        * We used to return immediately if the closer method reported
678        * failure, leaving the stream open.  But this is no good, for
679        * the following reasons.
680        *
681        * 1. The finalizer method used in GC makes no provision for
682        *    failure, so we must not return without freeing buffer
683        *    memory.
684        *
685        * 2. The closer method may have already freed some memory
686        *    used for I/O in this stream.  E.g. encoding_closer frees
687        *    ENCODING_STREAM_DATA(stream)->runoff.  If a writer method
688        *    tries to use this buffer later, it will write into memory
689        *    that may have been allocated elsewhere.  Sometime later
690        *    you will see a sign that says "Welcome to Crash City."
691        *
692        * 3. The closer can report failure if a flush fails in the
693        *    other stream in a MULE encoding/decoding stream pair.
694        *    The other stream in the pair is closed, but returning
695        *    early leaves the current stream open.  If we try to
696        *    flush the current stream later, we will crash when the
697        *    flusher notices that the other end stream is closed.
698        *
699        * So, we no longer abort the close if the closer method
700        * reports some kind of failure.  We still report the failure
701        * to the caller.
702        */
703       if (lstr->imp->closer)
704         if ((lstr->imp->closer) (lstr) < 0)
705           rc = -1;
706     }
707
708   lstr->flags &= ~LSTREAM_FL_IS_OPEN;
709   lstr->byte_count = 0;
710   /* Note that Lstream_flush() reset all the buffer indices.  That way,
711      the next call to Lstream_putc(), Lstream_getc(), or Lstream_ungetc()
712      on a closed stream will call into the function equivalents, which will
713      cause an error. */
714
715   /* We set the pointers to 0 so that we don't lose when this function
716      is called more than once on the same object */
717   if (lstr->out_buffer)
718     {
719       xfree (lstr->out_buffer);
720       lstr->out_buffer = 0;
721     }
722   if (lstr->in_buffer)
723     {
724       xfree (lstr->in_buffer);
725       lstr->in_buffer = 0;
726     }
727   if (lstr->unget_buffer)
728     {
729       xfree (lstr->unget_buffer);
730       lstr->unget_buffer = 0;
731     }
732
733   return rc;
734 }
735
736 int
737 Lstream_fputc (Lstream *lstr, int c)
738 {
739   unsigned char ch = (unsigned char) c;
740   Lstream_data_count retval = Lstream_write_1 (lstr, &ch, 1);
741   if (retval >= 0 && lstr->buffering == LSTREAM_LINE_BUFFERED && ch == '\n')
742     return Lstream_flush_out (lstr);
743   return retval < 0 ? -1 : 0;
744 }
745
746 int
747 Lstream_fgetc (Lstream *lstr)
748 {
749   unsigned char ch;
750   if (Lstream_read (lstr, &ch, 1) <= 0)
751     return -1;
752   return ch;
753 }
754
755 void
756 Lstream_fungetc (Lstream *lstr, int c)
757 {
758   unsigned char ch = (unsigned char) c;
759   Lstream_unread (lstr, &ch, 1);
760 }
761
762 \f
763 /************************ some stream implementations *********************/
764
765 /*********** a stdio stream ***********/
766
767 struct stdio_stream
768 {
769   FILE *file;
770   int closing;
771 };
772
773 #define STDIO_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, stdio)
774
775 DEFINE_LSTREAM_IMPLEMENTATION ("stdio", lstream_stdio,
776                                sizeof (struct stdio_stream));
777
778 static Lisp_Object
779 make_stdio_stream_1 (FILE *stream, int flags, const char *mode)
780 {
781   Lisp_Object obj;
782   Lstream *lstr = Lstream_new (lstream_stdio, mode);
783   struct stdio_stream *str = STDIO_STREAM_DATA (lstr);
784   str->file = stream;
785   str->closing = flags & LSTR_CLOSING;
786   lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE;
787   XSETLSTREAM (obj, lstr);
788   return obj;
789 }
790
791 Lisp_Object
792 make_stdio_input_stream (FILE *stream, int flags)
793 {
794   return make_stdio_stream_1 (stream, flags, "r");
795 }
796
797 Lisp_Object
798 make_stdio_output_stream (FILE *stream, int flags)
799 {
800   return make_stdio_stream_1 (stream, flags, "w");
801 }
802
803 /* #### From reading the Unix 98 specification, it appears that if we
804    want stdio_reader() to be completely correct, we should check for
805    0 < val < size and if so, check to see if an error has occurred.
806    If an error has occurred, but val is non-zero, we should go ahead
807    and act as if the read was successful, but remember in some fashion
808    or other, that an error has occurred, and report that on the next
809    call to stdio_reader instead of calling fread() again.
810
811    Currently, in such a case, we end up calling fread() twice and we
812    assume that
813
814    1) this is not harmful, and
815    2) the error will still be reported on the second read.
816
817    This is probably reasonable, so I don't think we should change this
818    code (it could even be argued that the error might have fixed
819    itself, so we should do the fread() again.  */
820
821 static Lstream_data_count
822 stdio_reader (Lstream *stream, unsigned char *data, Lstream_data_count size)
823 {
824   struct stdio_stream *str = STDIO_STREAM_DATA (stream);
825   Lstream_data_count val = fread (data, 1, size, str->file);
826   if (!val && ferror (str->file))
827     return -1;
828   return val;
829 }
830
831 static Lstream_data_count
832 stdio_writer (Lstream *stream, const unsigned char *data,
833               Lstream_data_count size)
834 {
835   struct stdio_stream *str = STDIO_STREAM_DATA (stream);
836   Lstream_data_count val = fwrite (data, 1, size, str->file);
837   if (!val && ferror (str->file))
838     return -1;
839   return val;
840 }
841
842 static int
843 stdio_rewinder (Lstream *stream)
844 {
845   rewind (STDIO_STREAM_DATA (stream)->file);
846   return 0;
847 }
848
849 static int
850 stdio_seekable_p (Lstream *stream)
851 {
852   struct stat lestat;
853   struct stdio_stream *str = STDIO_STREAM_DATA (stream);
854
855   if (fstat (fileno (str->file), &lestat) < 0)
856     return 0;
857   return S_ISREG (lestat.st_mode);
858 }
859
860 static int
861 stdio_flusher (Lstream *stream)
862 {
863   struct stdio_stream *str = STDIO_STREAM_DATA (stream);
864   if (stream->flags & LSTREAM_FL_WRITE)
865     return fflush (str->file);
866   else
867     return 0;
868 }
869
870 static int
871 stdio_closer (Lstream *stream)
872 {
873   struct stdio_stream *str = STDIO_STREAM_DATA (stream);
874   if (str->closing)
875     return fclose (str->file);
876   else
877   if (stream->flags & LSTREAM_FL_WRITE)
878     return fflush (str->file);
879   else
880     return 0;
881 }
882
883 /*********** a file descriptor ***********/
884
885 struct filedesc_stream
886 {
887   int fd;
888   int pty_max_bytes;
889   Bufbyte eof_char;
890   int starting_pos;
891   int current_pos;
892   int end_pos;
893   int chars_sans_newline;
894   unsigned int closing :1;
895   unsigned int allow_quit :1;
896   unsigned int blocked_ok :1;
897   unsigned int pty_flushing :1;
898   unsigned int blocking_error_p :1;
899 };
900
901 #define FILEDESC_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, filedesc)
902
903 DEFINE_LSTREAM_IMPLEMENTATION ("filedesc", lstream_filedesc,
904                                sizeof (struct filedesc_stream));
905
906 /* Make a stream that reads from or writes to a file descriptor FILEDESC.
907    OFFSET is the offset from the *current* file pointer that the reading
908    should start at.  COUNT is the number of bytes to be read (it is
909    ignored when writing); -1 for unlimited. */
910 static Lisp_Object
911 make_filedesc_stream_1 (int filedesc, int offset, int count, int flags,
912                         const char *mode)
913 {
914   Lisp_Object obj;
915   Lstream *lstr = Lstream_new (lstream_filedesc, mode);
916   struct filedesc_stream *fstr = FILEDESC_STREAM_DATA (lstr);
917   fstr->fd = filedesc;
918   fstr->closing      = !!(flags & LSTR_CLOSING);
919   fstr->allow_quit   = !!(flags & LSTR_ALLOW_QUIT);
920   fstr->blocked_ok   = !!(flags & LSTR_BLOCKED_OK);
921   fstr->pty_flushing = !!(flags & LSTR_PTY_FLUSHING);
922   fstr->blocking_error_p = 0;
923   fstr->chars_sans_newline = 0;
924   fstr->starting_pos = lseek (filedesc, offset, SEEK_CUR);
925   fstr->current_pos = max (fstr->starting_pos, 0);
926   if (count < 0)
927     fstr->end_pos = -1;
928   else
929     fstr->end_pos = fstr->starting_pos + count;
930   lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE;
931   XSETLSTREAM (obj, lstr);
932   return obj;
933 }
934
935 Lisp_Object
936 make_filedesc_input_stream (int filedesc, int offset, int count, int flags)
937 {
938   return make_filedesc_stream_1 (filedesc, offset, count, flags, "r");
939 }
940
941 Lisp_Object
942 make_filedesc_output_stream (int filedesc, int offset, int count, int flags)
943 {
944   return make_filedesc_stream_1 (filedesc, offset, count, flags, "w");
945 }
946
947 static Lstream_data_count
948 filedesc_reader (Lstream *stream, unsigned char *data, Lstream_data_count size)
949 {
950   Lstream_data_count nread;
951   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
952   if (str->end_pos >= 0)
953     size = min (size, (Lstream_data_count) (str->end_pos - str->current_pos));
954   nread = str->allow_quit ?
955     read_allowing_quit (str->fd, data, size) :
956     read (str->fd, data, size);
957   if (nread > 0)
958     str->current_pos += nread;
959   return nread;
960 }
961
962 static int
963 errno_would_block_p (int val)
964 {
965 #ifdef EWOULDBLOCK
966   if (val == EWOULDBLOCK)
967     return 1;
968 #endif
969 #ifdef EAGAIN
970   if (val == EAGAIN)
971     return 1;
972 #endif
973   return 0;
974 }
975
976 static Lstream_data_count
977 filedesc_writer (Lstream *stream, const unsigned char *data,
978                  Lstream_data_count size)
979 {
980   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
981   Lstream_data_count retval;
982   int need_newline = 0;
983
984   /* This function would be simple if it were not for the blasted
985      PTY max-bytes stuff.  Why the hell can't they just have written
986      the PTY drivers right so this problem doesn't exist?
987
988      Maybe all the PTY crap here should be moved into another stream
989      that does nothing but periodically insert EOF's as necessary. */
990   if (str->pty_flushing)
991     {
992       /* To make life easy, only send out one line at the most. */
993       const unsigned char *ptr;
994
995       ptr = (const unsigned char *) memchr (data, '\n', size);
996       if (ptr)
997         need_newline = 1;
998       else
999         ptr = data + size;
1000       if (ptr - data >= str->pty_max_bytes - str->chars_sans_newline)
1001         {
1002           ptr = data + str->pty_max_bytes - str->chars_sans_newline;
1003           need_newline = 0;
1004         }
1005       size = ptr - data;
1006     }
1007
1008   /**** start of non-PTY-crap ****/
1009   if (size > 0)
1010     retval = str->allow_quit ?
1011       write_allowing_quit (str->fd, data, size) :
1012       write (str->fd, data, size);
1013   else
1014     retval = 0;
1015   if (retval < 0 && errno_would_block_p (errno) && str->blocked_ok)
1016     {
1017       str->blocking_error_p = 1;
1018       return 0;
1019     }
1020   str->blocking_error_p = 0;
1021   if (retval < 0)
1022     return retval;
1023   /**** end non-PTY-crap ****/
1024
1025   if (str->pty_flushing)
1026     {
1027       str->chars_sans_newline += retval;
1028       /* Note that a newline was not among the bytes written out.
1029          Add to the number of non-newline bytes written out,
1030          and flush with an EOF if necessary.  Be careful to
1031          keep track of write errors as we go along and look
1032          out for EWOULDBLOCK. */
1033       if (str->chars_sans_newline >= str->pty_max_bytes)
1034         {
1035           Lstream_data_count retval2 = str->allow_quit ?
1036             write_allowing_quit (str->fd, &str->eof_char, 1) :
1037             write (str->fd, &str->eof_char, 1);
1038
1039           if (retval2 > 0)
1040             str->chars_sans_newline = 0;
1041           else if (retval2 < 0)
1042             {
1043               /* Error writing the EOF char.  If nothing got written,
1044                  then treat this as an error -- either return an error
1045                  condition or set the blocking-error flag. */
1046               if (retval == 0)
1047                 {
1048                   if (errno_would_block_p (errno) && str->blocked_ok)
1049                     {
1050                       str->blocking_error_p = 1;
1051                       return 0;
1052                     }
1053                   else
1054                     return retval2;
1055                 }
1056               else
1057                 return retval;
1058             }
1059         }
1060     }
1061
1062   /* The need_newline flag is necessary because otherwise when the
1063      first byte is a newline, we'd get stuck never writing anything
1064      in pty-flushing mode. */
1065   if (need_newline)
1066     {
1067       Bufbyte nl = '\n';
1068       Lstream_data_count retval2 = str->allow_quit ?
1069         write_allowing_quit (str->fd, &nl, 1) :
1070         write (str->fd, &nl, 1);
1071
1072       if (retval2 > 0)
1073         {
1074           str->chars_sans_newline = 0;
1075           retval++;
1076         }
1077       else if (retval2 < 0)
1078         {
1079           /* Error writing the newline char.  If nothing got written,
1080              then treat this as an error -- either return an error
1081              condition or set the blocking-error flag. */
1082           if (retval == 0)
1083             {
1084               if (errno_would_block_p (errno) && str->blocked_ok)
1085                 {
1086                   str->blocking_error_p = 1;
1087                   return 0;
1088                 }
1089               else
1090                 return retval2;
1091             }
1092           else
1093             return retval;
1094         }
1095     }
1096
1097   return retval;
1098 }
1099
1100 static int
1101 filedesc_rewinder (Lstream *stream)
1102 {
1103   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
1104   if (str->starting_pos < 0 ||
1105       lseek (FILEDESC_STREAM_DATA (stream)->fd, str->starting_pos,
1106              SEEK_SET) == -1)
1107     return -1;
1108   else
1109     {
1110       str->current_pos = str->starting_pos;
1111       return 0;
1112     }
1113 }
1114
1115 static int
1116 filedesc_seekable_p (Lstream *stream)
1117 {
1118   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
1119   if (str->starting_pos < 0)
1120     return 0;
1121   else
1122     {
1123       struct stat lestat;
1124
1125       if (fstat (str->fd, &lestat) < 0)
1126         return 0;
1127       return S_ISREG (lestat.st_mode);
1128     }
1129 }
1130
1131 static int
1132 filedesc_closer (Lstream *stream)
1133 {
1134   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
1135   if (str->closing)
1136     return close (str->fd);
1137   else
1138     return 0;
1139 }
1140
1141 static int
1142 filedesc_was_blocked_p (Lstream *stream)
1143 {
1144   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
1145   return str->blocking_error_p;
1146 }
1147
1148 void
1149 filedesc_stream_set_pty_flushing (Lstream *stream, int pty_max_bytes,
1150                                   Bufbyte eof_char)
1151 {
1152   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
1153   str->pty_max_bytes = pty_max_bytes;
1154   str->eof_char = eof_char;
1155   str->pty_flushing = 1;
1156 }
1157
1158 int
1159 filedesc_stream_fd (Lstream *stream)
1160 {
1161   struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream);
1162   return str->fd;
1163 }
1164
1165 /*********** read from a Lisp string ***********/
1166
1167 #define LISP_STRING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, lisp_string)
1168
1169 struct lisp_string_stream
1170 {
1171   Lisp_Object obj;
1172   Bytecount init_offset;
1173   Bytecount offset, end;
1174 };
1175
1176 DEFINE_LSTREAM_IMPLEMENTATION ("lisp-string", lstream_lisp_string,
1177                                sizeof (struct lisp_string_stream));
1178
1179 Lisp_Object
1180 make_lisp_string_input_stream (Lisp_Object string, Bytecount offset,
1181                                Bytecount len)
1182 {
1183   Lisp_Object obj;
1184   Lstream *lstr;
1185   struct lisp_string_stream *str;
1186
1187   CHECK_STRING (string);
1188   if (len < 0)
1189     len = XSTRING_LENGTH (string) - offset;
1190   assert (offset >= 0);
1191   assert (len >= 0);
1192   assert (offset + len <= XSTRING_LENGTH (string));
1193
1194   lstr = Lstream_new (lstream_lisp_string, "r");
1195   str = LISP_STRING_STREAM_DATA (lstr);
1196   str->offset = offset;
1197   str->end = offset + len;
1198   str->init_offset = offset;
1199   str->obj = string;
1200   XSETLSTREAM (obj, lstr);
1201   return obj;
1202 }
1203
1204 static Lstream_data_count
1205 lisp_string_reader (Lstream *stream, unsigned char *data,
1206                     Lstream_data_count size)
1207 {
1208   struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (stream);
1209   /* Don't lose if the string shrank past us ... */
1210   Bytecount offset = min (str->offset, XSTRING_LENGTH (str->obj));
1211   Bufbyte *strstart = XSTRING_DATA (str->obj);
1212   Bufbyte *start = strstart + offset;
1213
1214   /* ... or if someone changed the string and we ended up in the
1215      middle of a character. */
1216   /* Being in the middle of a character is `normal' unless
1217      LSTREAM_NO_PARTIAL_CHARS - mrb */
1218   if (stream->flags & LSTREAM_FL_NO_PARTIAL_CHARS)
1219     VALIDATE_CHARPTR_BACKWARD (start);
1220   offset = start - strstart;
1221   size = min (size, (Lstream_data_count) (str->end - offset));
1222   memcpy (data, start, size);
1223   str->offset = offset + size;
1224   return size;
1225 }
1226
1227 static int
1228 lisp_string_rewinder (Lstream *stream)
1229 {
1230   struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (stream);
1231   int pos = str->init_offset;
1232   if (pos > str->end)
1233     pos = str->end;
1234   /* Don't lose if the string shrank past us ... */
1235   pos = min (pos, XSTRING_LENGTH (str->obj));
1236   /* ... or if someone changed the string and we ended up in the
1237      middle of a character. */
1238   {
1239     Bufbyte *strstart = XSTRING_DATA (str->obj);
1240     Bufbyte *start = strstart + pos;
1241     VALIDATE_CHARPTR_BACKWARD (start);
1242     pos = start - strstart;
1243   }
1244   str->offset = pos;
1245   return 0;
1246 }
1247
1248 static Lisp_Object
1249 lisp_string_marker (Lisp_Object stream)
1250 {
1251   struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (XLSTREAM (stream));
1252   return str->obj;
1253 }
1254
1255 /*********** a fixed buffer ***********/
1256
1257 #define FIXED_BUFFER_STREAM_DATA(stream) \
1258   LSTREAM_TYPE_DATA (stream, fixed_buffer)
1259
1260 struct fixed_buffer_stream
1261 {
1262   const unsigned char *inbuf;
1263   unsigned char *outbuf;
1264   Lstream_data_count size;
1265   Lstream_data_count offset;
1266 };
1267
1268 DEFINE_LSTREAM_IMPLEMENTATION ("fixed-buffer", lstream_fixed_buffer,
1269                                sizeof (struct fixed_buffer_stream));
1270
1271 Lisp_Object
1272 make_fixed_buffer_input_stream (const void *buf, Lstream_data_count size)
1273 {
1274   Lisp_Object obj;
1275   Lstream *lstr = Lstream_new (lstream_fixed_buffer, "r");
1276   struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr);
1277   str->inbuf = (const unsigned char *) buf;
1278   str->size = size;
1279   XSETLSTREAM (obj, lstr);
1280   return obj;
1281 }
1282
1283 Lisp_Object
1284 make_fixed_buffer_output_stream (void *buf, Lstream_data_count size)
1285 {
1286   Lisp_Object obj;
1287   Lstream *lstr = Lstream_new (lstream_fixed_buffer, "w");
1288   struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr);
1289   str->outbuf = (unsigned char *) buf;
1290   str->size = size;
1291   XSETLSTREAM (obj, lstr);
1292   return obj;
1293 }
1294
1295 static Lstream_data_count
1296 fixed_buffer_reader (Lstream *stream, unsigned char *data,
1297                      Lstream_data_count size)
1298 {
1299   struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream);
1300   size = min (size, str->size - str->offset);
1301   memcpy (data, str->inbuf + str->offset, size);
1302   str->offset += size;
1303   return size;
1304 }
1305
1306 static Lstream_data_count
1307 fixed_buffer_writer (Lstream *stream, const unsigned char *data,
1308                      Lstream_data_count size)
1309 {
1310   struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream);
1311   if (str->offset == str->size)
1312     {
1313       /* If we're at the end, just throw away the data and pretend
1314          we wrote all of it.  If we return 0, then the lstream routines
1315          will try again and again to write it out. */
1316       return size;
1317     }
1318   size = min (size, str->size - str->offset);
1319   memcpy (str->outbuf + str->offset, data, size);
1320   str->offset += size;
1321   return size;
1322 }
1323
1324 static int
1325 fixed_buffer_rewinder (Lstream *stream)
1326 {
1327   FIXED_BUFFER_STREAM_DATA (stream)->offset = 0;
1328   return 0;
1329 }
1330
1331 const unsigned char *
1332 fixed_buffer_input_stream_ptr (Lstream *stream)
1333 {
1334   assert (stream->imp == lstream_fixed_buffer);
1335   return FIXED_BUFFER_STREAM_DATA (stream)->inbuf;
1336 }
1337
1338 unsigned char *
1339 fixed_buffer_output_stream_ptr (Lstream *stream)
1340 {
1341   assert (stream->imp == lstream_fixed_buffer);
1342   return FIXED_BUFFER_STREAM_DATA (stream)->outbuf;
1343 }
1344
1345 /*********** write to a resizing buffer ***********/
1346
1347 #define RESIZING_BUFFER_STREAM_DATA(stream) \
1348   LSTREAM_TYPE_DATA (stream, resizing_buffer)
1349
1350 struct resizing_buffer_stream
1351 {
1352   unsigned char *buf;
1353   Lstream_data_count allocked;
1354   int max_stored;
1355   int stored;
1356 };
1357
1358 DEFINE_LSTREAM_IMPLEMENTATION ("resizing-buffer", lstream_resizing_buffer,
1359                                sizeof (struct resizing_buffer_stream));
1360
1361 Lisp_Object
1362 make_resizing_buffer_output_stream (void)
1363 {
1364   Lisp_Object obj;
1365   XSETLSTREAM (obj, Lstream_new (lstream_resizing_buffer, "w"));
1366   return obj;
1367 }
1368
1369 static Lstream_data_count
1370 resizing_buffer_writer (Lstream *stream, const unsigned char *data,
1371                         Lstream_data_count size)
1372 {
1373   struct resizing_buffer_stream *str = RESIZING_BUFFER_STREAM_DATA (stream);
1374   DO_REALLOC (str->buf, str->allocked, str->stored + size, unsigned char);
1375   memcpy (str->buf + str->stored, data, size);
1376   str->stored += size;
1377   str->max_stored = max (str->max_stored, str->stored);
1378   return size;
1379 }
1380
1381 static int
1382 resizing_buffer_rewinder (Lstream *stream)
1383 {
1384   RESIZING_BUFFER_STREAM_DATA (stream)->stored = 0;
1385   return 0;
1386 }
1387
1388 static int
1389 resizing_buffer_closer (Lstream *stream)
1390 {
1391   struct resizing_buffer_stream *str = RESIZING_BUFFER_STREAM_DATA (stream);
1392   if (str->buf)
1393     {
1394       xfree (str->buf);
1395       str->buf = 0;
1396     }
1397   return 0;
1398 }
1399
1400 unsigned char *
1401 resizing_buffer_stream_ptr (Lstream *stream)
1402 {
1403   return RESIZING_BUFFER_STREAM_DATA (stream)->buf;
1404 }
1405
1406 /*********** write to an unsigned-char dynarr ***********/
1407
1408 /* Note: If you have a dynarr whose type is not unsigned_char_dynarr
1409    but which is really just an unsigned_char_dynarr (e.g. its type
1410    is Bufbyte or Extbyte), just cast to unsigned_char_dynarr. */
1411
1412 #define DYNARR_STREAM_DATA(stream) \
1413   LSTREAM_TYPE_DATA (stream, dynarr)
1414
1415 struct dynarr_stream
1416 {
1417   unsigned_char_dynarr *dyn;
1418 };
1419
1420 DEFINE_LSTREAM_IMPLEMENTATION ("dynarr", lstream_dynarr,
1421                                sizeof (struct dynarr_stream));
1422
1423 Lisp_Object
1424 make_dynarr_output_stream (unsigned_char_dynarr *dyn)
1425 {
1426   Lisp_Object obj;
1427   XSETLSTREAM (obj, Lstream_new (lstream_dynarr, "w"));
1428   DYNARR_STREAM_DATA (XLSTREAM (obj))->dyn = dyn;
1429   return obj;
1430 }
1431
1432 static Lstream_data_count
1433 dynarr_writer (Lstream *stream, const unsigned char *data,
1434                Lstream_data_count size)
1435 {
1436   struct dynarr_stream *str = DYNARR_STREAM_DATA (stream);
1437   Dynarr_add_many (str->dyn, data, size);
1438   return size;
1439 }
1440
1441 static int
1442 dynarr_rewinder (Lstream *stream)
1443 {
1444   Dynarr_reset (DYNARR_STREAM_DATA (stream)->dyn);
1445   return 0;
1446 }
1447
1448 static int
1449 dynarr_closer (Lstream *stream)
1450 {
1451   return 0;
1452 }
1453
1454 /************ read from or write to a Lisp buffer ************/
1455
1456 /* Note: Lisp-buffer read streams never return partial characters,
1457    and Lisp-buffer write streams expect to never get partial
1458    characters. */
1459
1460 #define LISP_BUFFER_STREAM_DATA(stream) \
1461   LSTREAM_TYPE_DATA (stream, lisp_buffer)
1462
1463 struct lisp_buffer_stream
1464 {
1465   Lisp_Object buffer;
1466   Lisp_Object orig_start;
1467   /* we use markers to properly deal with insertion/deletion */
1468   Lisp_Object start, end;
1469   int flags;
1470 };
1471
1472 DEFINE_LSTREAM_IMPLEMENTATION ("lisp-buffer", lstream_lisp_buffer,
1473                                sizeof (struct lisp_buffer_stream));
1474
1475 static Lisp_Object
1476 make_lisp_buffer_stream_1 (struct buffer *buf, Bufpos start, Bufpos end,
1477                            int flags, const char *mode)
1478 {
1479   Lisp_Object obj;
1480   Lstream *lstr;
1481   struct lisp_buffer_stream *str;
1482   Bufpos bmin, bmax;
1483   int reading = !strcmp (mode, "r");
1484
1485   /* Make sure the luser didn't pass "w" in. */
1486   if (!strcmp (mode, "w"))
1487     ABORT ();
1488
1489   if (flags & LSTR_IGNORE_ACCESSIBLE)
1490     {
1491       bmin = BUF_BEG (buf);
1492       bmax = BUF_Z (buf);
1493     }
1494   else
1495     {
1496       bmin = BUF_BEGV (buf);
1497       bmax = BUF_ZV (buf);
1498     }
1499
1500   if (start == -1)
1501     start = bmin;
1502   if (end == -1)
1503     end = bmax;
1504   assert (bmin <= start);
1505   assert (start <= bmax);
1506   if (reading)
1507     {
1508       assert (bmin  <= end);
1509       assert (end   <= bmax);
1510       assert (start <= end);
1511     }
1512
1513   lstr = Lstream_new (lstream_lisp_buffer, mode);
1514   str = LISP_BUFFER_STREAM_DATA (lstr);
1515   {
1516     Lisp_Object marker;
1517     Lisp_Object buffer;
1518
1519     XSETBUFFER (buffer, buf);
1520     marker = Fmake_marker ();
1521     Fset_marker (marker, make_int (start), buffer);
1522     str->start = marker;
1523     marker = Fmake_marker ();
1524     Fset_marker (marker, make_int (start), buffer);
1525     str->orig_start = marker;
1526     if (reading)
1527       {
1528         marker = Fmake_marker ();
1529         Fset_marker (marker, make_int (end), buffer);
1530         str->end = marker;
1531       }
1532     else
1533       str->end = Qnil;
1534     str->buffer = buffer;
1535   }
1536   str->flags = flags;
1537   XSETLSTREAM (obj, lstr);
1538   return obj;
1539 }
1540
1541 Lisp_Object
1542 make_lisp_buffer_input_stream (struct buffer *buf, Bufpos start, Bufpos end,
1543                                int flags)
1544 {
1545   return make_lisp_buffer_stream_1 (buf, start, end, flags, "r");
1546 }
1547
1548 Lisp_Object
1549 make_lisp_buffer_output_stream (struct buffer *buf, Bufpos pos, int flags)
1550 {
1551   Lisp_Object lstr = make_lisp_buffer_stream_1 (buf, pos, 0, flags, "wc");
1552
1553   Lstream_set_character_mode (XLSTREAM (lstr));
1554   return lstr;
1555 }
1556
1557 static Lstream_data_count
1558 lisp_buffer_reader (Lstream *stream, unsigned char *data,
1559                     Lstream_data_count size)
1560 {
1561   struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream);
1562   unsigned char *orig_data = data;
1563   Bytind start;
1564   Bytind end;
1565   struct buffer *buf = XBUFFER (str->buffer);
1566
1567   if (!BUFFER_LIVE_P (buf))
1568     return 0; /* Fut. */
1569
1570   /* NOTE: We do all our operations in Bytind's.
1571      Keep in mind that SIZE is a value in bytes, not chars. */
1572
1573   start = bi_marker_position (str->start);
1574   end = bi_marker_position (str->end);
1575   if (!(str->flags & LSTR_IGNORE_ACCESSIBLE))
1576     {
1577       start = bytind_clip_to_bounds (BI_BUF_BEGV (buf), start,
1578                                      BI_BUF_ZV (buf));
1579       end = bytind_clip_to_bounds (BI_BUF_BEGV (buf), end,
1580                                    BI_BUF_ZV (buf));
1581     }
1582
1583   size = min (size, (Lstream_data_count) (end - start));
1584   end = start + size;
1585   /* We cannot return a partial character. */
1586   VALIDATE_BYTIND_BACKWARD (buf, end);
1587
1588   while (start < end)
1589     {
1590       Bytind ceil;
1591       Bytecount chunk;
1592
1593       if (str->flags & LSTR_IGNORE_ACCESSIBLE)
1594         ceil = BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE (buf, start);
1595       else
1596         ceil = BI_BUF_CEILING_OF (buf, start);
1597       chunk = min (ceil, end) - start;
1598       memcpy (data, BI_BUF_BYTE_ADDRESS (buf, start), chunk);
1599       data += chunk;
1600       start += chunk;
1601     }
1602
1603   if (EQ (buf->selective_display, Qt) && str->flags & LSTR_SELECTIVE)
1604     {
1605       /* What a kludge.  What a kludge.  What a kludge. */
1606       unsigned char *p;
1607       for (p = orig_data; p < data; p++)
1608         if (*p == '\r')
1609           *p = '\n';
1610     }
1611
1612   set_bi_marker_position (str->start, end);
1613   return data - orig_data;
1614 }
1615
1616 static Lstream_data_count
1617 lisp_buffer_writer (Lstream *stream, const unsigned char *data,
1618                     Lstream_data_count size)
1619 {
1620   struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream);
1621   Bufpos pos;
1622   struct buffer *buf = XBUFFER (str->buffer);
1623
1624   if (!BUFFER_LIVE_P (buf))
1625     return 0; /* Fut. */
1626
1627   pos = marker_position (str->start);
1628   pos += buffer_insert_raw_string_1 (buf, pos, data, size, 0);
1629   set_marker_position (str->start, pos);
1630   return size;
1631 }
1632
1633 static int
1634 lisp_buffer_rewinder (Lstream *stream)
1635 {
1636   struct lisp_buffer_stream *str =
1637     LISP_BUFFER_STREAM_DATA (stream);
1638   struct buffer *buf = XBUFFER (str->buffer);
1639   long pos = marker_position (str->orig_start);
1640   if (!BUFFER_LIVE_P (buf))
1641     return -1; /* Fut. */
1642   if (pos > BUF_ZV (buf))
1643     pos = BUF_ZV (buf);
1644   if (pos < marker_position (str->orig_start))
1645     pos = marker_position (str->orig_start);
1646   if (MARKERP (str->end) && pos > marker_position (str->end))
1647     pos = marker_position (str->end);
1648   set_marker_position (str->start, pos);
1649   return 0;
1650 }
1651
1652 static Lisp_Object
1653 lisp_buffer_marker (Lisp_Object stream)
1654 {
1655   struct lisp_buffer_stream *str =
1656     LISP_BUFFER_STREAM_DATA (XLSTREAM (stream));
1657
1658   mark_object (str->start);
1659   mark_object (str->end);
1660   return str->buffer;
1661 }
1662
1663 Bufpos
1664 lisp_buffer_stream_startpos (Lstream *stream)
1665 {
1666   return marker_position (LISP_BUFFER_STREAM_DATA (stream)->start);
1667 }
1668
1669 \f
1670 /************************************************************************/
1671 /*                            initialization                            */
1672 /************************************************************************/
1673
1674 void
1675 lstream_type_create (void)
1676 {
1677   LSTREAM_HAS_METHOD (stdio, reader);
1678   LSTREAM_HAS_METHOD (stdio, writer);
1679   LSTREAM_HAS_METHOD (stdio, rewinder);
1680   LSTREAM_HAS_METHOD (stdio, seekable_p);
1681   LSTREAM_HAS_METHOD (stdio, flusher);
1682   LSTREAM_HAS_METHOD (stdio, closer);
1683
1684   LSTREAM_HAS_METHOD (filedesc, reader);
1685   LSTREAM_HAS_METHOD (filedesc, writer);
1686   LSTREAM_HAS_METHOD (filedesc, was_blocked_p);
1687   LSTREAM_HAS_METHOD (filedesc, rewinder);
1688   LSTREAM_HAS_METHOD (filedesc, seekable_p);
1689   LSTREAM_HAS_METHOD (filedesc, closer);
1690
1691   LSTREAM_HAS_METHOD (lisp_string, reader);
1692   LSTREAM_HAS_METHOD (lisp_string, rewinder);
1693   LSTREAM_HAS_METHOD (lisp_string, marker);
1694
1695   LSTREAM_HAS_METHOD (fixed_buffer, reader);
1696   LSTREAM_HAS_METHOD (fixed_buffer, writer);
1697   LSTREAM_HAS_METHOD (fixed_buffer, rewinder);
1698
1699   LSTREAM_HAS_METHOD (resizing_buffer, writer);
1700   LSTREAM_HAS_METHOD (resizing_buffer, rewinder);
1701   LSTREAM_HAS_METHOD (resizing_buffer, closer);
1702
1703   LSTREAM_HAS_METHOD (dynarr, writer);
1704   LSTREAM_HAS_METHOD (dynarr, rewinder);
1705   LSTREAM_HAS_METHOD (dynarr, closer);
1706
1707   LSTREAM_HAS_METHOD (lisp_buffer, reader);
1708   LSTREAM_HAS_METHOD (lisp_buffer, writer);
1709   LSTREAM_HAS_METHOD (lisp_buffer, rewinder);
1710   LSTREAM_HAS_METHOD (lisp_buffer, marker);
1711 }
1712
1713 void
1714 reinit_vars_of_lstream (void)
1715 {
1716   int i;
1717
1718   for (i = 0; i < countof (Vlstream_free_list); i++)
1719     {
1720       Vlstream_free_list[i] = Qnil;
1721       staticpro_nodump (&Vlstream_free_list[i]);
1722     }
1723 }
1724
1725 void
1726 vars_of_lstream (void)
1727 {
1728   INIT_LRECORD_IMPLEMENTATION (lstream);
1729
1730   reinit_vars_of_lstream ();
1731 }