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