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