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