Mercurial > hg > xemacs-beta
annotate src/lstream.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Fri, 03 Jun 2011 18:40:57 +0100 |
parents | 308d34e9f07d |
children | 56144c8593a8 |
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 | |
771 | 794 /* Close the stream. All data will be flushed out. If the stream is |
795 already closed, nothing happens. Note that, even if all data has | |
796 already been flushed out, the act of closing a stream may generate more | |
797 data -- for example, if the stream implements some sort of conversion, | |
798 such as gzip, there may be special "end-data" that need to be written | |
799 out when the file is closed. */ | |
800 | |
428 | 801 int |
802 Lstream_close (Lstream *lstr) | |
803 { | |
804 int rc = 0; | |
805 | |
806 if (lstr->flags & LSTREAM_FL_IS_OPEN) | |
807 { | |
808 rc = Lstream_pseudo_close (lstr); | |
809 /* | |
810 * We used to return immediately if the closer method reported | |
811 * failure, leaving the stream open. But this is no good, for | |
812 * the following reasons. | |
813 * | |
814 * 1. The finalizer method used in GC makes no provision for | |
815 * failure, so we must not return without freeing buffer | |
816 * memory. | |
817 * | |
818 * 2. The closer method may have already freed some memory | |
819 * used for I/O in this stream. E.g. encoding_closer frees | |
820 * ENCODING_STREAM_DATA(stream)->runoff. If a writer method | |
821 * tries to use this buffer later, it will write into memory | |
822 * that may have been allocated elsewhere. Sometime later | |
823 * you will see a sign that says "Welcome to Crash City." | |
824 * | |
825 * 3. The closer can report failure if a flush fails in the | |
826 * other stream in a MULE encoding/decoding stream pair. | |
827 * The other stream in the pair is closed, but returning | |
828 * early leaves the current stream open. If we try to | |
829 * flush the current stream later, we will crash when the | |
830 * flusher notices that the other end stream is closed. | |
831 * | |
832 * So, we no longer abort the close if the closer method | |
833 * reports some kind of failure. We still report the failure | |
834 * to the caller. | |
835 */ | |
836 if (lstr->imp->closer) | |
837 if ((lstr->imp->closer) (lstr) < 0) | |
838 rc = -1; | |
839 } | |
840 | |
841 lstr->flags &= ~LSTREAM_FL_IS_OPEN; | |
842 lstr->byte_count = 0; | |
843 /* Note that Lstream_flush() reset all the buffer indices. That way, | |
844 the next call to Lstream_putc(), Lstream_getc(), or Lstream_ungetc() | |
845 on a closed stream will call into the function equivalents, which will | |
846 cause an error. */ | |
847 | |
848 /* We set the pointers to 0 so that we don't lose when this function | |
849 is called more than once on the same object */ | |
850 if (lstr->out_buffer) | |
851 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
852 xfree (lstr->out_buffer); |
428 | 853 lstr->out_buffer = 0; |
854 } | |
855 if (lstr->in_buffer) | |
856 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
857 xfree (lstr->in_buffer); |
428 | 858 lstr->in_buffer = 0; |
859 } | |
860 if (lstr->unget_buffer) | |
861 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
862 xfree (lstr->unget_buffer); |
428 | 863 lstr->unget_buffer = 0; |
864 } | |
865 | |
866 return rc; | |
867 } | |
868 | |
771 | 869 |
870 /* Function equivalent of Lstream_putc(). */ | |
871 | |
428 | 872 int |
873 Lstream_fputc (Lstream *lstr, int c) | |
874 { | |
875 unsigned char ch = (unsigned char) c; | |
771 | 876 int retval = Lstream_write_1 (lstr, &ch, 1); |
877 if (retval == 0 && lstr->buffering == LSTREAM_LINE_BUFFERED && ch == '\n') | |
428 | 878 return Lstream_flush_out (lstr); |
771 | 879 return retval; |
428 | 880 } |
881 | |
771 | 882 /* Function equivalent of Lstream_getc(). */ |
883 | |
428 | 884 int |
885 Lstream_fgetc (Lstream *lstr) | |
886 { | |
887 unsigned char ch; | |
814 | 888 if (Lstream_read_1 (lstr, &ch, 1, 1) <= 0) |
428 | 889 return -1; |
890 return ch; | |
891 } | |
892 | |
771 | 893 /* Function equivalent of Lstream_ungetc(). */ |
894 | |
428 | 895 void |
896 Lstream_fungetc (Lstream *lstr, int c) | |
897 { | |
898 unsigned char ch = (unsigned char) c; | |
899 Lstream_unread (lstr, &ch, 1); | |
900 } | |
901 | |
902 | |
903 /************************ some stream implementations *********************/ | |
904 | |
905 /*********** a stdio stream ***********/ | |
906 | |
907 struct stdio_stream | |
908 { | |
909 FILE *file; | |
910 int closing; | |
911 }; | |
912 | |
913 #define STDIO_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, stdio) | |
914 | |
771 | 915 DEFINE_LSTREAM_IMPLEMENTATION ("stdio", stdio); |
428 | 916 |
917 static Lisp_Object | |
442 | 918 make_stdio_stream_1 (FILE *stream, int flags, const char *mode) |
428 | 919 { |
920 Lstream *lstr = Lstream_new (lstream_stdio, mode); | |
921 struct stdio_stream *str = STDIO_STREAM_DATA (lstr); | |
922 str->file = stream; | |
923 str->closing = flags & LSTR_CLOSING; | |
924 lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE; | |
793 | 925 return wrap_lstream (lstr); |
428 | 926 } |
927 | |
928 Lisp_Object | |
929 make_stdio_input_stream (FILE *stream, int flags) | |
930 { | |
931 return make_stdio_stream_1 (stream, flags, "r"); | |
932 } | |
933 | |
934 Lisp_Object | |
935 make_stdio_output_stream (FILE *stream, int flags) | |
936 { | |
937 return make_stdio_stream_1 (stream, flags, "w"); | |
938 } | |
939 | |
940 /* #### From reading the Unix 98 specification, it appears that if we | |
941 want stdio_reader() to be completely correct, we should check for | |
942 0 < val < size and if so, check to see if an error has occurred. | |
943 If an error has occurred, but val is non-zero, we should go ahead | |
944 and act as if the read was successful, but remember in some fashion | |
945 or other, that an error has occurred, and report that on the next | |
771 | 946 call to stdio_reader instead of calling retry_fread() again. |
428 | 947 |
771 | 948 Currently, in such a case, we end up calling retry_fread() twice and we |
428 | 949 assume that |
950 | |
951 1) this is not harmful, and | |
952 2) the error will still be reported on the second read. | |
953 | |
954 This is probably reasonable, so I don't think we should change this | |
955 code (it could even be argued that the error might have fixed | |
771 | 956 itself, so we should do the retry_fread() again. */ |
428 | 957 |
665 | 958 static Bytecount |
959 stdio_reader (Lstream *stream, unsigned char *data, Bytecount size) | |
428 | 960 { |
961 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
771 | 962 Bytecount val = retry_fread (data, 1, size, str->file); |
963 if (!val) | |
964 { | |
965 if (ferror (str->file)) | |
966 return LSTREAM_ERROR; | |
967 if (feof (str->file)) | |
968 return 0; /* LSTREAM_EOF; */ | |
969 } | |
428 | 970 return val; |
971 } | |
972 | |
665 | 973 static Bytecount |
462 | 974 stdio_writer (Lstream *stream, const unsigned char *data, |
665 | 975 Bytecount size) |
428 | 976 { |
977 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
771 | 978 Bytecount val = retry_fwrite (data, 1, size, str->file); |
428 | 979 if (!val && ferror (str->file)) |
771 | 980 return LSTREAM_ERROR; |
428 | 981 return val; |
982 } | |
983 | |
984 static int | |
985 stdio_rewinder (Lstream *stream) | |
986 { | |
987 rewind (STDIO_STREAM_DATA (stream)->file); | |
988 return 0; | |
989 } | |
990 | |
991 static int | |
992 stdio_seekable_p (Lstream *stream) | |
993 { | |
994 struct stat lestat; | |
995 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
996 | |
771 | 997 if (qxe_fstat (fileno (str->file), &lestat) < 0) |
428 | 998 return 0; |
999 return S_ISREG (lestat.st_mode); | |
1000 } | |
1001 | |
1002 static int | |
1003 stdio_flusher (Lstream *stream) | |
1004 { | |
1005 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
1006 if (stream->flags & LSTREAM_FL_WRITE) | |
1007 return fflush (str->file); | |
1008 else | |
1009 return 0; | |
1010 } | |
1011 | |
1012 static int | |
1013 stdio_closer (Lstream *stream) | |
1014 { | |
1015 struct stdio_stream *str = STDIO_STREAM_DATA (stream); | |
1016 if (str->closing) | |
771 | 1017 return retry_fclose (str->file); |
428 | 1018 else |
1019 if (stream->flags & LSTREAM_FL_WRITE) | |
1020 return fflush (str->file); | |
1021 else | |
1022 return 0; | |
1023 } | |
1024 | |
1025 /*********** a file descriptor ***********/ | |
1026 | |
1027 struct filedesc_stream | |
1028 { | |
1029 int fd; | |
1030 int pty_max_bytes; | |
867 | 1031 Ibyte eof_char; |
428 | 1032 int starting_pos; |
1033 int current_pos; | |
1034 int end_pos; | |
1035 int chars_sans_newline; | |
1036 unsigned int closing :1; | |
1037 unsigned int allow_quit :1; | |
1038 unsigned int blocked_ok :1; | |
1039 unsigned int pty_flushing :1; | |
1040 unsigned int blocking_error_p :1; | |
1041 }; | |
1042 | |
1043 #define FILEDESC_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, filedesc) | |
1044 | |
771 | 1045 DEFINE_LSTREAM_IMPLEMENTATION ("filedesc", filedesc); |
428 | 1046 |
1047 /* Make a stream that reads from or writes to a file descriptor FILEDESC. | |
1048 OFFSET is the offset from the *current* file pointer that the reading | |
1049 should start at. COUNT is the number of bytes to be read (it is | |
1050 ignored when writing); -1 for unlimited. */ | |
1051 static Lisp_Object | |
1052 make_filedesc_stream_1 (int filedesc, int offset, int count, int flags, | |
442 | 1053 const char *mode) |
428 | 1054 { |
1055 Lstream *lstr = Lstream_new (lstream_filedesc, mode); | |
1056 struct filedesc_stream *fstr = FILEDESC_STREAM_DATA (lstr); | |
1057 fstr->fd = filedesc; | |
1058 fstr->closing = !!(flags & LSTR_CLOSING); | |
1059 fstr->allow_quit = !!(flags & LSTR_ALLOW_QUIT); | |
1060 fstr->blocked_ok = !!(flags & LSTR_BLOCKED_OK); | |
1061 fstr->pty_flushing = !!(flags & LSTR_PTY_FLUSHING); | |
1062 fstr->blocking_error_p = 0; | |
1063 fstr->chars_sans_newline = 0; | |
1064 fstr->starting_pos = lseek (filedesc, offset, SEEK_CUR); | |
1065 fstr->current_pos = max (fstr->starting_pos, 0); | |
1066 if (count < 0) | |
1067 fstr->end_pos = -1; | |
1068 else | |
1069 fstr->end_pos = fstr->starting_pos + count; | |
1070 lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE; | |
793 | 1071 return wrap_lstream (lstr); |
428 | 1072 } |
1073 | |
814 | 1074 /* Flags: |
1075 | |
1076 LSTR_CLOSING | |
1077 If set, close the descriptor or FILE * when the stream is closed. | |
1078 | |
1079 LSTR_ALLOW_QUIT | |
1080 If set, allow quitting out of the actual I/O. | |
1081 | |
1082 LSTR_PTY_FLUSHING | |
1083 If set and filedesc_stream_set_pty_flushing() has been called | |
1084 on the stream, do not send more than pty_max_bytes on a single | |
1085 line without flushing the data out using the eof_char. | |
1086 | |
1087 LSTR_BLOCKED_OK | |
1088 If set, an EWOULDBLOCK error is not treated as an error but | |
1089 simply causes the write function to return 0 as the number | |
1090 of bytes written out. | |
1091 */ | |
1092 | |
428 | 1093 Lisp_Object |
1094 make_filedesc_input_stream (int filedesc, int offset, int count, int flags) | |
1095 { | |
1096 return make_filedesc_stream_1 (filedesc, offset, count, flags, "r"); | |
1097 } | |
1098 | |
1099 Lisp_Object | |
1100 make_filedesc_output_stream (int filedesc, int offset, int count, int flags) | |
1101 { | |
1102 return make_filedesc_stream_1 (filedesc, offset, count, flags, "w"); | |
1103 } | |
1104 | |
665 | 1105 static Bytecount |
1106 filedesc_reader (Lstream *stream, unsigned char *data, Bytecount size) | |
428 | 1107 { |
665 | 1108 Bytecount nread; |
428 | 1109 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); |
1110 if (str->end_pos >= 0) | |
665 | 1111 size = min (size, (Bytecount) (str->end_pos - str->current_pos)); |
430 | 1112 nread = str->allow_quit ? |
1113 read_allowing_quit (str->fd, data, size) : | |
771 | 1114 retry_read (str->fd, data, size); |
428 | 1115 if (nread > 0) |
1116 str->current_pos += nread; | |
771 | 1117 if (nread == 0) |
1118 return 0; /* LSTREAM_EOF; */ | |
1119 if (nread < 0) | |
1120 return LSTREAM_ERROR; | |
428 | 1121 return nread; |
1122 } | |
1123 | |
1124 static int | |
1125 errno_would_block_p (int val) | |
1126 { | |
1127 #ifdef EWOULDBLOCK | |
1128 if (val == EWOULDBLOCK) | |
1129 return 1; | |
1130 #endif | |
1131 #ifdef EAGAIN | |
1132 if (val == EAGAIN) | |
1133 return 1; | |
1134 #endif | |
1135 return 0; | |
1136 } | |
1137 | |
665 | 1138 static Bytecount |
462 | 1139 filedesc_writer (Lstream *stream, const unsigned char *data, |
665 | 1140 Bytecount size) |
428 | 1141 { |
1142 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
665 | 1143 Bytecount retval; |
428 | 1144 int need_newline = 0; |
1145 | |
1146 /* This function would be simple if it were not for the blasted | |
1147 PTY max-bytes stuff. Why the hell can't they just have written | |
1148 the PTY drivers right so this problem doesn't exist? | |
1149 | |
1150 Maybe all the PTY crap here should be moved into another stream | |
1151 that does nothing but periodically insert EOF's as necessary. */ | |
1152 if (str->pty_flushing) | |
1153 { | |
1154 /* To make life easy, only send out one line at the most. */ | |
442 | 1155 const unsigned char *ptr; |
428 | 1156 |
442 | 1157 ptr = (const unsigned char *) memchr (data, '\n', size); |
428 | 1158 if (ptr) |
1159 need_newline = 1; | |
1160 else | |
1161 ptr = data + size; | |
1162 if (ptr - data >= str->pty_max_bytes - str->chars_sans_newline) | |
1163 { | |
1164 ptr = data + str->pty_max_bytes - str->chars_sans_newline; | |
1165 need_newline = 0; | |
1166 } | |
1167 size = ptr - data; | |
1168 } | |
1169 | |
1170 /**** start of non-PTY-crap ****/ | |
1171 if (size > 0) | |
430 | 1172 retval = str->allow_quit ? |
1173 write_allowing_quit (str->fd, data, size) : | |
771 | 1174 retry_write (str->fd, data, size); |
428 | 1175 else |
1176 retval = 0; | |
1177 if (retval < 0 && errno_would_block_p (errno) && str->blocked_ok) | |
1178 { | |
1179 str->blocking_error_p = 1; | |
1180 return 0; | |
1181 } | |
1182 str->blocking_error_p = 0; | |
1183 if (retval < 0) | |
771 | 1184 return LSTREAM_ERROR; |
428 | 1185 /**** end non-PTY-crap ****/ |
1186 | |
1187 if (str->pty_flushing) | |
1188 { | |
1189 str->chars_sans_newline += retval; | |
1190 /* Note that a newline was not among the bytes written out. | |
1191 Add to the number of non-newline bytes written out, | |
1192 and flush with an EOF if necessary. Be careful to | |
1193 keep track of write errors as we go along and look | |
1194 out for EWOULDBLOCK. */ | |
1195 if (str->chars_sans_newline >= str->pty_max_bytes) | |
1196 { | |
665 | 1197 Bytecount retval2 = str->allow_quit ? |
430 | 1198 write_allowing_quit (str->fd, &str->eof_char, 1) : |
771 | 1199 retry_write (str->fd, &str->eof_char, 1); |
430 | 1200 |
428 | 1201 if (retval2 > 0) |
1202 str->chars_sans_newline = 0; | |
1203 else if (retval2 < 0) | |
1204 { | |
1205 /* Error writing the EOF char. If nothing got written, | |
1206 then treat this as an error -- either return an error | |
1207 condition or set the blocking-error flag. */ | |
1208 if (retval == 0) | |
1209 { | |
1210 if (errno_would_block_p (errno) && str->blocked_ok) | |
1211 { | |
1212 str->blocking_error_p = 1; | |
1213 return 0; | |
1214 } | |
1215 else | |
771 | 1216 return LSTREAM_ERROR; |
428 | 1217 } |
1218 else | |
1219 return retval; | |
1220 } | |
1221 } | |
1222 } | |
1223 | |
1224 /* The need_newline flag is necessary because otherwise when the | |
1225 first byte is a newline, we'd get stuck never writing anything | |
1226 in pty-flushing mode. */ | |
1227 if (need_newline) | |
1228 { | |
867 | 1229 Ibyte nl = '\n'; |
665 | 1230 Bytecount retval2 = str->allow_quit ? |
430 | 1231 write_allowing_quit (str->fd, &nl, 1) : |
771 | 1232 retry_write (str->fd, &nl, 1); |
430 | 1233 |
428 | 1234 if (retval2 > 0) |
1235 { | |
1236 str->chars_sans_newline = 0; | |
1237 retval++; | |
1238 } | |
1239 else if (retval2 < 0) | |
1240 { | |
1241 /* Error writing the newline char. If nothing got written, | |
1242 then treat this as an error -- either return an error | |
1243 condition or set the blocking-error flag. */ | |
1244 if (retval == 0) | |
1245 { | |
1246 if (errno_would_block_p (errno) && str->blocked_ok) | |
1247 { | |
1248 str->blocking_error_p = 1; | |
1249 return 0; | |
1250 } | |
1251 else | |
771 | 1252 return LSTREAM_ERROR; |
428 | 1253 } |
1254 else | |
1255 return retval; | |
1256 } | |
1257 } | |
1258 | |
1259 return retval; | |
1260 } | |
1261 | |
1262 static int | |
1263 filedesc_rewinder (Lstream *stream) | |
1264 { | |
1265 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
1266 if (str->starting_pos < 0 || | |
1267 lseek (FILEDESC_STREAM_DATA (stream)->fd, str->starting_pos, | |
1268 SEEK_SET) == -1) | |
1269 return -1; | |
1270 else | |
1271 { | |
1272 str->current_pos = str->starting_pos; | |
1273 return 0; | |
1274 } | |
1275 } | |
1276 | |
1277 static int | |
1278 filedesc_seekable_p (Lstream *stream) | |
1279 { | |
1280 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
1281 if (str->starting_pos < 0) | |
1282 return 0; | |
1283 else | |
1284 { | |
1285 struct stat lestat; | |
1286 | |
771 | 1287 if (qxe_fstat (str->fd, &lestat) < 0) |
428 | 1288 return 0; |
1289 return S_ISREG (lestat.st_mode); | |
1290 } | |
1291 } | |
1292 | |
1293 static int | |
1294 filedesc_closer (Lstream *stream) | |
1295 { | |
1296 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
1297 if (str->closing) | |
771 | 1298 return retry_close (str->fd); |
428 | 1299 else |
1300 return 0; | |
1301 } | |
1302 | |
1303 static int | |
1304 filedesc_was_blocked_p (Lstream *stream) | |
1305 { | |
1306 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
1307 return str->blocking_error_p; | |
1308 } | |
1309 | |
1310 void | |
1311 filedesc_stream_set_pty_flushing (Lstream *stream, int pty_max_bytes, | |
867 | 1312 Ibyte eof_char) |
428 | 1313 { |
1314 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
1315 str->pty_max_bytes = pty_max_bytes; | |
1316 str->eof_char = eof_char; | |
1317 str->pty_flushing = 1; | |
1318 } | |
1319 | |
1320 int | |
1321 filedesc_stream_fd (Lstream *stream) | |
1322 { | |
1323 struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); | |
1324 return str->fd; | |
1325 } | |
1326 | |
1327 /*********** read from a Lisp string ***********/ | |
1328 | |
1329 #define LISP_STRING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, lisp_string) | |
1330 | |
1331 struct lisp_string_stream | |
1332 { | |
1333 Lisp_Object obj; | |
1334 Bytecount init_offset; | |
1335 Bytecount offset, end; | |
1336 }; | |
1337 | |
1204 | 1338 static const struct memory_description lisp_string_lstream_description[] = { |
1339 { XD_LISP_OBJECT, offsetof (struct lisp_string_stream, obj) }, | |
1340 { XD_END } | |
1341 }; | |
1342 | |
1343 DEFINE_LSTREAM_IMPLEMENTATION_WITH_DATA ("lisp-string", lisp_string); | |
428 | 1344 |
1345 Lisp_Object | |
1346 make_lisp_string_input_stream (Lisp_Object string, Bytecount offset, | |
1347 Bytecount len) | |
1348 { | |
1349 Lstream *lstr; | |
1350 struct lisp_string_stream *str; | |
1351 | |
1352 CHECK_STRING (string); | |
1353 if (len < 0) | |
1354 len = XSTRING_LENGTH (string) - offset; | |
1355 assert (offset >= 0); | |
1356 assert (len >= 0); | |
1357 assert (offset + len <= XSTRING_LENGTH (string)); | |
1358 | |
1359 lstr = Lstream_new (lstream_lisp_string, "r"); | |
1360 str = LISP_STRING_STREAM_DATA (lstr); | |
1361 str->offset = offset; | |
1362 str->end = offset + len; | |
1363 str->init_offset = offset; | |
1364 str->obj = string; | |
793 | 1365 return wrap_lstream (lstr); |
428 | 1366 } |
1367 | |
665 | 1368 static Bytecount |
462 | 1369 lisp_string_reader (Lstream *stream, unsigned char *data, |
665 | 1370 Bytecount size) |
428 | 1371 { |
1372 struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (stream); | |
1373 /* Don't lose if the string shrank past us ... */ | |
1374 Bytecount offset = min (str->offset, XSTRING_LENGTH (str->obj)); | |
867 | 1375 Ibyte *strstart = XSTRING_DATA (str->obj); |
1376 Ibyte *start = strstart + offset; | |
428 | 1377 |
1378 /* ... or if someone changed the string and we ended up in the | |
1379 middle of a character. */ | |
1380 /* Being in the middle of a character is `normal' unless | |
1381 LSTREAM_NO_PARTIAL_CHARS - mrb */ | |
1382 if (stream->flags & LSTREAM_FL_NO_PARTIAL_CHARS) | |
867 | 1383 VALIDATE_IBYTEPTR_BACKWARD (start); |
428 | 1384 offset = start - strstart; |
665 | 1385 size = min (size, (Bytecount) (str->end - offset)); |
428 | 1386 memcpy (data, start, size); |
1387 str->offset = offset + size; | |
1388 return size; | |
1389 } | |
1390 | |
1391 static int | |
1392 lisp_string_rewinder (Lstream *stream) | |
1393 { | |
1394 struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (stream); | |
1395 int pos = str->init_offset; | |
1396 if (pos > str->end) | |
1397 pos = str->end; | |
1398 /* Don't lose if the string shrank past us ... */ | |
1399 pos = min (pos, XSTRING_LENGTH (str->obj)); | |
1400 /* ... or if someone changed the string and we ended up in the | |
1401 middle of a character. */ | |
1402 { | |
867 | 1403 Ibyte *strstart = XSTRING_DATA (str->obj); |
1404 Ibyte *start = strstart + pos; | |
1405 VALIDATE_IBYTEPTR_BACKWARD (start); | |
428 | 1406 pos = start - strstart; |
1407 } | |
1408 str->offset = pos; | |
1409 return 0; | |
1410 } | |
1411 | |
1412 static Lisp_Object | |
1413 lisp_string_marker (Lisp_Object stream) | |
1414 { | |
1415 struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (XLSTREAM (stream)); | |
1416 return str->obj; | |
1417 } | |
1418 | |
1419 /*********** a fixed buffer ***********/ | |
1420 | |
1421 #define FIXED_BUFFER_STREAM_DATA(stream) \ | |
1422 LSTREAM_TYPE_DATA (stream, fixed_buffer) | |
1423 | |
1424 struct fixed_buffer_stream | |
1425 { | |
442 | 1426 const unsigned char *inbuf; |
428 | 1427 unsigned char *outbuf; |
665 | 1428 Bytecount size; |
1429 Bytecount offset; | |
428 | 1430 }; |
1431 | |
771 | 1432 DEFINE_LSTREAM_IMPLEMENTATION ("fixed-buffer", fixed_buffer); |
428 | 1433 |
1434 Lisp_Object | |
665 | 1435 make_fixed_buffer_input_stream (const void *buf, Bytecount size) |
428 | 1436 { |
1437 Lstream *lstr = Lstream_new (lstream_fixed_buffer, "r"); | |
1438 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr); | |
440 | 1439 str->inbuf = (const unsigned char *) buf; |
428 | 1440 str->size = size; |
793 | 1441 return wrap_lstream (lstr); |
428 | 1442 } |
1443 | |
1444 Lisp_Object | |
665 | 1445 make_fixed_buffer_output_stream (void *buf, Bytecount size) |
428 | 1446 { |
1447 Lstream *lstr = Lstream_new (lstream_fixed_buffer, "w"); | |
1448 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr); | |
440 | 1449 str->outbuf = (unsigned char *) buf; |
428 | 1450 str->size = size; |
793 | 1451 return wrap_lstream (lstr); |
428 | 1452 } |
1453 | |
665 | 1454 static Bytecount |
462 | 1455 fixed_buffer_reader (Lstream *stream, unsigned char *data, |
665 | 1456 Bytecount size) |
428 | 1457 { |
1458 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream); | |
1459 size = min (size, str->size - str->offset); | |
1460 memcpy (data, str->inbuf + str->offset, size); | |
1461 str->offset += size; | |
1462 return size; | |
1463 } | |
1464 | |
665 | 1465 static Bytecount |
462 | 1466 fixed_buffer_writer (Lstream *stream, const unsigned char *data, |
665 | 1467 Bytecount size) |
428 | 1468 { |
1469 struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream); | |
1470 if (str->offset == str->size) | |
1471 { | |
1472 /* If we're at the end, just throw away the data and pretend | |
1473 we wrote all of it. If we return 0, then the lstream routines | |
1474 will try again and again to write it out. */ | |
1475 return size; | |
1476 } | |
1477 size = min (size, str->size - str->offset); | |
1478 memcpy (str->outbuf + str->offset, data, size); | |
1479 str->offset += size; | |
1480 return size; | |
1481 } | |
1482 | |
1483 static int | |
1484 fixed_buffer_rewinder (Lstream *stream) | |
1485 { | |
1486 FIXED_BUFFER_STREAM_DATA (stream)->offset = 0; | |
1487 return 0; | |
1488 } | |
1489 | |
442 | 1490 const unsigned char * |
428 | 1491 fixed_buffer_input_stream_ptr (Lstream *stream) |
1492 { | |
1493 assert (stream->imp == lstream_fixed_buffer); | |
1494 return FIXED_BUFFER_STREAM_DATA (stream)->inbuf; | |
1495 } | |
1496 | |
1497 unsigned char * | |
1498 fixed_buffer_output_stream_ptr (Lstream *stream) | |
1499 { | |
1500 assert (stream->imp == lstream_fixed_buffer); | |
1501 return FIXED_BUFFER_STREAM_DATA (stream)->outbuf; | |
1502 } | |
1503 | |
1504 /*********** write to a resizing buffer ***********/ | |
1505 | |
1506 #define RESIZING_BUFFER_STREAM_DATA(stream) \ | |
1507 LSTREAM_TYPE_DATA (stream, resizing_buffer) | |
1508 | |
1509 struct resizing_buffer_stream | |
1510 { | |
1511 unsigned char *buf; | |
665 | 1512 Bytecount allocked; |
428 | 1513 int max_stored; |
1514 int stored; | |
1515 }; | |
1516 | |
771 | 1517 DEFINE_LSTREAM_IMPLEMENTATION ("resizing-buffer", resizing_buffer); |
428 | 1518 |
1519 Lisp_Object | |
1520 make_resizing_buffer_output_stream (void) | |
1521 { | |
793 | 1522 return wrap_lstream (Lstream_new (lstream_resizing_buffer, "w")); |
428 | 1523 } |
1524 | |
665 | 1525 static Bytecount |
462 | 1526 resizing_buffer_writer (Lstream *stream, const unsigned char *data, |
665 | 1527 Bytecount size) |
428 | 1528 { |
1529 struct resizing_buffer_stream *str = RESIZING_BUFFER_STREAM_DATA (stream); | |
1530 DO_REALLOC (str->buf, str->allocked, str->stored + size, unsigned char); | |
1531 memcpy (str->buf + str->stored, data, size); | |
1532 str->stored += size; | |
1533 str->max_stored = max (str->max_stored, str->stored); | |
1534 return size; | |
1535 } | |
1536 | |
1537 static int | |
1538 resizing_buffer_rewinder (Lstream *stream) | |
1539 { | |
1540 RESIZING_BUFFER_STREAM_DATA (stream)->stored = 0; | |
1541 return 0; | |
1542 } | |
1543 | |
1544 static int | |
1545 resizing_buffer_closer (Lstream *stream) | |
1546 { | |
1547 struct resizing_buffer_stream *str = RESIZING_BUFFER_STREAM_DATA (stream); | |
1548 if (str->buf) | |
1549 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
1550 xfree (str->buf); |
428 | 1551 str->buf = 0; |
1552 } | |
1553 return 0; | |
1554 } | |
1555 | |
1556 unsigned char * | |
1557 resizing_buffer_stream_ptr (Lstream *stream) | |
1558 { | |
1559 return RESIZING_BUFFER_STREAM_DATA (stream)->buf; | |
1560 } | |
1561 | |
788 | 1562 Lisp_Object |
1563 resizing_buffer_to_lisp_string (Lstream *stream) | |
1564 { | |
1565 return make_string (resizing_buffer_stream_ptr (stream), | |
1566 Lstream_byte_count (stream)); | |
1567 } | |
1568 | |
428 | 1569 /*********** write to an unsigned-char dynarr ***********/ |
1570 | |
1571 /* Note: If you have a dynarr whose type is not unsigned_char_dynarr | |
1572 but which is really just an unsigned_char_dynarr (e.g. its type | |
867 | 1573 is Ibyte or Extbyte), just cast to unsigned_char_dynarr. */ |
428 | 1574 |
1575 #define DYNARR_STREAM_DATA(stream) \ | |
1576 LSTREAM_TYPE_DATA (stream, dynarr) | |
1577 | |
1578 struct dynarr_stream | |
1579 { | |
1580 unsigned_char_dynarr *dyn; | |
1581 }; | |
1582 | |
771 | 1583 DEFINE_LSTREAM_IMPLEMENTATION ("dynarr", dynarr); |
428 | 1584 |
1585 Lisp_Object | |
1586 make_dynarr_output_stream (unsigned_char_dynarr *dyn) | |
1587 { | |
793 | 1588 Lisp_Object obj = wrap_lstream (Lstream_new (lstream_dynarr, "w")); |
1589 | |
428 | 1590 DYNARR_STREAM_DATA (XLSTREAM (obj))->dyn = dyn; |
1591 return obj; | |
1592 } | |
1593 | |
665 | 1594 static Bytecount |
462 | 1595 dynarr_writer (Lstream *stream, const unsigned char *data, |
665 | 1596 Bytecount size) |
428 | 1597 { |
1598 struct dynarr_stream *str = DYNARR_STREAM_DATA (stream); | |
1599 Dynarr_add_many (str->dyn, data, size); | |
1600 return size; | |
1601 } | |
1602 | |
1603 static int | |
1604 dynarr_rewinder (Lstream *stream) | |
1605 { | |
1606 Dynarr_reset (DYNARR_STREAM_DATA (stream)->dyn); | |
1607 return 0; | |
1608 } | |
1609 | |
1610 static int | |
2286 | 1611 dynarr_closer (Lstream *UNUSED (stream)) |
428 | 1612 { |
1613 return 0; | |
1614 } | |
1615 | |
1616 /************ read from or write to a Lisp buffer ************/ | |
1617 | |
1618 /* Note: Lisp-buffer read streams never return partial characters, | |
1619 and Lisp-buffer write streams expect to never get partial | |
1620 characters. */ | |
1621 | |
1622 #define LISP_BUFFER_STREAM_DATA(stream) \ | |
1623 LSTREAM_TYPE_DATA (stream, lisp_buffer) | |
1624 | |
1625 struct lisp_buffer_stream | |
1626 { | |
1627 Lisp_Object buffer; | |
1628 Lisp_Object orig_start; | |
1629 /* we use markers to properly deal with insertion/deletion */ | |
1630 Lisp_Object start, end; | |
1631 int flags; | |
1632 }; | |
1633 | |
1204 | 1634 static const struct memory_description lisp_buffer_lstream_description[] = { |
1635 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, buffer) }, | |
1636 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, orig_start) }, | |
1637 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, start) }, | |
1638 { XD_LISP_OBJECT, offsetof (struct lisp_buffer_stream, end) }, | |
1639 { XD_END } | |
1640 }; | |
1641 | |
1642 DEFINE_LSTREAM_IMPLEMENTATION_WITH_DATA ("lisp-buffer", lisp_buffer); | |
428 | 1643 |
1644 static Lisp_Object | |
665 | 1645 make_lisp_buffer_stream_1 (struct buffer *buf, Charbpos start, Charbpos end, |
2367 | 1646 int flags, const Ascbyte *mode) |
428 | 1647 { |
1648 Lstream *lstr; | |
1649 struct lisp_buffer_stream *str; | |
665 | 1650 Charbpos bmin, bmax; |
428 | 1651 int reading = !strcmp (mode, "r"); |
1652 | |
1653 /* 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
|
1654 assert (strcmp (mode, "w")); |
428 | 1655 |
1656 if (flags & LSTR_IGNORE_ACCESSIBLE) | |
1657 { | |
1658 bmin = BUF_BEG (buf); | |
1659 bmax = BUF_Z (buf); | |
1660 } | |
1661 else | |
1662 { | |
1663 bmin = BUF_BEGV (buf); | |
1664 bmax = BUF_ZV (buf); | |
1665 } | |
1666 | |
1667 if (start == -1) | |
1668 start = bmin; | |
1669 if (end == -1) | |
1670 end = bmax; | |
1671 assert (bmin <= start); | |
1672 assert (start <= bmax); | |
1673 if (reading) | |
1674 { | |
1675 assert (bmin <= end); | |
1676 assert (end <= bmax); | |
1677 assert (start <= end); | |
1678 } | |
1679 | |
1680 lstr = Lstream_new (lstream_lisp_buffer, mode); | |
1681 str = LISP_BUFFER_STREAM_DATA (lstr); | |
1682 { | |
1683 Lisp_Object marker; | |
793 | 1684 Lisp_Object buffer = wrap_buffer (buf); |
428 | 1685 |
1686 marker = Fmake_marker (); | |
1687 Fset_marker (marker, make_int (start), buffer); | |
1688 str->start = marker; | |
1689 marker = Fmake_marker (); | |
1690 Fset_marker (marker, make_int (start), buffer); | |
1691 str->orig_start = marker; | |
1692 if (reading) | |
1693 { | |
1694 marker = Fmake_marker (); | |
1695 Fset_marker (marker, make_int (end), buffer); | |
1696 str->end = marker; | |
1697 } | |
1698 else | |
1699 str->end = Qnil; | |
1700 str->buffer = buffer; | |
1701 } | |
1702 str->flags = flags; | |
793 | 1703 return wrap_lstream (lstr); |
428 | 1704 } |
1705 | |
1706 Lisp_Object | |
826 | 1707 make_lisp_buffer_input_stream (struct buffer *buf, Charbpos start, |
1708 Charbpos end, int flags) | |
428 | 1709 { |
1710 return make_lisp_buffer_stream_1 (buf, start, end, flags, "r"); | |
1711 } | |
1712 | |
1713 Lisp_Object | |
665 | 1714 make_lisp_buffer_output_stream (struct buffer *buf, Charbpos pos, int flags) |
428 | 1715 { |
1716 Lisp_Object lstr = make_lisp_buffer_stream_1 (buf, pos, 0, flags, "wc"); | |
1717 | |
1718 Lstream_set_character_mode (XLSTREAM (lstr)); | |
1719 return lstr; | |
1720 } | |
1721 | |
665 | 1722 static Bytecount |
867 | 1723 lisp_buffer_reader (Lstream *stream, Ibyte *data, Bytecount size) |
428 | 1724 { |
1725 struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); | |
665 | 1726 Bytebpos start; |
1727 Bytebpos end; | |
428 | 1728 struct buffer *buf = XBUFFER (str->buffer); |
826 | 1729 Bytecount src_used; |
428 | 1730 |
1731 if (!BUFFER_LIVE_P (buf)) | |
1732 return 0; /* Fut. */ | |
1733 | |
826 | 1734 start = byte_marker_position (str->start); |
1735 end = byte_marker_position (str->end); | |
428 | 1736 if (!(str->flags & LSTR_IGNORE_ACCESSIBLE)) |
1737 { | |
826 | 1738 start = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf), start, |
1739 BYTE_BUF_ZV (buf)); | |
1740 end = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf), end, | |
1741 BYTE_BUF_ZV (buf)); | |
428 | 1742 } |
1743 | |
826 | 1744 size = copy_buffer_text_out (buf, start, end - start, data, size, |
1745 FORMAT_DEFAULT, Qnil, &src_used); | |
1746 end = start + src_used; | |
428 | 1747 |
1748 if (EQ (buf->selective_display, Qt) && str->flags & LSTR_SELECTIVE) | |
1749 { | |
1750 /* What a kludge. What a kludge. What a kludge. */ | |
867 | 1751 Ibyte *p; |
840 | 1752 for (p = data; p < data + src_used; p++) |
428 | 1753 if (*p == '\r') |
1754 *p = '\n'; | |
1755 } | |
1756 | |
826 | 1757 set_byte_marker_position (str->start, end); |
1758 return size; | |
428 | 1759 } |
1760 | |
665 | 1761 static Bytecount |
867 | 1762 lisp_buffer_writer (Lstream *stream, const Ibyte *data, |
665 | 1763 Bytecount size) |
428 | 1764 { |
1765 struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); | |
665 | 1766 Charbpos pos; |
428 | 1767 struct buffer *buf = XBUFFER (str->buffer); |
1768 | |
1769 if (!BUFFER_LIVE_P (buf)) | |
1770 return 0; /* Fut. */ | |
1771 | |
1772 pos = marker_position (str->start); | |
1773 pos += buffer_insert_raw_string_1 (buf, pos, data, size, 0); | |
1774 set_marker_position (str->start, pos); | |
1775 return size; | |
1776 } | |
1777 | |
1778 static int | |
1779 lisp_buffer_rewinder (Lstream *stream) | |
1780 { | |
1781 struct lisp_buffer_stream *str = | |
1782 LISP_BUFFER_STREAM_DATA (stream); | |
1783 struct buffer *buf = XBUFFER (str->buffer); | |
1784 long pos = marker_position (str->orig_start); | |
1785 if (!BUFFER_LIVE_P (buf)) | |
1786 return -1; /* Fut. */ | |
1787 if (pos > BUF_ZV (buf)) | |
1788 pos = BUF_ZV (buf); | |
1789 if (pos < marker_position (str->orig_start)) | |
1790 pos = marker_position (str->orig_start); | |
1791 if (MARKERP (str->end) && pos > marker_position (str->end)) | |
1792 pos = marker_position (str->end); | |
1793 set_marker_position (str->start, pos); | |
1794 return 0; | |
1795 } | |
1796 | |
1797 static Lisp_Object | |
1798 lisp_buffer_marker (Lisp_Object stream) | |
1799 { | |
1800 struct lisp_buffer_stream *str = | |
1801 LISP_BUFFER_STREAM_DATA (XLSTREAM (stream)); | |
1802 | |
1204 | 1803 mark_object (str->orig_start); |
428 | 1804 mark_object (str->start); |
1805 mark_object (str->end); | |
1806 return str->buffer; | |
1807 } | |
1808 | |
665 | 1809 Charbpos |
428 | 1810 lisp_buffer_stream_startpos (Lstream *stream) |
1811 { | |
1812 return marker_position (LISP_BUFFER_STREAM_DATA (stream)->start); | |
1813 } | |
1814 | |
1815 | |
1816 /************************************************************************/ | |
1817 /* initialization */ | |
1818 /************************************************************************/ | |
1819 | |
1820 void | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1821 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
|
1822 { |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1823 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
|
1824 } |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1825 |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1826 void |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1827 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
|
1828 { |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1829 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
|
1830 } |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1831 |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1832 void |
428 | 1833 lstream_type_create (void) |
1834 { | |
1835 LSTREAM_HAS_METHOD (stdio, reader); | |
1836 LSTREAM_HAS_METHOD (stdio, writer); | |
1837 LSTREAM_HAS_METHOD (stdio, rewinder); | |
1838 LSTREAM_HAS_METHOD (stdio, seekable_p); | |
1839 LSTREAM_HAS_METHOD (stdio, flusher); | |
1840 LSTREAM_HAS_METHOD (stdio, closer); | |
1841 | |
1842 LSTREAM_HAS_METHOD (filedesc, reader); | |
1843 LSTREAM_HAS_METHOD (filedesc, writer); | |
1844 LSTREAM_HAS_METHOD (filedesc, was_blocked_p); | |
1845 LSTREAM_HAS_METHOD (filedesc, rewinder); | |
1846 LSTREAM_HAS_METHOD (filedesc, seekable_p); | |
1847 LSTREAM_HAS_METHOD (filedesc, closer); | |
1848 | |
1849 LSTREAM_HAS_METHOD (lisp_string, reader); | |
1850 LSTREAM_HAS_METHOD (lisp_string, rewinder); | |
1851 LSTREAM_HAS_METHOD (lisp_string, marker); | |
1852 | |
1853 LSTREAM_HAS_METHOD (fixed_buffer, reader); | |
1854 LSTREAM_HAS_METHOD (fixed_buffer, writer); | |
1855 LSTREAM_HAS_METHOD (fixed_buffer, rewinder); | |
1856 | |
1857 LSTREAM_HAS_METHOD (resizing_buffer, writer); | |
1858 LSTREAM_HAS_METHOD (resizing_buffer, rewinder); | |
1859 LSTREAM_HAS_METHOD (resizing_buffer, closer); | |
1860 | |
1861 LSTREAM_HAS_METHOD (dynarr, writer); | |
1862 LSTREAM_HAS_METHOD (dynarr, rewinder); | |
1863 LSTREAM_HAS_METHOD (dynarr, closer); | |
1864 | |
1865 LSTREAM_HAS_METHOD (lisp_buffer, reader); | |
1866 LSTREAM_HAS_METHOD (lisp_buffer, writer); | |
1867 LSTREAM_HAS_METHOD (lisp_buffer, rewinder); | |
1868 LSTREAM_HAS_METHOD (lisp_buffer, marker); | |
1869 } | |
1870 | |
3263 | 1871 #ifndef NEW_GC |
428 | 1872 void |
1873 reinit_vars_of_lstream (void) | |
1874 { | |
1875 int i; | |
1876 | |
1877 for (i = 0; i < countof (Vlstream_free_list); i++) | |
1878 { | |
1879 Vlstream_free_list[i] = Qnil; | |
1880 staticpro_nodump (&Vlstream_free_list[i]); | |
1881 } | |
1882 } | |
3263 | 1883 #endif /* not NEW_GC */ |
428 | 1884 |
1885 void | |
1886 vars_of_lstream (void) | |
1887 { | |
1888 } |