Mercurial > hg > xemacs-beta
annotate src/lstream.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | e0db3c197671 |
| children | b5df3737028a |
| rev | line source |
|---|---|
| 428 | 1 /* Generic stream implementation. |
| 2 Copyright (C) 1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
4 Copyright (C) 1996, 2001, 2002, 2010 Ben Wing. |
| 428 | 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 | |
| 771 | 36 /* This module provides a generic buffering stream implementation. |
| 428 | 37 Conceptually, you send data to the stream or read data from the |
| 38 stream, not caring what's on the other end of the stream. The | |
| 39 other end could be another stream, a file descriptor, a stdio | |
| 40 stream, a fixed block of memory, a reallocating block of memory, | |
| 41 etc. The main purpose of the stream is to provide a standard | |
| 42 interface and to do buffering. Macros are defined to read | |
| 43 or write characters, so the calling functions do not have to | |
| 44 worry about blocking data together in order to achieve efficiency. | |
| 45 | |
| 771 | 46 Note that this object is called "stream" in Lisp but "lstream" |
| 428 | 47 in C. The reason for this is that "stream" is too generic a name |
| 48 for C; too much likelihood of conflict/confusion with C++, etc. */ | |
| 49 | |
| 50 #define DEFAULT_BLOCK_BUFFERING_SIZE 512 | |
| 51 #define MAX_READ_SIZE 512 | |
| 52 | |
| 53 static Lisp_Object | |
| 54 mark_lstream (Lisp_Object obj) | |
| 55 { | |
| 56 Lstream *lstr = XLSTREAM (obj); | |
| 57 return lstr->imp->marker ? (lstr->imp->marker) (obj) : Qnil; | |
| 58 } | |
| 59 | |
| 60 static void | |
| 2286 | 61 print_lstream (Lisp_Object obj, Lisp_Object printcharfun, |
| 62 int UNUSED (escapeflag)) | |
| 428 | 63 { |
| 64 Lstream *lstr = XLSTREAM (obj); | |
| 65 | |
| 800 | 66 write_fmt_string (printcharfun, |
| 67 "#<INTERNAL OBJECT (XEmacs bug?) (%s lstream) 0x%lx>", | |
| 68 lstr->imp->name, (long) lstr); | |
| 428 | 69 } |
| 70 | |
| 71 static void | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
72 finalize_lstream (void *header) |
| 428 | 73 { |
| 74 /* WARNING WARNING WARNING. This function (and all finalize functions) | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
75 may get called more than once on the same object. */ |
| 428 | 76 Lstream *lstr = (Lstream *) header; |
| 77 | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
78 if (lstr->flags & LSTREAM_FL_IS_OPEN) |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
79 Lstream_close (lstr); |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
80 |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
81 if (lstr->imp->finalizer) |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
82 (lstr->imp->finalizer) (lstr); |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
83 } |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
84 |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
85 static void |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
86 disksave_lstream (Lisp_Object lstream) |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
87 { |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
88 Lstream *lstr = XLSTREAM (lstream); |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
89 |
| 428 | 90 #if 0 /* this may cause weird Broken Pipes? */ |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
91 Lstream_pseudo_close (lstr); |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
92 return; |
| 428 | 93 #endif |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
94 if ((lstr->flags & LSTREAM_FL_IS_OPEN) && |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
95 (lstr->flags & LSTREAM_FL_CLOSE_AT_DISKSAVE)) |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
96 Lstream_close (lstr); |
| 428 | 97 } |
| 98 | |
| 665 | 99 inline static Bytecount |
| 100 aligned_sizeof_lstream (Bytecount lstream_type_specific_size) | |
| 456 | 101 { |
| 826 | 102 return MAX_ALIGN_SIZE (offsetof (Lstream, data) + |
| 103 lstream_type_specific_size); | |
| 456 | 104 } |
| 105 | |
| 665 | 106 static Bytecount |
| 442 | 107 sizeof_lstream (const void *header) |
| 428 | 108 { |
| 456 | 109 return aligned_sizeof_lstream (((const Lstream *) header)->imp->size); |
| 428 | 110 } |
| 111 | |
| 1204 | 112 static const struct memory_description lstream_implementation_description_1[] |
| 113 = { | |
| 114 { XD_END } | |
| 115 }; | |
| 116 | |
| 117 const struct sized_memory_description lstream_implementation_description = { | |
| 118 sizeof (struct lstream_implementation), | |
| 119 lstream_implementation_description_1 | |
| 120 }; | |
| 121 | |
| 122 static const struct sized_memory_description lstream_extra_description_map[] = | |
| 123 { | |
| 124 { offsetof (Lstream, imp) }, | |
| 125 { offsetof (struct lstream_implementation, extra_description) }, | |
| 126 { -1 }, | |
| 127 }; | |
| 128 | |
| 129 static const struct memory_description lstream_description[] = | |
| 130 { | |
| 2367 | 131 { XD_BLOCK_PTR, offsetof (Lstream, imp), 1, |
| 2551 | 132 { &lstream_implementation_description } }, |
| 2367 | 133 { XD_BLOCK_ARRAY, offsetof (Lstream, data), 1, |
| 2551 | 134 { lstream_extra_description_map } }, |
| 1204 | 135 { XD_END } |
| 136 }; | |
| 137 | |
| 138 static const struct memory_description lstream_empty_extra_description_1[] = | |
| 139 { | |
| 140 { XD_END } | |
| 141 }; | |
| 142 | |
| 143 const struct sized_memory_description lstream_empty_extra_description = { | |
| 144 0, lstream_empty_extra_description_1 | |
| 145 }; | |
| 146 | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
147 DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT ("stream", lstream, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
148 mark_lstream, print_lstream, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
149 finalize_lstream, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
150 0, 0, /* no equal or hash */ |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
151 lstream_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
152 0, 0, 0, 0, /* no property meths */ |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
153 disksave_lstream, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
154 sizeof_lstream, Lstream); |
| 428 | 155 |
| 771 | 156 |
| 157 /* Change the buffering of a stream. See lstream.h. By default the | |
| 158 buffering is STREAM_BLOCK_BUFFERED. */ | |
| 159 | |
| 428 | 160 void |
| 161 Lstream_set_buffering (Lstream *lstr, Lstream_buffering buffering, | |
| 162 int buffering_size) | |
| 163 { | |
| 164 lstr->buffering = buffering; | |
| 165 switch (buffering) | |
| 166 { | |
| 167 case LSTREAM_UNBUFFERED: | |
| 168 lstr->buffering_size = 0; break; | |
| 169 case LSTREAM_BLOCK_BUFFERED: | |
| 170 lstr->buffering_size = DEFAULT_BLOCK_BUFFERING_SIZE; break; | |
| 171 case LSTREAM_BLOCKN_BUFFERED: | |
| 172 lstr->buffering_size = buffering_size; break; | |
| 173 case LSTREAM_LINE_BUFFERED: | |
| 174 case LSTREAM_UNLIMITED: | |
| 175 lstr->buffering_size = INT_MAX; break; | |
| 176 } | |
| 177 } | |
| 178 | |
| 3263 | 179 #ifndef NEW_GC |
| 442 | 180 static const Lstream_implementation *lstream_types[32]; |
| 428 | 181 static Lisp_Object Vlstream_free_list[32]; |
| 182 static int lstream_type_count; | |
| 3263 | 183 #endif /* not NEW_GC */ |
| 428 | 184 |
| 771 | 185 /* Allocate and return a new Lstream. This function is not really |
| 186 meant to be called directly; rather, each stream type should | |
| 187 provide its own stream creation function, which creates the stream | |
| 188 and does any other necessary creation stuff (e.g. opening a | |
| 189 file). */ | |
| 190 | |
| 428 | 191 Lstream * |
| 442 | 192 Lstream_new (const Lstream_implementation *imp, const char *mode) |
| 428 | 193 { |
| 194 Lstream *p; | |
| 3263 | 195 #ifdef NEW_GC |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
196 p = XLSTREAM (alloc_sized_lrecord (aligned_sizeof_lstream (imp->size), |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
197 &lrecord_lstream)); |
| 3263 | 198 #else /* not NEW_GC */ |
| 428 | 199 int i; |
| 200 | |
| 201 for (i = 0; i < lstream_type_count; i++) | |
| 202 { | |
| 203 if (lstream_types[i] == imp) | |
| 204 break; | |
| 205 } | |
| 206 | |
| 207 if (i == lstream_type_count) | |
| 208 { | |
| 209 assert (lstream_type_count < countof (lstream_types)); | |
| 210 lstream_types[lstream_type_count] = imp; | |
| 211 Vlstream_free_list[lstream_type_count] = | |
| 456 | 212 make_lcrecord_list (aligned_sizeof_lstream (imp->size), |
| 428 | 213 &lrecord_lstream); |
| 214 lstream_type_count++; | |
| 215 } | |
| 216 | |
| 1204 | 217 p = XLSTREAM (alloc_managed_lcrecord (Vlstream_free_list[i])); |
| 3263 | 218 #endif /* not NEW_GC */ |
| 428 | 219 /* Zero it out, except the header. */ |
| 456 | 220 memset ((char *) p + sizeof (p->header), '\0', |
| 221 aligned_sizeof_lstream (imp->size) - sizeof (p->header)); | |
| 428 | 222 p->imp = imp; |
| 223 Lstream_set_buffering (p, LSTREAM_BLOCK_BUFFERED, 0); | |
| 224 p->flags = LSTREAM_FL_IS_OPEN; | |
| 225 | |
| 226 /* convert mode (one of "r", "w", "rc", "wc") to p->flags */ | |
| 227 assert (mode[0] == 'r' || mode[0] == 'w'); | |
| 228 assert (mode[1] == 'c' || mode[1] == '\0'); | |
| 229 p->flags |= (mode[0] == 'r' ? LSTREAM_FL_READ : LSTREAM_FL_WRITE); | |
| 230 if (mode[1] == 'c') | |
| 231 p->flags |= LSTREAM_FL_NO_PARTIAL_CHARS; | |
| 232 | |
| 233 return p; | |
| 234 } | |
| 235 | |
| 771 | 236 /* Set or unset "character mode" on the stream. The basic idea is that, |
| 237 assuming valid internal-format data is passing through the stream and | |
| 238 we're processing the data character by character, we don't want partial | |
| 239 characters at the end of the data. (No partial characters at the | |
| 240 beginning happens naturally if we eliminate partial characters at the | |
| 241 end and the stream is implemented correctly.) | |
| 242 | |
| 243 Character mode actually has two somewhat different meanings, depending | |
| 244 on whether this is a read stream or write stream. If a read stream, | |
| 245 character mode means that data returned from calling Lstream_read() on | |
| 246 the stream will contain only full characters. If a write stream, | |
| 247 character mode means that data passed to the write method in the stream | |
| 248 implementation will contain only full characters. It's important to | |
| 249 note the non-parallelism in who should set this mode on the stream: The | |
| 250 *CALLER* sets character mode on read streams it creates; the *STREAM | |
| 251 ITSELF* sets character mode on write streams, typically at creation | |
| 814 | 252 time. |
| 253 | |
| 254 (However, if a read stream always generates internal-format data, then | |
| 255 the callers will almost always want character mode, and it's allowed to | |
| 256 set this on behalf of the caller, as long as a flag can be provided at | |
| 257 creation time to disable this behavior.) */ | |
| 771 | 258 |
| 428 | 259 void |
| 260 Lstream_set_character_mode (Lstream *lstr) | |
| 261 { | |
| 262 lstr->flags |= LSTREAM_FL_NO_PARTIAL_CHARS; | |
| 263 } | |
| 264 | |
| 771 | 265 /* Unset character mode. See Lstream_set_character_mode(). */ |
| 266 | |
| 267 void | |
| 268 Lstream_unset_character_mode (Lstream *lstr) | |
| 269 { | |
| 270 lstr->flags &= ~LSTREAM_FL_NO_PARTIAL_CHARS; | |
| 271 } | |
| 272 | |
| 273 /* Close the stream (if it's open), and free all memory associated with the | |
| 274 stream. Put the stream on a free list; later calls to create a new | |
| 275 stream of this type may reuse this stream. Calling this is not strictly | |
| 276 necessary, but it is much more efficient than having the Lstream be | |
| 277 garbage-collected. Be VERY VERY SURE there are no pointers to this | |
| 278 object hanging around anywhere where they might be used! When streams | |
| 279 are chained together, be VERY CAREFUL of the order in which you delete | |
| 280 them! (e.g. if the streams are in a singly-linked list, delete the head | |
| 814 | 281 first; this will close (but check the documentation, e.g. of |
| 282 make_coding_input_stream()), and may send data down to the rest. Then | |
| 771 | 283 proceed to the rest, one by one. If the chains are in a doubly-linked |
| 284 list, close all the streams first (again, from the head to the tail), | |
| 285 disconnect the back links, then delete starting from the head. In | |
| 814 | 286 general, it's a good idea to close everything before deleting anything. |
| 771 | 287 |
| 288 NOTE: DO NOT CALL DURING GARBAGE COLLECTION (e.g. in a finalizer). You | |
| 289 will be aborted. See free_managed_lcrecord(). */ | |
| 290 | |
| 428 | 291 void |
| 292 Lstream_delete (Lstream *lstr) | |
| 293 { | |
| 3263 | 294 #ifndef NEW_GC |
| 428 | 295 int i; |
| 3263 | 296 #endif /* not NEW_GC */ |
| 793 | 297 Lisp_Object val = wrap_lstream (lstr); |
| 428 | 298 |
| 3263 | 299 #ifdef NEW_GC |
| 2720 | 300 free_lrecord (val); |
| 3263 | 301 #else /* not NEW_GC */ |
| 428 | 302 for (i = 0; i < lstream_type_count; i++) |
| 303 { | |
| 304 if (lstream_types[i] == lstr->imp) | |
| 305 { | |
| 306 free_managed_lcrecord (Vlstream_free_list[i], val); | |
| 307 return; | |
| 308 } | |
| 309 } | |
| 310 | |
| 2500 | 311 ABORT (); |
| 3263 | 312 #endif /* not NEW_GC */ |
| 428 | 313 } |
| 314 | |
| 315 #define Lstream_internal_error(reason, lstr) \ | |
| 563 | 316 signal_error (Qinternal_error, reason, wrap_lstream (lstr)) |
| 428 | 317 |
| 771 | 318 /* Reopen a closed stream. This enables I/O on it again. This is not |
| 319 meant to be called except from a wrapper routine that reinitializes | |
| 320 variables and such -- the close routine may well have freed some | |
| 321 necessary storage structures, for example. */ | |
| 322 | |
| 428 | 323 void |
| 324 Lstream_reopen (Lstream *lstr) | |
| 325 { | |
| 326 if (lstr->flags & LSTREAM_FL_IS_OPEN) | |
| 327 Lstream_internal_error ("lstream already open", lstr); | |
| 328 lstr->flags |= LSTREAM_FL_IS_OPEN; | |
| 329 } | |
| 330 | |
| 771 | 331 /* Try to write as much of DATA as possible to the stream. Return the |
| 332 number of bytes written. */ | |
| 428 | 333 |
| 771 | 334 static int |
| 335 Lstream_really_write (Lstream *lstr, const unsigned char *data, int size) | |
| 428 | 336 { |
| 665 | 337 Bytecount num_written; |
| 771 | 338 const unsigned char *orig_data = data; |
| 339 int error_occurred = 0; | |
| 428 | 340 |
| 771 | 341 while (size > 0) |
| 428 | 342 { |
| 343 if (! (lstr->flags & LSTREAM_FL_IS_OPEN)) | |
| 344 Lstream_internal_error ("lstream not open", lstr); | |
| 345 if (! (lstr->flags & LSTREAM_FL_WRITE)) | |
| 346 Lstream_internal_error ("lstream not open for writing", lstr); | |
| 347 if (!lstr->imp->writer) | |
| 348 Lstream_internal_error ("lstream has no writer", lstr); | |
| 349 | |
| 350 if (lstr->flags & LSTREAM_FL_NO_PARTIAL_CHARS) | |
| 351 /* It's quite possible for us to get passed an incomplete | |
| 352 character at the end. We need to spit back that | |
| 353 incomplete character. */ | |
| 354 { | |
| 442 | 355 const unsigned char *dataend = data + size - 1; |
| 428 | 356 assert (size > 0); /* safety check ... */ |
| 357 /* Optimize the most common case. */ | |
| 826 | 358 if (!byte_ascii_p (*dataend)) |
| 428 | 359 { |
| 360 /* Go back to the beginning of the last (and possibly partial) | |
| 361 character, and bump forward to see if the character is | |
| 362 complete. */ | |
| 867 | 363 VALIDATE_IBYTEPTR_BACKWARD (dataend); |
| 826 | 364 if (dataend + rep_bytes_by_first_byte (*dataend) != data + size) |
| 428 | 365 /* If not, chop the size down to ignore the last char |
| 366 and stash it away for next time. */ | |
| 367 size = dataend - data; | |
| 368 /* If we don't even have one character to write, then just | |
| 369 skip out. */ | |
| 370 if (size == 0) | |
| 371 break; | |
| 372 } | |
| 373 } | |
| 374 | |
| 771 | 375 num_written = (lstr->imp->writer) (lstr, data, size); |
| 428 | 376 if (num_written == 0) |
| 377 /* If nothing got written, then just hold the data. This may | |
| 378 occur, for example, if this stream does non-blocking I/O; | |
| 379 the attempt to write the data might have resulted in an | |
| 380 EWOULDBLOCK error. */ | |
| 771 | 381 break; |
| 382 else if (num_written > size) | |
| 2500 | 383 ABORT (); |
| 428 | 384 else if (num_written > 0) |
| 385 { | |
| 771 | 386 data += num_written; |
| 387 size -= num_written; | |
| 428 | 388 } |
| 389 else | |
| 771 | 390 { |
| 391 /* If error, just hold the data, for similar reasons as above. */ | |
| 392 error_occurred = 1; | |
| 393 break; | |
| 394 } | |
| 428 | 395 } |
| 396 | |
| 2383 | 397 if (!error_occurred && lstr->imp->flusher) |
| 771 | 398 error_occurred = (lstr->imp->flusher) (lstr) < 0; |
| 399 | |
| 400 if (data == orig_data && error_occurred) | |
| 401 return -1; | |
| 402 | |
| 403 return data - orig_data; | |
| 404 } | |
| 405 | |
| 406 /* Attempt to flush out all of the buffered data for writing. Leaves | |
| 407 whatever wasn't flushed sitting in the stream's buffers. Return -1 if | |
| 408 nothing written and error occurred, 0 otherwise. */ | |
| 428 | 409 |
| 771 | 410 int |
| 411 Lstream_flush_out (Lstream *lstr) | |
| 412 { | |
| 413 Bytecount num_written = | |
| 414 Lstream_really_write (lstr, lstr->out_buffer, lstr->out_buffer_ind); | |
| 415 if (num_written == lstr->out_buffer_ind) | |
| 416 { | |
| 417 lstr->out_buffer_ind = 0; | |
| 418 return 0; | |
| 419 } | |
| 420 else if (num_written > 0) | |
| 421 { | |
| 422 memmove (lstr->out_buffer, lstr->out_buffer + num_written, | |
| 423 lstr->out_buffer_ind - num_written); | |
| 424 lstr->out_buffer_ind -= num_written; | |
| 425 return 0; | |
| 426 } | |
| 427 else return num_written; | |
| 428 | 428 } |
| 429 | |
| 771 | 430 /* Flush out any pending unwritten data in the stream. Clear any buffered |
| 431 input data. This differs from Lstream_flush_out() in that it also | |
| 432 clears any unflushable buffered data. Returns 0 on success, -1 on | |
| 433 error. */ | |
| 434 | |
| 428 | 435 int |
| 436 Lstream_flush (Lstream *lstr) | |
| 437 { | |
| 438 if (Lstream_flush_out (lstr) < 0) | |
| 439 return -1; | |
| 440 | |
| 441 /* clear out buffered data */ | |
| 442 lstr->in_buffer_current = lstr->in_buffer_ind = 0; | |
| 443 lstr->unget_buffer_ind = 0; | |
| 444 | |
| 445 return 0; | |
| 446 } | |
| 447 | |
| 448 /* We want to add NUM characters. This function ensures that the | |
| 449 buffer is large enough for this (per the buffering size specified | |
| 450 in the stream) and returns the number of characters we can | |
| 451 actually write. If FORCE is set, ignore the buffering size | |
| 452 and go ahead and make space for all the chars even if it exceeds | |
| 453 the buffering size. (This is used to deal with the possibility | |
| 454 that the stream writer might refuse to write any bytes now, e.g. | |
| 455 if it's getting EWOULDBLOCK errors. We have to keep stocking them | |
| 771 | 456 up until they can be written, so as to avoid losing data.) */ |
| 428 | 457 |
| 665 | 458 static Bytecount |
| 459 Lstream_adding (Lstream *lstr, Bytecount num, int force) | |
| 428 | 460 { |
| 665 | 461 Bytecount size = num + lstr->out_buffer_ind; |
| 430 | 462 |
| 463 if (size <= lstr->out_buffer_size) | |
| 464 return num; | |
| 465 | |
| 428 | 466 /* Maybe chop it down so that we don't buffer more characters |
| 467 than our advertised buffering size. */ | |
| 430 | 468 if ((size > lstr->buffering_size) && !force) |
| 469 { | |
| 470 size = lstr->buffering_size; | |
| 471 /* There might be more data buffered than the buffering size. */ | |
| 472 if (size <= lstr->out_buffer_ind) | |
| 473 return 0; | |
| 474 } | |
| 475 | |
| 476 DO_REALLOC (lstr->out_buffer, lstr->out_buffer_size, size, unsigned char); | |
| 477 | |
| 478 return size - lstr->out_buffer_ind; | |
| 428 | 479 } |
| 480 | |
| 481 /* Like Lstream_write(), but does not handle line-buffering correctly. */ | |
| 482 | |
| 771 | 483 static int |
| 665 | 484 Lstream_write_1 (Lstream *lstr, const void *data, Bytecount size) |
| 428 | 485 { |
| 442 | 486 const unsigned char *p = (const unsigned char *) data; |
| 665 | 487 Bytecount off = 0; |
| 428 | 488 if (! (lstr->flags & LSTREAM_FL_IS_OPEN)) |
| 489 Lstream_internal_error ("lstream not open", lstr); | |
| 490 if (! (lstr->flags & LSTREAM_FL_WRITE)) | |
| 491 Lstream_internal_error ("lstream not open for writing", lstr); | |
| 771 | 492 |
| 493 if (lstr->buffering == LSTREAM_UNBUFFERED) | |
| 494 { | |
| 495 /* If there is buffered data, it means we ran into blocking | |
| 496 errors the previous time and had to buffer our remaining | |
| 497 data. Try to write it now. */ | |
| 498 if (lstr->out_buffer_ind > 0) | |
| 499 { | |
| 500 if (Lstream_flush_out (lstr) < 0) | |
| 501 return -1; | |
| 502 } | |
| 503 | |
| 504 /* If not still blocked, try to write the new data */ | |
| 505 if (lstr->out_buffer_ind == 0) | |
| 506 { | |
| 507 /* we don't need to loop because Lstream_really_write does that | |
| 508 for us. */ | |
| 509 Bytecount num_written = Lstream_really_write (lstr, p, size); | |
| 510 if (num_written < 0) | |
| 511 return -1; | |
| 512 off += num_written; | |
| 513 } | |
| 514 | |
| 515 /* squirrel away the rest of the data */ | |
| 516 if (off < size) | |
| 517 { | |
| 518 Lstream_adding (lstr, size - off, 1); | |
| 519 memcpy (lstr->out_buffer + lstr->out_buffer_ind, p + off, | |
| 520 size - off); | |
| 521 lstr->out_buffer_ind += size - off; | |
| 522 } | |
| 523 | |
| 524 lstr->byte_count += size; | |
| 525 return 0; | |
| 526 } | |
| 527 else | |
| 528 { | |
| 529 int couldnt_write_last_time = 0; | |
| 428 | 530 |
| 771 | 531 while (1) |
| 532 { | |
| 533 /* Figure out how much we can add to the buffer */ | |
| 534 Bytecount chunk = Lstream_adding (lstr, size, 0); | |
| 535 if (chunk == 0) | |
| 536 { | |
| 537 if (couldnt_write_last_time) | |
| 538 /* Ung, we ran out of space and tried to flush | |
| 539 the buffer, but it didn't work because the stream | |
| 540 writer is refusing to accept any data. So we | |
| 541 just have to squirrel away all the rest of the | |
| 542 stuff. */ | |
| 543 chunk = Lstream_adding (lstr, size, 1); | |
| 544 else | |
| 545 couldnt_write_last_time = 1; | |
| 546 } | |
| 547 /* Do it. */ | |
| 548 if (chunk > 0) | |
| 549 { | |
| 550 memcpy (lstr->out_buffer + lstr->out_buffer_ind, p + off, chunk); | |
| 551 lstr->out_buffer_ind += chunk; | |
| 552 lstr->byte_count += chunk; | |
| 553 size -= chunk; | |
| 554 off += chunk; | |
| 555 } | |
| 556 /* If the buffer is full and we have more to add, flush it out. */ | |
| 557 if (size > 0) | |
| 558 { | |
| 559 if (Lstream_flush_out (lstr) < 0) | |
| 560 { | |
| 561 if (off == 0) | |
| 562 return -1; | |
| 563 else | |
| 564 return 0; | |
| 565 } | |
| 566 } | |
| 567 else | |
| 568 break; | |
| 569 } | |
| 570 } | |
| 571 return 0; | |
| 428 | 572 } |
| 573 | |
| 771 | 574 /* Write SIZE bytes of DATA to the stream. Return value is 0 on success, |
| 575 -1 on error. -1 is only returned when no bytes could be written; if any | |
| 576 bytes could be written, then 0 is returned and any unwritten bytes are | |
| 577 buffered and the next call to Lstream_write() will try to write them | |
| 578 again. (This buffering happens even when the stream's buffering type is | |
| 579 LSTREAM_UNBUFFERED, and regardless of how much data is passed in or what | |
| 580 the stream's buffering size was set to. #### There should perhaps be a | |
| 581 way to control whether this happens.) */ | |
| 428 | 582 |
| 771 | 583 int |
| 665 | 584 Lstream_write (Lstream *lstr, const void *data, Bytecount size) |
| 428 | 585 { |
| 665 | 586 Bytecount i; |
| 442 | 587 const unsigned char *p = (const unsigned char *) data; |
| 428 | 588 |
| 771 | 589 /* If the stream is not line-buffered, then we can just call |
| 590 Lstream_write_1(), which writes in chunks. Otherwise, we repeatedly | |
| 591 call Lstream_putc(), which knows how to handle line buffering. | |
| 592 Returns 0 on success, -1 on failure. */ | |
| 593 | |
| 428 | 594 if (size == 0) |
| 771 | 595 return 0; |
| 428 | 596 if (lstr->buffering != LSTREAM_LINE_BUFFERED) |
| 597 return Lstream_write_1 (lstr, data, size); | |
| 598 for (i = 0; i < size; i++) | |
| 599 { | |
| 600 if (Lstream_putc (lstr, p[i]) < 0) | |
| 601 break; | |
| 602 } | |
| 771 | 603 return i == 0 ? -1 : 0; |
| 428 | 604 } |
| 605 | |
| 606 int | |
| 607 Lstream_was_blocked_p (Lstream *lstr) | |
| 608 { | |
| 609 return lstr->imp->was_blocked_p ? lstr->imp->was_blocked_p (lstr) : 0; | |
| 610 } | |
| 611 | |
| 665 | 612 static Bytecount |
| 462 | 613 Lstream_raw_read (Lstream *lstr, unsigned char *buffer, |
| 665 | 614 Bytecount size) |
| 428 | 615 { |
| 616 if (! (lstr->flags & LSTREAM_FL_IS_OPEN)) | |
| 617 Lstream_internal_error ("lstream not open", lstr); | |
| 618 if (! (lstr->flags & LSTREAM_FL_READ)) | |
| 619 Lstream_internal_error ("lstream not open for reading", lstr); | |
| 620 if (!lstr->imp->reader) | |
| 621 Lstream_internal_error ("lstream has no reader", lstr); | |
| 622 | |
| 623 return (lstr->imp->reader) (lstr, buffer, size); | |
| 624 } | |
| 625 | |
| 626 /* Assuming the buffer is empty, fill it up again. */ | |
| 627 | |
| 665 | 628 static Bytecount |
| 428 | 629 Lstream_read_more (Lstream *lstr) |
| 630 { | |
| 631 #if 0 | |
| 665 | 632 Bytecount size_needed |
| 462 | 633 = max (1, min (MAX_READ_SIZE, lstr->buffering_size)); |
| 428 | 634 #else |
| 635 /* If someone requested a larger buffer size, so be it! */ | |
| 665 | 636 Bytecount size_needed = |
| 462 | 637 max (1, lstr->buffering_size); |
| 428 | 638 #endif |
| 665 | 639 Bytecount size_gotten; |
| 428 | 640 |
| 641 DO_REALLOC (lstr->in_buffer, lstr->in_buffer_size, | |
| 642 size_needed, unsigned char); | |
| 643 size_gotten = Lstream_raw_read (lstr, lstr->in_buffer, size_needed); | |
| 644 lstr->in_buffer_current = max (0, size_gotten); | |
| 645 lstr->in_buffer_ind = 0; | |
| 646 return size_gotten < 0 ? -1 : size_gotten; | |
| 647 } | |
| 648 | |
| 771 | 649 /* Read SIZE bytes of DATA from the stream. Return the number of bytes |
| 650 read. 0 means EOF (#### sometimes; it may simply indicate we can't read | |
| 651 any data at other times, particularly if SIZE is too small. this needs | |
| 652 to be fixed!). -1 means an error occurred and no bytes were read. */ | |
| 653 | |
| 814 | 654 static Bytecount |
| 655 Lstream_read_1 (Lstream *lstr, void *data, Bytecount size, | |
| 656 int override_no_partial_chars) | |
| 428 | 657 { |
| 658 unsigned char *p = (unsigned char *) data; | |
| 665 | 659 Bytecount off = 0; |
| 660 Bytecount chunk; | |
| 428 | 661 int error_occurred = 0; |
| 662 | |
| 663 if (size == 0) | |
| 664 return 0; | |
| 665 | |
| 666 /* First try to get some data from the unget buffer */ | |
| 667 chunk = min (size, lstr->unget_buffer_ind); | |
| 668 if (chunk > 0) | |
| 669 { | |
| 670 /* The bytes come back in reverse order. */ | |
| 671 for (; off < chunk; off++) | |
| 672 p[off] = lstr->unget_buffer[--lstr->unget_buffer_ind]; | |
| 673 lstr->byte_count += chunk; | |
| 674 size -= chunk; | |
| 675 } | |
| 676 | |
| 677 while (size > 0) | |
| 678 { | |
| 771 | 679 /* If unbuffered, then simply read directly into output buffer. |
| 680 No need to copy. */ | |
| 681 if (lstr->buffering == LSTREAM_UNBUFFERED) | |
| 682 { | |
| 683 chunk = Lstream_raw_read (lstr, p + off, size); | |
| 684 if (chunk < 0) | |
| 685 error_occurred = 1; | |
| 686 if (chunk <= 0) | |
| 687 break; | |
| 688 lstr->byte_count += chunk; | |
| 428 | 689 size -= chunk; |
| 771 | 690 off += chunk; |
| 691 } | |
| 692 else | |
| 428 | 693 { |
| 771 | 694 /* Take whatever we can from the in buffer */ |
| 695 chunk = min (size, lstr->in_buffer_current - lstr->in_buffer_ind); | |
| 696 if (chunk > 0) | |
| 697 { | |
| 698 memcpy (p + off, lstr->in_buffer + lstr->in_buffer_ind, chunk); | |
| 699 lstr->in_buffer_ind += chunk; | |
| 700 lstr->byte_count += chunk; | |
| 701 size -= chunk; | |
| 702 off += chunk; | |
| 703 } | |
| 704 | |
| 705 /* If we need some more, try to get some more from the | |
| 706 stream's end */ | |
| 707 if (size > 0) | |
| 708 { | |
| 709 Bytecount retval = Lstream_read_more (lstr); | |
| 710 if (retval < 0) | |
| 711 error_occurred = 1; | |
| 712 if (retval <= 0) | |
| 713 break; | |
| 714 } | |
| 428 | 715 } |
| 716 } | |
| 717 | |
| 814 | 718 if ((lstr->flags & LSTREAM_FL_NO_PARTIAL_CHARS) && |
| 719 !override_no_partial_chars) | |
| 428 | 720 { |
| 721 /* It's quite possible for us to get passed an incomplete | |
| 722 character at the end. We need to spit back that | |
| 723 incomplete character. */ | |
| 867 | 724 Bytecount newoff = validate_ibyte_string_backward (p, off); |
| 771 | 725 if (newoff < off) |
| 428 | 726 { |
| 771 | 727 Lstream_unread (lstr, p + newoff, off - newoff); |
| 728 off = newoff; | |
| 428 | 729 } |
| 730 } | |
| 731 | |
| 462 | 732 return off == 0 && error_occurred ? -1 : off; |
| 428 | 733 } |
| 734 | |
| 814 | 735 Bytecount |
| 736 Lstream_read (Lstream *lstr, void *data, Bytecount size) | |
| 737 { | |
| 738 return Lstream_read_1 (lstr, data, size, 0); | |
| 739 } | |
| 740 | |
| 741 | |
| 771 | 742 /* Push back SIZE bytes of DATA onto the input queue. The next call |
| 743 to Lstream_read() with the same size will read the same bytes back. | |
| 744 Note that this will be the case even if there is other pending | |
| 745 unread data. */ | |
| 746 | |
| 428 | 747 void |
| 665 | 748 Lstream_unread (Lstream *lstr, const void *data, Bytecount size) |
| 428 | 749 { |
| 442 | 750 const unsigned char *p = (const unsigned char *) data; |
| 428 | 751 |
| 752 /* Make sure buffer is big enough */ | |
| 753 DO_REALLOC (lstr->unget_buffer, lstr->unget_buffer_size, | |
| 754 lstr->unget_buffer_ind + size, unsigned char); | |
| 755 | |
| 756 lstr->byte_count -= size; | |
| 757 | |
| 758 /* Bytes have to go on in reverse order -- they are reversed | |
| 759 again when read back. */ | |
| 760 while (size--) | |
| 761 lstr->unget_buffer[lstr->unget_buffer_ind++] = p[size]; | |
| 762 } | |
| 763 | |
| 771 | 764 /* Rewind the stream to the beginning. */ |
| 765 | |
| 428 | 766 int |
| 767 Lstream_rewind (Lstream *lstr) | |
| 768 { | |
| 769 if (!lstr->imp->rewinder) | |
| 770 Lstream_internal_error ("lstream has no rewinder", lstr); | |
| 771 if (Lstream_flush (lstr) < 0) | |
| 772 return -1; | |
| 773 lstr->byte_count = 0; | |
| 774 return (lstr->imp->rewinder) (lstr); | |
| 775 } | |
| 776 | |
| 777 int | |
| 778 Lstream_seekable_p (Lstream *lstr) | |
| 779 { | |
| 780 if (!lstr->imp->rewinder) | |
| 781 return 0; | |
| 782 if (!lstr->imp->seekable_p) | |
| 783 return 1; | |
| 784 return (lstr->imp->seekable_p) (lstr); | |
| 785 } | |
| 786 | |
| 787 static int | |
| 788 Lstream_pseudo_close (Lstream *lstr) | |
| 789 { | |
| 1943 | 790 if (! (lstr->flags & LSTREAM_FL_IS_OPEN)) |
| 428 | 791 Lstream_internal_error ("lstream is not open", lstr); |
| 792 | |
| 793 /* don't check errors here -- best not to risk file descriptor loss */ | |
| 794 return Lstream_flush (lstr); | |
| 795 } | |
| 796 | |
| 771 | 797 /* Close the stream. All data will be flushed out. If the stream is |
| 798 already closed, nothing happens. Note that, even if all data has | |
| 799 already been flushed out, the act of closing a stream may generate more | |
| 800 data -- for example, if the stream implements some sort of conversion, | |
| 801 such as gzip, there may be special "end-data" that need to be written | |
| 802 out when the file is closed. */ | |
| 803 | |
| 428 | 804 int |
| 805 Lstream_close (Lstream *lstr) | |
| 806 { | |
| 807 int rc = 0; | |
| 808 | |
| 809 if (lstr->flags & LSTREAM_FL_IS_OPEN) | |
| 810 { | |
| 811 rc = Lstream_pseudo_close (lstr); | |
| 812 /* | |
| 813 * We used to return immediately if the closer method reported | |
| 814 * failure, leaving the stream open. But this is no good, for | |
| 815 * the following reasons. | |
| 816 * | |
| 817 * 1. The finalizer method used in GC makes no provision for | |
| 818 * failure, so we must not return without freeing buffer | |
| 819 * memory. | |
| 820 * | |
| 821 * 2. The closer method may have already freed some memory | |
| 822 * used for I/O in this stream. E.g. encoding_closer frees | |
| 823 * ENCODING_STREAM_DATA(stream)->runoff. If a writer method | |
| 824 * tries to use this buffer later, it will write into memory | |
| 825 * that may have been allocated elsewhere. Sometime later | |
| 826 * you will see a sign that says "Welcome to Crash City." | |
| 827 * | |
| 828 * 3. The closer can report failure if a flush fails in the | |
| 829 * other stream in a MULE encoding/decoding stream pair. | |
| 830 * The other stream in the pair is closed, but returning | |
| 831 * early leaves the current stream open. If we try to | |
| 832 * flush the current stream later, we will crash when the | |
| 833 * flusher notices that the other end stream is closed. | |
| 834 * | |
| 835 * So, we no longer abort the close if the closer method | |
| 836 * reports some kind of failure. We still report the failure | |
| 837 * to the caller. | |
| 838 */ | |
| 839 if (lstr->imp->closer) | |
| 840 if ((lstr->imp->closer) (lstr) < 0) | |
| 841 rc = -1; | |
| 842 } | |
| 843 | |
| 844 lstr->flags &= ~LSTREAM_FL_IS_OPEN; | |
| 845 lstr->byte_count = 0; | |
| 846 /* Note that Lstream_flush() reset all the buffer indices. That way, | |
| 847 the next call to Lstream_putc(), Lstream_getc(), or Lstream_ungetc() | |
| 848 on a closed stream will call into the function equivalents, which will | |
| 849 cause an error. */ | |
| 850 | |
| 851 /* We set the pointers to 0 so that we don't lose when this function | |
| 852 is called more than once on the same object */ | |
| 853 if (lstr->out_buffer) | |
| 854 { | |
| 1726 | 855 xfree (lstr->out_buffer, unsigned char *); |
| 428 | 856 lstr->out_buffer = 0; |
| 857 } | |
| 858 if (lstr->in_buffer) | |
| 859 { | |
| 1726 | 860 xfree (lstr->in_buffer, unsigned char *); |
| 428 | 861 lstr->in_buffer = 0; |
| 862 } | |
| 863 if (lstr->unget_buffer) | |
| 864 { | |
| 1726 | 865 xfree (lstr->unget_buffer, unsigned char *); |
| 428 | 866 lstr->unget_buffer = 0; |
| 867 } | |
| 868 | |
| 869 return rc; | |
| 870 } | |
| 871 | |
| 771 | 872 |
| 873 /* Function equivalent of Lstream_putc(). */ | |
| 874 | |
| 428 | 875 int |
| 876 Lstream_fputc (Lstream *lstr, int c) | |
| 877 { | |
| 878 unsigned char ch = (unsigned char) c; | |
| 771 | 879 int retval = Lstream_write_1 (lstr, &ch, 1); |
| 880 if (retval == 0 && lstr->buffering == LSTREAM_LINE_BUFFERED && ch == '\n') | |
| 428 | 881 return Lstream_flush_out (lstr); |
| 771 | 882 return retval; |
| 428 | 883 } |
| 884 | |
| 771 | 885 /* Function equivalent of Lstream_getc(). */ |
| 886 | |
| 428 | 887 int |
| 888 Lstream_fgetc (Lstream *lstr) | |
| 889 { | |
| 890 unsigned char ch; | |
| 814 | 891 if (Lstream_read_1 (lstr, &ch, 1, 1) <= 0) |
| 428 | 892 return -1; |
| 893 return ch; | |
| 894 } | |
| 895 | |
| 771 | 896 /* Function equivalent of Lstream_ungetc(). */ |
| 897 | |
| 428 | 898 void |
| 899 Lstream_fungetc (Lstream *lstr, int c) | |
| 900 { | |
| 901 unsigned char ch = (unsigned char) c; | |
| 902 Lstream_unread (lstr, &ch, 1); | |
| 903 } | |
| 904 | |
| 905 | |
| 906 /************************ some stream implementations *********************/ | |
| 907 | |
| 908 /*********** a stdio stream ***********/ | |
| 909 | |
| 910 struct stdio_stream | |
| 911 { | |
| 912 FILE *file; | |
| 913 int closing; | |
| 914 }; | |
| 915 | |
| 916 #define STDIO_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, stdio) | |
| 917 | |
| 771 | 918 DEFINE_LSTREAM_IMPLEMENTATION ("stdio", stdio); |
| 428 | 919 |
| 920 static Lisp_Object | |
| 442 | 921 make_stdio_stream_1 (FILE *stream, int flags, const char *mode) |
| 428 | 922 { |
| 923 Lstream *lstr = Lstream_new (lstream_stdio, mode); | |
| 924 struct stdio_stream *str = STDIO_STREAM_DATA (lstr); | |
| 925 str->file = stream; | |
| 926 str->closing = flags & LSTR_CLOSING; | |
| 927 lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE; | |
| 793 | 928 return wrap_lstream (lstr); |
| 428 | 929 } |
| 930 | |
| 931 Lisp_Object | |
| 932 make_stdio_input_stream (FILE *stream, int flags) | |
| 933 { | |
| 934 return make_stdio_stream_1 (stream, flags, "r"); | |
| 935 } | |
| 936 | |
| 937 Lisp_Object | |
| 938 make_stdio_output_stream (FILE *stream, int flags) | |
| 939 { | |
| 940 return make_stdio_stream_1 (stream, flags, "w"); | |
| 941 } | |
| 942 | |
| 943 /* #### From reading the Unix 98 specification, it appears that if we | |
| 944 want stdio_reader() to be completely correct, we should check for | |
| 945 0 < val < size and if so, check to see if an error has occurred. | |
| 946 If an error has occurred, but val is non-zero, we should go ahead | |
| 947 and act as if the read was successful, but remember in some fashion | |
| 948 or other, that an error has occurred, and report that on the next | |
| 771 | 949 call to stdio_reader instead of calling retry_fread() again. |
| 428 | 950 |
| 771 | 951 Currently, in such a case, we end up calling retry_fread() twice and we |
| 428 | 952 assume that |
| 953 | |
| 954 1) this is not harmful, and | |
| 955 2) the error will still be reported on the second read. | |
| 956 | |
| 957 This is probably reasonable, so I don't think we should change this | |
| 958 code (it could even be argued that the error might have fixed | |
| 771 | 959 itself, so we should do the retry_fread() again. */ |
| 428 | 960 |
| 665 | 961 static Bytecount |
| 962 stdio_reader (Lstream *stream, unsigned char *data, Bytecount size) | |
| 428 | 963 { |
| 964 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
| 771 | 965 Bytecount val = retry_fread (data, 1, size, str->file); |
| 966 if (!val) | |
| 967 { | |
| 968 if (ferror (str->file)) | |
| 969 return LSTREAM_ERROR; | |
| 970 if (feof (str->file)) | |
| 971 return 0; /* LSTREAM_EOF; */ | |
| 972 } | |
| 428 | 973 return val; |
| 974 } | |
| 975 | |
| 665 | 976 static Bytecount |
| 462 | 977 stdio_writer (Lstream *stream, const unsigned char *data, |
| 665 | 978 Bytecount size) |
| 428 | 979 { |
| 980 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
| 771 | 981 Bytecount val = retry_fwrite (data, 1, size, str->file); |
| 428 | 982 if (!val && ferror (str->file)) |
| 771 | 983 return LSTREAM_ERROR; |
| 428 | 984 return val; |
| 985 } | |
| 986 | |
| 987 static int | |
| 988 stdio_rewinder (Lstream *stream) | |
| 989 { | |
| 990 rewind (STDIO_STREAM_DATA (stream)->file); | |
| 991 return 0; | |
| 992 } | |
| 993 | |
| 994 static int | |
| 995 stdio_seekable_p (Lstream *stream) | |
| 996 { | |
| 997 struct stat lestat; | |
| 998 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
| 999 | |
| 771 | 1000 if (qxe_fstat (fileno (str->file), &lestat) < 0) |
| 428 | 1001 return 0; |
| 1002 return S_ISREG (lestat.st_mode); | |
| 1003 } | |
| 1004 | |
| 1005 static int | |
| 1006 stdio_flusher (Lstream *stream) | |
| 1007 { | |
| 1008 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
| 1009 if (stream->flags & LSTREAM_FL_WRITE) | |
| 1010 return fflush (str->file); | |
| 1011 else | |
| 1012 return 0; | |
| 1013 } | |
| 1014 | |
| 1015 static int | |
| 1016 stdio_closer (Lstream *stream) | |
| 1017 { | |
| 1018 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
| 1019 if (str->closing) | |
| 771 | 1020 return retry_fclose (str->file); |
| 428 | 1021 else |
| 1022 if (stream->flags & LSTREAM_FL_WRITE) | |
| 1023 return fflush (str->file); | |
| 1024 else | |
| 1025 return 0; | |
| 1026 } | |
| 1027 | |
| 1028 /*********** a file descriptor ***********/ | |
| 1029 | |
| 1030 struct filedesc_stream | |
| 1031 { | |
| 1032 int fd; | |
| 1033 int pty_max_bytes; | |
| 867 | 1034 Ibyte eof_char; |
| 428 | 1035 int starting_pos; |
| 1036 int current_pos; | |
| 1037 int end_pos; | |
| 1038 int chars_sans_newline; | |
| 1039 unsigned int closing :1; | |
| 1040 unsigned int allow_quit :1; | |
| 1041 unsigned int blocked_ok :1; | |
| 1042 unsigned int pty_flushing :1; | |
| 1043 unsigned int blocking_error_p :1; | |
| 1044 }; | |
| 1045 | |
| 1046 #define FILEDESC_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, filedesc) | |
| 1047 | |
| 771 | 1048 DEFINE_LSTREAM_IMPLEMENTATION ("filedesc", filedesc); |
| 428 | 1049 |
| 1050 /* Make a stream that reads from or writes to a file descriptor FILEDESC. | |
| 1051 OFFSET is the offset from the *current* file pointer that the reading | |
| 1052 should start at. COUNT is the number of bytes to be read (it is | |
| 1053 ignored when writing); -1 for unlimited. */ | |
| 1054 static Lisp_Object | |
| 1055 make_filedesc_stream_1 (int filedesc, int offset, int count, int flags, | |
| 442 | 1056 const char *mode) |
| 428 | 1057 { |
| 1058 Lstream *lstr = Lstream_new (lstream_filedesc, mode); | |
| 1059 struct filedesc_stream *fstr = FILEDESC_STREAM_DATA (lstr); | |
| 1060 fstr->fd = filedesc; | |
| 1061 fstr->closing = !!(flags & LSTR_CLOSING); | |
| 1062 fstr->allow_quit = !!(flags & LSTR_ALLOW_QUIT); | |
| 1063 fstr->blocked_ok = !!(flags & LSTR_BLOCKED_OK); | |
| 1064 fstr->pty_flushing = !!(flags & LSTR_PTY_FLUSHING); | |
| 1065 fstr->blocking_error_p = 0; | |
| 1066 fstr->chars_sans_newline = 0; | |
| 1067 fstr->starting_pos = lseek (filedesc, offset, SEEK_CUR); | |
| 1068 fstr->current_pos = max (fstr->starting_pos, 0); | |
| 1069 if (count < 0) | |
| 1070 fstr->end_pos = -1; | |
| 1071 else | |
| 1072 fstr->end_pos = fstr->starting_pos + count; | |
| 1073 lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE; | |
| 793 | 1074 return wrap_lstream (lstr); |
| 428 | 1075 } |
| 1076 | |
| 814 | 1077 /* Flags: |
| 1078 | |
| 1079 LSTR_CLOSING | |
| 1080 If set, close the descriptor or FILE * when the stream is closed. | |
| 1081 | |
| 1082 LSTR_ALLOW_QUIT | |
| 1083 If set, allow quitting out of the actual I/O. | |
| 1084 | |
| 1085 LSTR_PTY_FLUSHING | |
| 1086 If set and filedesc_stream_set_pty_flushing() has been called | |
| 1087 on the stream, do not send more than pty_max_bytes on a single | |
| 1088 line without flushing the data out using the eof_char. | |
| 1089 | |
| 1090 LSTR_BLOCKED_OK | |
| 1091 If set, an EWOULDBLOCK error is not treated as an error but | |
| 1092 simply causes the write function to return 0 as the number | |
| 1093 of bytes written out. | |
| 1094 */ | |
| 1095 | |
| 428 | 1096 Lisp_Object |
| 1097 make_filedesc_input_stream (int filedesc, int offset, int count, int flags) | |
| 1098 { | |
| 1099 return make_filedesc_stream_1 (filedesc, offset, count, flags, "r"); | |
| 1100 } | |
| 1101 | |
| 1102 Lisp_Object | |
| 1103 make_filedesc_output_stream (int filedesc, int offset, int count, int flags) | |
| 1104 { | |
| 1105 return make_filedesc_stream_1 (filedesc, offset, count, flags, "w"); | |
| 1106 } | |
| 1107 | |
| 665 | 1108 static Bytecount |
| 1109 filedesc_reader (Lstream *stream, unsigned char *data, Bytecount size) | |
| 428 | 1110 { |
| 665 | 1111 Bytecount nread; |
| 428 | 1112 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); |
| 1113 if (str->end_pos >= 0) | |
| 665 | 1114 size = min (size, (Bytecount) (str->end_pos - str->current_pos)); |
| 430 | 1115 nread = str->allow_quit ? |
| 1116 read_allowing_quit (str->fd, data, size) : | |
| 771 | 1117 retry_read (str->fd, data, size); |
| 428 | 1118 if (nread > 0) |
| 1119 str->current_pos += nread; | |
| 771 | 1120 if (nread == 0) |
| 1121 return 0; /* LSTREAM_EOF; */ | |
| 1122 if (nread < 0) | |
| 1123 return LSTREAM_ERROR; | |
| 428 | 1124 return nread; |
| 1125 } | |
| 1126 | |
| 1127 static int | |
| 1128 errno_would_block_p (int val) | |
| 1129 { | |
| 1130 #ifdef EWOULDBLOCK | |
| 1131 if (val == EWOULDBLOCK) | |
| 1132 return 1; | |
| 1133 #endif | |
| 1134 #ifdef EAGAIN | |
| 1135 if (val == EAGAIN) | |
| 1136 return 1; | |
| 1137 #endif | |
| 1138 return 0; | |
| 1139 } | |
| 1140 | |
| 665 | 1141 static Bytecount |
| 462 | 1142 filedesc_writer (Lstream *stream, const unsigned char *data, |
| 665 | 1143 Bytecount size) |
| 428 | 1144 { |
| 1145 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
| 665 | 1146 Bytecount retval; |
| 428 | 1147 int need_newline = 0; |
| 1148 | |
| 1149 /* This function would be simple if it were not for the blasted | |
| 1150 PTY max-bytes stuff. Why the hell can't they just have written | |
| 1151 the PTY drivers right so this problem doesn't exist? | |
| 1152 | |
| 1153 Maybe all the PTY crap here should be moved into another stream | |
| 1154 that does nothing but periodically insert EOF's as necessary. */ | |
| 1155 if (str->pty_flushing) | |
| 1156 { | |
| 1157 /* To make life easy, only send out one line at the most. */ | |
| 442 | 1158 const unsigned char *ptr; |
| 428 | 1159 |
| 442 | 1160 ptr = (const unsigned char *) memchr (data, '\n', size); |
| 428 | 1161 if (ptr) |
| 1162 need_newline = 1; | |
| 1163 else | |
| 1164 ptr = data + size; | |
| 1165 if (ptr - data >= str->pty_max_bytes - str->chars_sans_newline) | |
| 1166 { | |
| 1167 ptr = data + str->pty_max_bytes - str->chars_sans_newline; | |
| 1168 need_newline = 0; | |
| 1169 } | |
| 1170 size = ptr - data; | |
| 1171 } | |
| 1172 | |
| 1173 /**** start of non-PTY-crap ****/ | |
| 1174 if (size > 0) | |
| 430 | 1175 retval = str->allow_quit ? |
| 1176 write_allowing_quit (str->fd, data, size) : | |
| 771 | 1177 retry_write (str->fd, data, size); |
| 428 | 1178 else |
| 1179 retval = 0; | |
| 1180 if (retval < 0 && errno_would_block_p (errno) && str->blocked_ok) | |
| 1181 { | |
| 1182 str->blocking_error_p = 1; | |
| 1183 return 0; | |
| 1184 } | |
| 1185 str->blocking_error_p = 0; | |
| 1186 if (retval < 0) | |
| 771 | 1187 return LSTREAM_ERROR; |
| 428 | 1188 /**** end non-PTY-crap ****/ |
| 1189 | |
| 1190 if (str->pty_flushing) | |
| 1191 { | |
| 1192 str->chars_sans_newline += retval; | |
| 1193 /* Note that a newline was not among the bytes written out. | |
| 1194 Add to the number of non-newline bytes written out, | |
| 1195 and flush with an EOF if necessary. Be careful to | |
| 1196 keep track of write errors as we go along and look | |
| 1197 out for EWOULDBLOCK. */ | |
| 1198 if (str->chars_sans_newline >= str->pty_max_bytes) | |
| 1199 { | |
| 665 | 1200 Bytecount retval2 = str->allow_quit ? |
| 430 | 1201 write_allowing_quit (str->fd, &str->eof_char, 1) : |
| 771 | 1202 retry_write (str->fd, &str->eof_char, 1); |
| 430 | 1203 |
| 428 | 1204 if (retval2 > 0) |
| 1205 str->chars_sans_newline = 0; | |
| 1206 else if (retval2 < 0) | |
| 1207 { | |
| 1208 /* Error writing the EOF char. If nothing got written, | |
| 1209 then treat this as an error -- either return an error | |
| 1210 condition or set the blocking-error flag. */ | |
| 1211 if (retval == 0) | |
| 1212 { | |
| 1213 if (errno_would_block_p (errno) && str->blocked_ok) | |
| 1214 { | |
| 1215 str->blocking_error_p = 1; | |
| 1216 return 0; | |
| 1217 } | |
| 1218 else | |
| 771 | 1219 return LSTREAM_ERROR; |
| 428 | 1220 } |
| 1221 else | |
| 1222 return retval; | |
| 1223 } | |
| 1224 } | |
| 1225 } | |
| 1226 | |
| 1227 /* The need_newline flag is necessary because otherwise when the | |
| 1228 first byte is a newline, we'd get stuck never writing anything | |
| 1229 in pty-flushing mode. */ | |
| 1230 if (need_newline) | |
| 1231 { | |
| 867 | 1232 Ibyte nl = '\n'; |
| 665 | 1233 Bytecount retval2 = str->allow_quit ? |
| 430 | 1234 write_allowing_quit (str->fd, &nl, 1) : |
| 771 | 1235 retry_write (str->fd, &nl, 1); |
| 430 | 1236 |
| 428 | 1237 if (retval2 > 0) |
| 1238 { | |
| 1239 str->chars_sans_newline = 0; | |
| 1240 retval++; | |
| 1241 } | |
| 1242 else if (retval2 < 0) | |
| 1243 { | |
| 1244 /* Error writing the newline char. If nothing got written, | |
| 1245 then treat this as an error -- either return an error | |
| 1246 condition or set the blocking-error flag. */ | |
| 1247 if (retval == 0) | |
| 1248 { | |
| 1249 if (errno_would_block_p (errno) && str->blocked_ok) | |
| 1250 { | |
| 1251 str->blocking_error_p = 1; | |
| 1252 return 0; | |
| 1253 } | |
| 1254 else | |
| 771 | 1255 return LSTREAM_ERROR; |
| 428 | 1256 } |
| 1257 else | |
| 1258 return retval; | |
| 1259 } | |
| 1260 } | |
| 1261 | |
| 1262 return retval; | |
| 1263 } | |
| 1264 | |
| 1265 static int | |
| 1266 filedesc_rewinder (Lstream *stream) | |
| 1267 { | |
| 1268 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
| 1269 if (str->starting_pos < 0 || | |
| 1270 lseek (FILEDESC_STREAM_DATA (stream)->fd, str->starting_pos, | |
| 1271 SEEK_SET) == -1) | |
| 1272 return -1; | |
| 1273 else | |
| 1274 { | |
| 1275 str->current_pos = str->starting_pos; | |
| 1276 return 0; | |
| 1277 } | |
| 1278 } | |
| 1279 | |
| 1280 static int | |
| 1281 filedesc_seekable_p (Lstream *stream) | |
| 1282 { | |
| 1283 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
| 1284 if (str->starting_pos < 0) | |
| 1285 return 0; | |
| 1286 else | |
| 1287 { | |
| 1288 struct stat lestat; | |
| 1289 | |
| 771 | 1290 if (qxe_fstat (str->fd, &lestat) < 0) |
| 428 | 1291 return 0; |
| 1292 return S_ISREG (lestat.st_mode); | |
| 1293 } | |
| 1294 } | |
| 1295 | |
| 1296 static int | |
| 1297 filedesc_closer (Lstream *stream) | |
| 1298 { | |
| 1299 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
| 1300 if (str->closing) | |
| 771 | 1301 return retry_close (str->fd); |
| 428 | 1302 else |
| 1303 return 0; | |
| 1304 } | |
| 1305 | |
| 1306 static int | |
| 1307 filedesc_was_blocked_p (Lstream *stream) | |
| 1308 { | |
| 1309 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
| 1310 return str->blocking_error_p; | |
| 1311 } | |
| 1312 | |
| 1313 void | |
| 1314 filedesc_stream_set_pty_flushing (Lstream *stream, int pty_max_bytes, | |
| 867 | 1315 Ibyte eof_char) |
| 428 | 1316 { |
| 1317 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
| 1318 str->pty_max_bytes = pty_max_bytes; | |
| 1319 str->eof_char = eof_char; | |
| 1320 str->pty_flushing = 1; | |
| 1321 } | |
| 1322 | |
| 1323 int | |
| 1324 filedesc_stream_fd (Lstream *stream) | |
| 1325 { | |
| 1326 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
| 1327 return str->fd; | |
| 1328 } | |
| 1329 | |
| 1330 /*********** read from a Lisp string ***********/ | |
| 1331 | |
| 1332 #define LISP_STRING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, lisp_string) | |
| 1333 | |
| 1334 struct lisp_string_stream | |
| 1335 { | |
| 1336 Lisp_Object obj; | |
| 1337 Bytecount init_offset; | |
| 1338 Bytecount offset, end; | |
| 1339 }; | |
| 1340 | |
| 1204 | 1341 static const struct memory_description lisp_string_lstream_description[] = { |
| 1342 { XD_LISP_OBJECT, offsetof (struct lisp_string_stream, obj) }, | |
| 1343 { XD_END } | |
| 1344 }; | |
| 1345 | |
| 1346 DEFINE_LSTREAM_IMPLEMENTATION_WITH_DATA ("lisp-string", lisp_string); | |
| 428 | 1347 |
| 1348 Lisp_Object | |
| 1349 make_lisp_string_input_stream (Lisp_Object string, Bytecount offset, | |
| 1350 Bytecount len) | |
| 1351 { | |
| 1352 Lstream *lstr; | |
| 1353 struct lisp_string_stream *str; | |
| 1354 | |
| 1355 CHECK_STRING (string); | |
| 1356 if (len < 0) | |
| 1357 len = XSTRING_LENGTH (string) - offset; | |
| 1358 assert (offset >= 0); | |
| 1359 assert (len >= 0); | |
| 1360 assert (offset + len <= XSTRING_LENGTH (string)); | |
| 1361 | |
| 1362 lstr = Lstream_new (lstream_lisp_string, "r"); | |
| 1363 str = LISP_STRING_STREAM_DATA (lstr); | |
| 1364 str->offset = offset; | |
| 1365 str->end = offset + len; | |
| 1366 str->init_offset = offset; | |
| 1367 str->obj = string; | |
| 793 | 1368 return wrap_lstream (lstr); |
| 428 | 1369 } |
| 1370 | |
| 665 | 1371 static Bytecount |
| 462 | 1372 lisp_string_reader (Lstream *stream, unsigned char *data, |
| 665 | 1373 Bytecount size) |
| 428 | 1374 { |
| 1375 struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (stream); | |
| 1376 /* Don't lose if the string shrank past us ... */ | |
| 1377 Bytecount offset = min (str->offset, XSTRING_LENGTH (str->obj)); | |
| 867 | 1378 Ibyte *strstart = XSTRING_DATA (str->obj); |
| 1379 Ibyte *start = strstart + offset; | |
| 428 | 1380 |
| 1381 /* ... or if someone changed the string and we ended up in the | |
| 1382 middle of a character. */ | |
| 1383 /* Being in the middle of a character is `normal' unless | |
| 1384 LSTREAM_NO_PARTIAL_CHARS - mrb */ | |
| 1385 if (stream->flags & LSTREAM_FL_NO_PARTIAL_CHARS) | |
| 867 | 1386 VALIDATE_IBYTEPTR_BACKWARD (start); |
| 428 | 1387 offset = start - strstart; |
| 665 | 1388 size = min (size, (Bytecount) (str->end - offset)); |
| 428 | 1389 memcpy (data, start, size); |
| 1390 str->offset = offset + size; | |
| 1391 return size; | |
| 1392 } | |
| 1393 | |
| 1394 static int | |
| 1395 lisp_string_rewinder (Lstream *stream) | |
| 1396 { | |
| 1397 struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (stream); | |
| 1398 int pos = str->init_offset; | |
| 1399 if (pos > str->end) | |
| 1400 pos = str->end; | |
| 1401 /* Don't lose if the string shrank past us ... */ | |
| 1402 pos = min (pos, XSTRING_LENGTH (str->obj)); | |
| 1403 /* ... or if someone changed the string and we ended up in the | |
| 1404 middle of a character. */ | |
| 1405 { | |
| 867 | 1406 Ibyte *strstart = XSTRING_DATA (str->obj); |
| 1407 Ibyte *start = strstart + pos; | |
| 1408 VALIDATE_IBYTEPTR_BACKWARD (start); | |
| 428 | 1409 pos = start - strstart; |
| 1410 } | |
| 1411 str->offset = pos; | |
| 1412 return 0; | |
| 1413 } | |
| 1414 | |
| 1415 static Lisp_Object | |
| 1416 lisp_string_marker (Lisp_Object stream) | |
| 1417 { | |
| 1418 struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (XLSTREAM (stream)); | |
| 1419 return str->obj; | |
| 1420 } | |
| 1421 | |
| 1422 /*********** a fixed buffer ***********/ | |
| 1423 | |
| 1424 #define FIXED_BUFFER_STREAM_DATA(stream) \ | |
| 1425 LSTREAM_TYPE_DATA (stream, fixed_buffer) | |
| 1426 | |
| 1427 struct fixed_buffer_stream | |
| 1428 { | |
| 442 | 1429 const unsigned char *inbuf; |
| 428 | 1430 unsigned char *outbuf; |
| 665 | 1431 Bytecount size; |
| 1432 Bytecount offset; | |
| 428 | 1433 }; |
| 1434 | |
| 771 | 1435 DEFINE_LSTREAM_IMPLEMENTATION ("fixed-buffer", fixed_buffer); |
| 428 | 1436 |
| 1437 Lisp_Object | |
| 665 | 1438 make_fixed_buffer_input_stream (const void *buf, Bytecount size) |
| 428 | 1439 { |
| 1440 Lstream *lstr = Lstream_new (lstream_fixed_buffer, "r"); | |
| 1441 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr); | |
| 440 | 1442 str->inbuf = (const unsigned char *) buf; |
| 428 | 1443 str->size = size; |
| 793 | 1444 return wrap_lstream (lstr); |
| 428 | 1445 } |
| 1446 | |
| 1447 Lisp_Object | |
| 665 | 1448 make_fixed_buffer_output_stream (void *buf, Bytecount size) |
| 428 | 1449 { |
| 1450 Lstream *lstr = Lstream_new (lstream_fixed_buffer, "w"); | |
| 1451 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr); | |
| 440 | 1452 str->outbuf = (unsigned char *) buf; |
| 428 | 1453 str->size = size; |
| 793 | 1454 return wrap_lstream (lstr); |
| 428 | 1455 } |
| 1456 | |
| 665 | 1457 static Bytecount |
| 462 | 1458 fixed_buffer_reader (Lstream *stream, unsigned char *data, |
| 665 | 1459 Bytecount size) |
| 428 | 1460 { |
| 1461 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream); | |
| 1462 size = min (size, str->size - str->offset); | |
| 1463 memcpy (data, str->inbuf + str->offset, size); | |
| 1464 str->offset += size; | |
| 1465 return size; | |
| 1466 } | |
| 1467 | |
| 665 | 1468 static Bytecount |
| 462 | 1469 fixed_buffer_writer (Lstream *stream, const unsigned char *data, |
| 665 | 1470 Bytecount size) |
| 428 | 1471 { |
| 1472 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream); | |
| 1473 if (str->offset == str->size) | |
| 1474 { | |
| 1475 /* If we're at the end, just throw away the data and pretend | |
| 1476 we wrote all of it. If we return 0, then the lstream routines | |
| 1477 will try again and again to write it out. */ | |
| 1478 return size; | |
| 1479 } | |
| 1480 size = min (size, str->size - str->offset); | |
| 1481 memcpy (str->outbuf + str->offset, data, size); | |
| 1482 str->offset += size; | |
| 1483 return size; | |
| 1484 } | |
| 1485 | |
| 1486 static int | |
| 1487 fixed_buffer_rewinder (Lstream *stream) | |
| 1488 { | |
| 1489 FIXED_BUFFER_STREAM_DATA (stream)->offset = 0; | |
| 1490 return 0; | |
| 1491 } | |
| 1492 | |
| 442 | 1493 const unsigned char * |
| 428 | 1494 fixed_buffer_input_stream_ptr (Lstream *stream) |
| 1495 { | |
| 1496 assert (stream->imp == lstream_fixed_buffer); | |
| 1497 return FIXED_BUFFER_STREAM_DATA (stream)->inbuf; | |
| 1498 } | |
| 1499 | |
| 1500 unsigned char * | |
| 1501 fixed_buffer_output_stream_ptr (Lstream *stream) | |
| 1502 { | |
| 1503 assert (stream->imp == lstream_fixed_buffer); | |
| 1504 return FIXED_BUFFER_STREAM_DATA (stream)->outbuf; | |
| 1505 } | |
| 1506 | |
| 1507 /*********** write to a resizing buffer ***********/ | |
| 1508 | |
| 1509 #define RESIZING_BUFFER_STREAM_DATA(stream) \ | |
| 1510 LSTREAM_TYPE_DATA (stream, resizing_buffer) | |
| 1511 | |
| 1512 struct resizing_buffer_stream | |
| 1513 { | |
| 1514 unsigned char *buf; | |
| 665 | 1515 Bytecount allocked; |
| 428 | 1516 int max_stored; |
| 1517 int stored; | |
| 1518 }; | |
| 1519 | |
| 771 | 1520 DEFINE_LSTREAM_IMPLEMENTATION ("resizing-buffer", resizing_buffer); |
| 428 | 1521 |
| 1522 Lisp_Object | |
| 1523 make_resizing_buffer_output_stream (void) | |
| 1524 { | |
| 793 | 1525 return wrap_lstream (Lstream_new (lstream_resizing_buffer, "w")); |
| 428 | 1526 } |
| 1527 | |
| 665 | 1528 static Bytecount |
| 462 | 1529 resizing_buffer_writer (Lstream *stream, const unsigned char *data, |
| 665 | 1530 Bytecount size) |
| 428 | 1531 { |
| 1532 struct resizing_buffer_stream *str = RESIZING_BUFFER_STREAM_DATA (stream); | |
| 1533 DO_REALLOC (str->buf, str->allocked, str->stored + size, unsigned char); | |
| 1534 memcpy (str->buf + str->stored, data, size); | |
| 1535 str->stored += size; | |
| 1536 str->max_stored = max (str->max_stored, str->stored); | |
| 1537 return size; | |
| 1538 } | |
| 1539 | |
| 1540 static int | |
| 1541 resizing_buffer_rewinder (Lstream *stream) | |
| 1542 { | |
| 1543 RESIZING_BUFFER_STREAM_DATA (stream)->stored = 0; | |
| 1544 return 0; | |
| 1545 } | |
| 1546 | |
| 1547 static int | |
| 1548 resizing_buffer_closer (Lstream *stream) | |
| 1549 { | |
| 1550 struct resizing_buffer_stream *str = RESIZING_BUFFER_STREAM_DATA (stream); | |
| 1551 if (str->buf) | |
| 1552 { | |
| 1726 | 1553 xfree (str->buf, unsigned char *); |
| 428 | 1554 str->buf = 0; |
| 1555 } | |
| 1556 return 0; | |
| 1557 } | |
| 1558 | |
| 1559 unsigned char * | |
| 1560 resizing_buffer_stream_ptr (Lstream *stream) | |
| 1561 { | |
| 1562 return RESIZING_BUFFER_STREAM_DATA (stream)->buf; | |
| 1563 } | |
| 1564 | |
| 788 | 1565 Lisp_Object |
| 1566 resizing_buffer_to_lisp_string (Lstream *stream) | |
| 1567 { | |
| 1568 return make_string (resizing_buffer_stream_ptr (stream), | |
| 1569 Lstream_byte_count (stream)); | |
| 1570 } | |
| 1571 | |
| 428 | 1572 /*********** write to an unsigned-char dynarr ***********/ |
| 1573 | |
| 1574 /* Note: If you have a dynarr whose type is not unsigned_char_dynarr | |
| 1575 but which is really just an unsigned_char_dynarr (e.g. its type | |
| 867 | 1576 is Ibyte or Extbyte), just cast to unsigned_char_dynarr. */ |
| 428 | 1577 |
| 1578 #define DYNARR_STREAM_DATA(stream) \ | |
| 1579 LSTREAM_TYPE_DATA (stream, dynarr) | |
| 1580 | |
| 1581 struct dynarr_stream | |
| 1582 { | |
| 1583 unsigned_char_dynarr *dyn; | |
| 1584 }; | |
| 1585 | |
| 771 | 1586 DEFINE_LSTREAM_IMPLEMENTATION ("dynarr", dynarr); |
| 428 | 1587 |
| 1588 Lisp_Object | |
| 1589 make_dynarr_output_stream (unsigned_char_dynarr *dyn) | |
| 1590 { | |
| 793 | 1591 Lisp_Object obj = wrap_lstream (Lstream_new (lstream_dynarr, "w")); |
| 1592 | |
| 428 | 1593 DYNARR_STREAM_DATA (XLSTREAM (obj))->dyn = dyn; |
| 1594 return obj; | |
| 1595 } | |
| 1596 | |
| 665 | 1597 static Bytecount |
| 462 | 1598 dynarr_writer (Lstream *stream, const unsigned char *data, |
| 665 | 1599 Bytecount size) |
| 428 | 1600 { |
| 1601 struct dynarr_stream *str = DYNARR_STREAM_DATA (stream); | |
| 1602 Dynarr_add_many (str->dyn, data, size); | |
| 1603 return size; | |
| 1604 } | |
| 1605 | |
| 1606 static int | |
| 1607 dynarr_rewinder (Lstream *stream) | |
| 1608 { | |
| 1609 Dynarr_reset (DYNARR_STREAM_DATA (stream)->dyn); | |
| 1610 return 0; | |
| 1611 } | |
| 1612 | |
| 1613 static int | |
| 2286 | 1614 dynarr_closer (Lstream *UNUSED (stream)) |
| 428 | 1615 { |
| 1616 return 0; | |
| 1617 } | |
| 1618 | |
| 1619 /************ read from or write to a Lisp buffer ************/ | |
| 1620 | |
| 1621 /* Note: Lisp-buffer read streams never return partial characters, | |
| 1622 and Lisp-buffer write streams expect to never get partial | |
| 1623 characters. */ | |
| 1624 | |
| 1625 #define LISP_BUFFER_STREAM_DATA(stream) \ | |
| 1626 LSTREAM_TYPE_DATA (stream, lisp_buffer) | |
| 1627 | |
| 1628 struct lisp_buffer_stream | |
| 1629 { | |
| 1630 Lisp_Object buffer; | |
| 1631 Lisp_Object orig_start; | |
| 1632 /* we use markers to properly deal with insertion/deletion */ | |
| 1633 Lisp_Object start, end; | |
| 1634 int flags; | |
| 1635 }; | |
| 1636 | |
| 1204 | 1637 static const struct memory_description lisp_buffer_lstream_description[] = { |
| 1638 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, buffer) }, | |
| 1639 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, orig_start) }, | |
| 1640 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, start) }, | |
| 1641 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, end) }, | |
| 1642 { XD_END } | |
| 1643 }; | |
| 1644 | |
| 1645 DEFINE_LSTREAM_IMPLEMENTATION_WITH_DATA ("lisp-buffer", lisp_buffer); | |
| 428 | 1646 |
| 1647 static Lisp_Object | |
| 665 | 1648 make_lisp_buffer_stream_1 (struct buffer *buf, Charbpos start, Charbpos end, |
| 2367 | 1649 int flags, const Ascbyte *mode) |
| 428 | 1650 { |
| 1651 Lstream *lstr; | |
| 1652 struct lisp_buffer_stream *str; | |
| 665 | 1653 Charbpos bmin, bmax; |
| 428 | 1654 int reading = !strcmp (mode, "r"); |
| 1655 | |
| 1656 /* Make sure the luser didn't pass "w" in. */ | |
| 1657 if (!strcmp (mode, "w")) | |
| 2500 | 1658 ABORT (); |
| 428 | 1659 |
| 1660 if (flags & LSTR_IGNORE_ACCESSIBLE) | |
| 1661 { | |
| 1662 bmin = BUF_BEG (buf); | |
| 1663 bmax = BUF_Z (buf); | |
| 1664 } | |
| 1665 else | |
| 1666 { | |
| 1667 bmin = BUF_BEGV (buf); | |
| 1668 bmax = BUF_ZV (buf); | |
| 1669 } | |
| 1670 | |
| 1671 if (start == -1) | |
| 1672 start = bmin; | |
| 1673 if (end == -1) | |
| 1674 end = bmax; | |
| 1675 assert (bmin <= start); | |
| 1676 assert (start <= bmax); | |
| 1677 if (reading) | |
| 1678 { | |
| 1679 assert (bmin <= end); | |
| 1680 assert (end <= bmax); | |
| 1681 assert (start <= end); | |
| 1682 } | |
| 1683 | |
| 1684 lstr = Lstream_new (lstream_lisp_buffer, mode); | |
| 1685 str = LISP_BUFFER_STREAM_DATA (lstr); | |
| 1686 { | |
| 1687 Lisp_Object marker; | |
| 793 | 1688 Lisp_Object buffer = wrap_buffer (buf); |
| 428 | 1689 |
| 1690 marker = Fmake_marker (); | |
| 1691 Fset_marker (marker, make_int (start), buffer); | |
| 1692 str->start = marker; | |
| 1693 marker = Fmake_marker (); | |
| 1694 Fset_marker (marker, make_int (start), buffer); | |
| 1695 str->orig_start = marker; | |
| 1696 if (reading) | |
| 1697 { | |
| 1698 marker = Fmake_marker (); | |
| 1699 Fset_marker (marker, make_int (end), buffer); | |
| 1700 str->end = marker; | |
| 1701 } | |
| 1702 else | |
| 1703 str->end = Qnil; | |
| 1704 str->buffer = buffer; | |
| 1705 } | |
| 1706 str->flags = flags; | |
| 793 | 1707 return wrap_lstream (lstr); |
| 428 | 1708 } |
| 1709 | |
| 1710 Lisp_Object | |
| 826 | 1711 make_lisp_buffer_input_stream (struct buffer *buf, Charbpos start, |
| 1712 Charbpos end, int flags) | |
| 428 | 1713 { |
| 1714 return make_lisp_buffer_stream_1 (buf, start, end, flags, "r"); | |
| 1715 } | |
| 1716 | |
| 1717 Lisp_Object | |
| 665 | 1718 make_lisp_buffer_output_stream (struct buffer *buf, Charbpos pos, int flags) |
| 428 | 1719 { |
| 1720 Lisp_Object lstr = make_lisp_buffer_stream_1 (buf, pos, 0, flags, "wc"); | |
| 1721 | |
| 1722 Lstream_set_character_mode (XLSTREAM (lstr)); | |
| 1723 return lstr; | |
| 1724 } | |
| 1725 | |
| 665 | 1726 static Bytecount |
| 867 | 1727 lisp_buffer_reader (Lstream *stream, Ibyte *data, Bytecount size) |
| 428 | 1728 { |
| 1729 struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); | |
| 665 | 1730 Bytebpos start; |
| 1731 Bytebpos end; | |
| 428 | 1732 struct buffer *buf = XBUFFER (str->buffer); |
| 826 | 1733 Bytecount src_used; |
| 428 | 1734 |
| 1735 if (!BUFFER_LIVE_P (buf)) | |
| 1736 return 0; /* Fut. */ | |
| 1737 | |
| 826 | 1738 start = byte_marker_position (str->start); |
| 1739 end = byte_marker_position (str->end); | |
| 428 | 1740 if (!(str->flags & LSTR_IGNORE_ACCESSIBLE)) |
| 1741 { | |
| 826 | 1742 start = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf), start, |
| 1743 BYTE_BUF_ZV (buf)); | |
| 1744 end = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf), end, | |
| 1745 BYTE_BUF_ZV (buf)); | |
| 428 | 1746 } |
| 1747 | |
| 826 | 1748 size = copy_buffer_text_out (buf, start, end - start, data, size, |
| 1749 FORMAT_DEFAULT, Qnil, &src_used); | |
| 1750 end = start + src_used; | |
| 428 | 1751 |
| 1752 if (EQ (buf->selective_display, Qt) && str->flags & LSTR_SELECTIVE) | |
| 1753 { | |
| 1754 /* What a kludge. What a kludge. What a kludge. */ | |
| 867 | 1755 Ibyte *p; |
| 840 | 1756 for (p = data; p < data + src_used; p++) |
| 428 | 1757 if (*p == '\r') |
| 1758 *p = '\n'; | |
| 1759 } | |
| 1760 | |
| 826 | 1761 set_byte_marker_position (str->start, end); |
| 1762 return size; | |
| 428 | 1763 } |
| 1764 | |
| 665 | 1765 static Bytecount |
| 867 | 1766 lisp_buffer_writer (Lstream *stream, const Ibyte *data, |
| 665 | 1767 Bytecount size) |
| 428 | 1768 { |
| 1769 struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); | |
| 665 | 1770 Charbpos pos; |
| 428 | 1771 struct buffer *buf = XBUFFER (str->buffer); |
| 1772 | |
| 1773 if (!BUFFER_LIVE_P (buf)) | |
| 1774 return 0; /* Fut. */ | |
| 1775 | |
| 1776 pos = marker_position (str->start); | |
| 1777 pos += buffer_insert_raw_string_1 (buf, pos, data, size, 0); | |
| 1778 set_marker_position (str->start, pos); | |
| 1779 return size; | |
| 1780 } | |
| 1781 | |
| 1782 static int | |
| 1783 lisp_buffer_rewinder (Lstream *stream) | |
| 1784 { | |
| 1785 struct lisp_buffer_stream *str = | |
| 1786 LISP_BUFFER_STREAM_DATA (stream); | |
| 1787 struct buffer *buf = XBUFFER (str->buffer); | |
| 1788 long pos = marker_position (str->orig_start); | |
| 1789 if (!BUFFER_LIVE_P (buf)) | |
| 1790 return -1; /* Fut. */ | |
| 1791 if (pos > BUF_ZV (buf)) | |
| 1792 pos = BUF_ZV (buf); | |
| 1793 if (pos < marker_position (str->orig_start)) | |
| 1794 pos = marker_position (str->orig_start); | |
| 1795 if (MARKERP (str->end) && pos > marker_position (str->end)) | |
| 1796 pos = marker_position (str->end); | |
| 1797 set_marker_position (str->start, pos); | |
| 1798 return 0; | |
| 1799 } | |
| 1800 | |
| 1801 static Lisp_Object | |
| 1802 lisp_buffer_marker (Lisp_Object stream) | |
| 1803 { | |
| 1804 struct lisp_buffer_stream *str = | |
| 1805 LISP_BUFFER_STREAM_DATA (XLSTREAM (stream)); | |
| 1806 | |
| 1204 | 1807 mark_object (str->orig_start); |
| 428 | 1808 mark_object (str->start); |
| 1809 mark_object (str->end); | |
| 1810 return str->buffer; | |
| 1811 } | |
| 1812 | |
| 665 | 1813 Charbpos |
| 428 | 1814 lisp_buffer_stream_startpos (Lstream *stream) |
| 1815 { | |
| 1816 return marker_position (LISP_BUFFER_STREAM_DATA (stream)->start); | |
| 1817 } | |
| 1818 | |
| 1819 | |
| 1820 /************************************************************************/ | |
| 1821 /* initialization */ | |
| 1822 /************************************************************************/ | |
| 1823 | |
| 1824 void | |
| 1825 lstream_type_create (void) | |
| 1826 { | |
| 1827 LSTREAM_HAS_METHOD (stdio, reader); | |
| 1828 LSTREAM_HAS_METHOD (stdio, writer); | |
| 1829 LSTREAM_HAS_METHOD (stdio, rewinder); | |
| 1830 LSTREAM_HAS_METHOD (stdio, seekable_p); | |
| 1831 LSTREAM_HAS_METHOD (stdio, flusher); | |
| 1832 LSTREAM_HAS_METHOD (stdio, closer); | |
| 1833 | |
| 1834 LSTREAM_HAS_METHOD (filedesc, reader); | |
| 1835 LSTREAM_HAS_METHOD (filedesc, writer); | |
| 1836 LSTREAM_HAS_METHOD (filedesc, was_blocked_p); | |
| 1837 LSTREAM_HAS_METHOD (filedesc, rewinder); | |
| 1838 LSTREAM_HAS_METHOD (filedesc, seekable_p); | |
| 1839 LSTREAM_HAS_METHOD (filedesc, closer); | |
| 1840 | |
| 1841 LSTREAM_HAS_METHOD (lisp_string, reader); | |
| 1842 LSTREAM_HAS_METHOD (lisp_string, rewinder); | |
| 1843 LSTREAM_HAS_METHOD (lisp_string, marker); | |
| 1844 | |
| 1845 LSTREAM_HAS_METHOD (fixed_buffer, reader); | |
| 1846 LSTREAM_HAS_METHOD (fixed_buffer, writer); | |
| 1847 LSTREAM_HAS_METHOD (fixed_buffer, rewinder); | |
| 1848 | |
| 1849 LSTREAM_HAS_METHOD (resizing_buffer, writer); | |
| 1850 LSTREAM_HAS_METHOD (resizing_buffer, rewinder); | |
| 1851 LSTREAM_HAS_METHOD (resizing_buffer, closer); | |
| 1852 | |
| 1853 LSTREAM_HAS_METHOD (dynarr, writer); | |
| 1854 LSTREAM_HAS_METHOD (dynarr, rewinder); | |
| 1855 LSTREAM_HAS_METHOD (dynarr, closer); | |
| 1856 | |
| 1857 LSTREAM_HAS_METHOD (lisp_buffer, reader); | |
| 1858 LSTREAM_HAS_METHOD (lisp_buffer, writer); | |
| 1859 LSTREAM_HAS_METHOD (lisp_buffer, rewinder); | |
| 1860 LSTREAM_HAS_METHOD (lisp_buffer, marker); | |
| 1861 } | |
| 1862 | |
| 3263 | 1863 #ifndef NEW_GC |
| 428 | 1864 void |
| 1865 reinit_vars_of_lstream (void) | |
| 1866 { | |
| 1867 int i; | |
| 1868 | |
| 1869 for (i = 0; i < countof (Vlstream_free_list); i++) | |
| 1870 { | |
| 1871 Vlstream_free_list[i] = Qnil; | |
| 1872 staticpro_nodump (&Vlstream_free_list[i]); | |
| 1873 } | |
| 1874 } | |
| 3263 | 1875 #endif /* not NEW_GC */ |
| 428 | 1876 |
| 1877 void | |
| 1878 vars_of_lstream (void) | |
| 1879 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
1880 INIT_LISP_OBJECT (lstream); |
| 428 | 1881 } |