mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Use heap-allocated port types instead of ptobnums

Browse source 
This removes a limitation on the number of port types, simplifies the
API, and removes a central point of coordination.

* libguile/ports-internal.h (struct scm_t_port_type): Rename from
  scm_t_ptob_descriptor, now that it's private.  Add GOOPS class
  fields.
  (struct scm_t_port): Rename from struct scm_port, especially
  considering that deprecated.h redefines scm_port using the
  preprocessor :(.
* libguile/ports.h: Add definitions of SCM_PORT and SCM_PORT_TYPE,
  though the scm_t_port and scm_t_port_type types are incomplete.
  (SCM_TC2PTOBNUM, SCM_PTOBNUM, SCM_PTOBNAME): Remove, as there are no
  more typecodes for port types.
  (scm_c_num_port_types, scm_c_port_type_ref, scm_c_port_type_add_x):
  Remove.
  (scm_make_port_type): Return a scm_t_port_type*.  All methods adapted
  to take a scm_t_port_type* instead of a ptobnum.
  (scm_c_make_port_with_encoding, scm_c_make_port): Take a port type
  pointer instead of a tag.
  (scm_new_port_table_entry): Remove; not useful.
* libguile/ports.c: Remove things related to the port kind table.  Adapt
  uses of SCM_PORT_DESCRIPTOR / scm_t_ptob_descriptor to use
  SCM_PORT_TYPE and scm_t_port_type.
* libguile/deprecated.c:
* libguile/deprecated.h:
* libguile/filesys.c:
* libguile/fports.c:
* libguile/fports.h:
* libguile/print.c:
* libguile/r6rs-ports.c:
* libguile/strports.c:
* libguile/strports.h:
* libguile/tags.h:
* libguile/vports.c:
* test-suite/standalone/test-scm-c-read.c: Adapt to change.
* libguile/goops.c (scm_class_of, make_port_classes)
  (scm_make_port_classes, create_port_classes): Adapt to store the
  classes in the ptob.
This commit is contained in:
Andy Wingo 2016-05-13 18:23:47 +02:00
parent 17f90360b6
commit cd51ce81d0
17 changed files with 190 additions and 272 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/deprecated.c
View file

@ -202,7 +202,6 @@ scm_init_deprecated_goops (void)
scm_class_output_port = scm_variable_ref (scm_c_lookup ("<output-port>")); scm_class_output_port = scm_variable_ref (scm_c_lookup ("<output-port>"));
scm_class_input_output_port = scm_variable_ref (scm_c_lookup ("<input-output-port>")); scm_class_input_output_port = scm_variable_ref (scm_c_lookup ("<input-output-port>"));
scm_port_class = scm_i_port_class;
scm_smob_class = scm_i_smob_class; scm_smob_class = scm_i_smob_class;
} }

3
libguile/deprecated.h
View file

@ -116,7 +116,7 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard before,
#define scm_option scm_option__GONE__REPLACE_WITH__scm_t_option #define scm_option scm_option__GONE__REPLACE_WITH__scm_t_option
#define scm_port scm_port__GONE__REPLACE_WITH__scm_t_port #define scm_port scm_port__GONE__REPLACE_WITH__scm_t_port
#define scm_port_rw_active scm_port_rw_active__GONE__REPLACE_WITH__scm_t_port_rw_active #define scm_port_rw_active scm_port_rw_active__GONE__REPLACE_WITH__scm_t_port_rw_active
#define scm_ptob_descriptor scm_ptob_descriptor__GONE__REPLACE_WITH__scm_t_ptob_descriptor #define scm_ptob_descriptor scm_ptob_descriptor__GONE__REPLACE_WITH__scm_t_port_type
#define scm_rng scm_rng__GONE__REPLACE_WITH__scm_t_rng #define scm_rng scm_rng__GONE__REPLACE_WITH__scm_t_rng
#define scm_rstate scm_rstate__GONE__REPLACE_WITH__scm_t_rstate #define scm_rstate scm_rstate__GONE__REPLACE_WITH__scm_t_rstate
#define scm_sizet scm_sizet__GONE__REPLACE_WITH__size_t #define scm_sizet scm_sizet__GONE__REPLACE_WITH__size_t
@ -203,7 +203,6 @@ SCM_DEPRECATED SCM scm_class_int;
SCM_DEPRECATED SCM scm_class_float; SCM_DEPRECATED SCM scm_class_float;
SCM_DEPRECATED SCM scm_class_double; SCM_DEPRECATED SCM scm_class_double;
SCM_DEPRECATED SCM *scm_port_class;
SCM_DEPRECATED SCM *scm_smob_class; SCM_DEPRECATED SCM *scm_smob_class;
SCM_INTERNAL void scm_init_deprecated_goops (void); SCM_INTERNAL void scm_init_deprecated_goops (void);

1
libguile/filesys.c
View file

@ -47,6 +47,7 @@
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/dynwind.h" #include "libguile/dynwind.h"
#include "libguile/ports.h"
#include "libguile/ports-internal.h" #include "libguile/ports-internal.h"
#include "libguile/validate.h" #include "libguile/validate.h"

32
libguile/fports.c
View file

@ -72,7 +72,7 @@
#error Oops, unknown OFF_T size #error Oops, unknown OFF_T size
#endif #endif
scm_t_bits scm_tc16_fport; scm_t_port_type *scm_file_port_type;
/* Move ports with the specified file descriptor to new descriptors, /* Move ports with the specified file descriptor to new descriptors,
@ -409,7 +409,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
"file port"); "file port");
fp->fdes = fdes; fp->fdes = fdes;
port = scm_c_make_port (scm_tc16_fport, mode_bits, (scm_t_bits)fp); port = scm_c_make_port (scm_file_port_type, mode_bits, (scm_t_bits)fp);
SCM_SET_FILENAME (port, name); SCM_SET_FILENAME (port, name);
@ -547,7 +547,7 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
if (scm_is_string (name) || scm_is_symbol (name)) if (scm_is_string (name) || scm_is_symbol (name))
scm_display (name, port); scm_display (name, port);
else else
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); scm_puts (SCM_PORT_TYPE (exp)->name, port);
scm_putc (' ', port); scm_putc (' ', port);
fdes = (SCM_FSTREAM (exp))->fdes; fdes = (SCM_FSTREAM (exp))->fdes;
@ -560,7 +560,7 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
} }
else else
{ {
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); scm_puts (SCM_PORT_TYPE (exp)->name, port);
scm_putc (' ', port); scm_putc (' ', port);
scm_uintprint ((scm_t_bits) SCM_PORT (exp), 16, port); scm_uintprint ((scm_t_bits) SCM_PORT (exp), 16, port);
} }
@ -650,21 +650,21 @@ fport_get_natural_buffer_sizes (SCM port, size_t *read_size, size_t *write_size)
#endif #endif
} }
static scm_t_bits static scm_t_port_type *
scm_make_fptob () scm_make_fptob ()
{ {
scm_t_bits tc = scm_make_port_type ("file", fport_read, fport_write); scm_t_port_type *ptob = scm_make_port_type ("file", fport_read, fport_write);
scm_set_port_print (tc, fport_print); scm_set_port_print (ptob, fport_print);
scm_set_port_needs_close_on_gc (tc, 1); scm_set_port_needs_close_on_gc (ptob, 1);
scm_set_port_close (tc, fport_close); scm_set_port_close (ptob, fport_close);
scm_set_port_seek (tc, fport_seek); scm_set_port_seek (ptob, fport_seek);
scm_set_port_truncate (tc, fport_truncate); scm_set_port_truncate (ptob, fport_truncate);
scm_set_port_input_waiting (tc, fport_input_waiting); scm_set_port_input_waiting (ptob, fport_input_waiting);
scm_set_port_random_access_p (tc, fport_random_access_p); scm_set_port_random_access_p (ptob, fport_random_access_p);
scm_set_port_get_natural_buffer_sizes (tc, fport_get_natural_buffer_sizes); scm_set_port_get_natural_buffer_sizes (ptob, fport_get_natural_buffer_sizes);
return tc; return ptob;
} }
/* We can't initialize the keywords from 'scm_init_fports', because /* We can't initialize the keywords from 'scm_init_fports', because
@ -685,7 +685,7 @@ scm_init_ice_9_fports (void)
void void
scm_init_fports () scm_init_fports ()
{ {
scm_tc16_fport = scm_make_fptob (); scm_file_port_type = scm_make_fptob ();
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_ice_9_fports", "scm_init_ice_9_fports",

5
libguile/fports.h
View file

@ -37,12 +37,13 @@ typedef struct scm_t_fport {
*/ */
} scm_t_fport; } scm_t_fport;
SCM_API scm_t_bits scm_tc16_fport; SCM_API scm_t_port_type *scm_file_port_type;
#define SCM_FSTREAM(x) ((scm_t_fport *) SCM_STREAM (x)) #define SCM_FSTREAM(x) ((scm_t_fport *) SCM_STREAM (x))
#define SCM_FPORT_FDES(x) (SCM_FSTREAM (x)->fdes) #define SCM_FPORT_FDES(x) (SCM_FSTREAM (x)->fdes)
#define SCM_FPORTP(x) (SCM_HAS_TYP16 (x, scm_tc16_fport)) #define SCM_FPORTP(x) \
(SCM_PORTP (x) && SCM_PORT_TYPE (x) == scm_file_port_type)
#define SCM_OPFPORTP(x) (SCM_FPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_OPN)) #define SCM_OPFPORTP(x) (SCM_FPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_OPN))
#define SCM_OPINFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_RDNG)) #define SCM_OPINFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_RDNG))
#define SCM_OPOUTFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_WRTNG)) #define SCM_OPOUTFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_WRTNG))

84
libguile/goops.c
View file

@ -51,11 +51,6 @@
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/goops.h" #include "libguile/goops.h"
/* Port classes */
#define SCM_IN_PCLASS_INDEX 0
#define SCM_OUT_PCLASS_INDEX SCM_I_MAX_PORT_TYPE_COUNT
#define SCM_INOUT_PCLASS_INDEX (2 * SCM_I_MAX_PORT_TYPE_COUNT)
/* Objects have identity, so references to classes and instances are by /* Objects have identity, so references to classes and instances are by
value, not by reference. Redefinition of a class or modification of value, not by reference. Redefinition of a class or modification of
an instance causes in-place update; you can think of GOOPS as an instance causes in-place update; you can think of GOOPS as
@ -138,11 +133,6 @@ static SCM class_bitvector;
static SCM vtable_class_map = SCM_BOOL_F; static SCM vtable_class_map = SCM_BOOL_F;
/* Port classes. Allocate 3 times the maximum number of port types so that
input ports, output ports, and in/out ports can be stored at different
offsets. See `SCM_IN_PCLASS_INDEX' et al. */
SCM scm_i_port_class[3 * SCM_I_MAX_PORT_TYPE_COUNT];
/* SMOB classes. */ /* SMOB classes. */
SCM scm_i_smob_class[SCM_I_MAX_SMOB_TYPE_COUNT]; SCM scm_i_smob_class[SCM_I_MAX_SMOB_TYPE_COUNT];
@ -277,11 +267,16 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
/* fall through to ports */ /* fall through to ports */
} }
case scm_tc7_port: case scm_tc7_port:
return scm_i_port_class[(SCM_WRTNG & SCM_CELL_WORD_0 (x) {
? (SCM_RDNG & SCM_CELL_WORD_0 (x) scm_t_port_type *ptob = SCM_PORT_TYPE (x);
? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x) if (SCM_INPUT_PORT_P (x))
: SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x)) {
: SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))]; if (SCM_OUTPUT_PORT_P (x))
return ptob->input_output_class;
return ptob->input_class;
}
return ptob->output_class;
}
case scm_tcs_struct: case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID) if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
/* A GOOPS object with a valid class. */ /* A GOOPS object with a valid class. */
@ -759,40 +754,67 @@ create_smob_classes (void)
scm_smobs[i].apply != 0); scm_smobs[i].apply != 0);
} }
void struct pre_goops_port_type
scm_make_port_classes (long ptobnum, char *type_name) {
scm_t_port_type *ptob;
struct pre_goops_port_type *prev;
};
struct pre_goops_port_type *pre_goops_port_types;
static void
make_port_classes (scm_t_port_type *ptob)
{ {
SCM name, meta, super, supers; SCM name, meta, super, supers;
meta = class_class; meta = class_class;
name = make_class_name ("<", type_name, "-port>"); name = make_class_name ("<", ptob->name, "-port>");
supers = scm_list_1 (class_port); supers = scm_list_1 (class_port);
super = scm_make_standard_class (meta, name, supers, SCM_EOL); super = scm_make_standard_class (meta, name, supers, SCM_EOL);
name = make_class_name ("<", type_name, "-input-port>"); name = make_class_name ("<", ptob->name, "-input-port>");
supers = scm_list_2 (super, class_input_port); supers = scm_list_2 (super, class_input_port);
scm_i_port_class[SCM_IN_PCLASS_INDEX + ptobnum] ptob->input_class = scm_make_standard_class (meta, name, supers, SCM_EOL);
= scm_make_standard_class (meta, name, supers, SCM_EOL);
name = make_class_name ("<", type_name, "-output-port>"); name = make_class_name ("<", ptob->name, "-output-port>");
supers = scm_list_2 (super, class_output_port); supers = scm_list_2 (super, class_output_port);
scm_i_port_class[SCM_OUT_PCLASS_INDEX + ptobnum] ptob->output_class = scm_make_standard_class (meta, name, supers, SCM_EOL);
= scm_make_standard_class (meta, name, supers, SCM_EOL);
name = make_class_name ("<", type_name, "-input-output-port>"); name = make_class_name ("<", ptob->name, "-input-output-port>");
supers = scm_list_2 (super, class_input_output_port); supers = scm_list_2 (super, class_input_output_port);
scm_i_port_class[SCM_INOUT_PCLASS_INDEX + ptobnum] ptob->input_output_class =
= scm_make_standard_class (meta, name, supers, SCM_EOL); scm_make_standard_class (meta, name, supers, SCM_EOL);
}
void
scm_make_port_classes (scm_t_port_type *ptob)
{
ptob->input_class = SCM_BOOL_F;
ptob->output_class = SCM_BOOL_F;
ptob->input_output_class = SCM_BOOL_F;
if (!goops_loaded_p)
{
/* Not really a pair. */
struct pre_goops_port_type *link;
link = scm_gc_typed_calloc (struct pre_goops_port_type);
link->ptob = ptob;
link->prev = pre_goops_port_types;
pre_goops_port_types = link;
return;
}
make_port_classes (ptob);
} }
static void static void
create_port_classes (void) create_port_classes (void)
{ {
long i; while (pre_goops_port_types)
{
for (i = scm_c_num_port_types () - 1; i >= 0; i--) make_port_classes (pre_goops_port_types->ptob);
scm_make_port_classes (i, SCM_PTOBNAME (i)); pre_goops_port_types = pre_goops_port_types->prev;
}
} }
SCM SCM

3
libguile/goops.h
View file

@ -82,7 +82,6 @@
#define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d) #define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
SCM_INTERNAL SCM scm_i_port_class[];
SCM_INTERNAL SCM scm_i_smob_class[]; SCM_INTERNAL SCM scm_i_smob_class[];
SCM_API SCM scm_module_goops; SCM_API SCM scm_module_goops;
@ -90,7 +89,7 @@ SCM_API SCM scm_module_goops;
SCM_API SCM scm_goops_version (void); SCM_API SCM scm_goops_version (void);
SCM_API void scm_load_goops (void); SCM_API void scm_load_goops (void);
SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep); SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep);
SCM_API void scm_make_port_classes (long ptobnum, char *type_name); SCM_INTERNAL void scm_make_port_classes (scm_t_port_type *ptob);
SCM_API SCM scm_ensure_accessor (SCM name); SCM_API SCM scm_ensure_accessor (SCM name);
SCM_API SCM scm_class_of (SCM obj); SCM_API SCM scm_class_of (SCM obj);

12
libguile/ports-internal.h
View file

@ -34,7 +34,7 @@ typedef enum scm_t_port_type_flags {
} scm_t_port_type_flags; } scm_t_port_type_flags;
/* port-type description. */ /* port-type description. */
struct scm_t_ptob_descriptor struct scm_t_port_type
{ {
char *name; char *name;
int (*print) (SCM exp, SCM port, scm_print_state *pstate); int (*print) (SCM exp, SCM port, scm_print_state *pstate);
@ -56,6 +56,9 @@ struct scm_t_ptob_descriptor
void (*truncate) (SCM port, scm_t_off length); void (*truncate) (SCM port, scm_t_off length);
unsigned flags; unsigned flags;
/* GOOPS tomfoolery. */
SCM input_class, output_class, input_output_class;
}; };
/* Port buffers. /* Port buffers.
@ -280,7 +283,7 @@ struct scm_iconv_descriptors
typedef struct scm_iconv_descriptors scm_t_iconv_descriptors; typedef struct scm_iconv_descriptors scm_t_iconv_descriptors;
struct scm_port struct scm_t_port
{ {
/* Source location information. */ /* Source location information. */
SCM file_name; SCM file_name;
@ -315,11 +318,6 @@ struct scm_port
SCM alist; SCM alist;
}; };
typedef struct scm_port scm_t_port;
#define SCM_PORT(x) ((scm_t_port *) SCM_CELL_WORD_2 (x))
#define SCM_PORT_DESCRIPTOR(port) ((scm_t_ptob_descriptor *) SCM_CELL_WORD_3 (port))
#define SCM_UNICODE_BOM 0xFEFFUL /* Unicode byte-order mark */ #define SCM_UNICODE_BOM 0xFEFFUL /* Unicode byte-order mark */
#define SCM_FILENAME(x) (SCM_PORT (x)->file_name) #define SCM_FILENAME(x) (SCM_PORT (x)->file_name)

210
libguile/ports.c
View file

@ -110,88 +110,6 @@ static SCM sym_escape;
/* The port kind table --- a dynamically resized array of port types. */
/* scm_ptobs scm_numptob
* implement a dynamically resized array of ptob records.
* Indexes into this table are used when generating type
* tags for smobjects (if you know a tag you can get an index and conversely).
*/
static scm_t_ptob_descriptor **scm_ptobs = NULL;
static long scm_numptob = 0; /* Number of port types. */
static long scm_ptobs_size = 0; /* Number of slots in the port type
table. */
static scm_i_pthread_mutex_t scm_ptobs_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
long
scm_c_num_port_types (void)
{
long ret;
scm_i_pthread_mutex_lock (&scm_ptobs_lock);
ret = scm_numptob;
scm_i_pthread_mutex_unlock (&scm_ptobs_lock);
return ret;
}
scm_t_ptob_descriptor*
scm_c_port_type_ref (long ptobnum)
{
scm_t_ptob_descriptor *ret = NULL;
scm_i_pthread_mutex_lock (&scm_ptobs_lock);
if (0 <= ptobnum && ptobnum < scm_numptob)
ret = scm_ptobs[ptobnum];
scm_i_pthread_mutex_unlock (&scm_ptobs_lock);
if (!ret)
scm_out_of_range ("scm_c_port_type_ref", scm_from_long (ptobnum));
return ret;
}
long
scm_c_port_type_add_x (scm_t_ptob_descriptor *desc)
{
long ret = -1;
scm_i_pthread_mutex_lock (&scm_ptobs_lock);
if (scm_numptob + 1 < SCM_I_MAX_PORT_TYPE_COUNT)
{
if (scm_numptob == scm_ptobs_size)
{
unsigned long old_size = scm_ptobs_size;
scm_t_ptob_descriptor **old_ptobs = scm_ptobs;
/* Currently there are only 9 predefined port types, so one
resize will cover it. */
scm_ptobs_size = old_size + 10;
if (scm_ptobs_size >= SCM_I_MAX_PORT_TYPE_COUNT)
scm_ptobs_size = SCM_I_MAX_PORT_TYPE_COUNT;
scm_ptobs = scm_gc_malloc (sizeof (*scm_ptobs) * scm_ptobs_size,
"scm_ptobs");
memcpy (scm_ptobs, old_ptobs, sizeof (*scm_ptobs) * scm_numptob);
}
ret = scm_numptob++;
scm_ptobs[ret] = desc;
}
scm_i_pthread_mutex_unlock (&scm_ptobs_lock);
if (ret < 0)
scm_out_of_range ("scm_c_port_type_add_x", scm_from_long (scm_numptob));
return ret;
}
static SCM trampoline_to_c_read_subr; static SCM trampoline_to_c_read_subr;
static SCM trampoline_to_c_write_subr; static SCM trampoline_to_c_write_subr;
@ -199,18 +117,17 @@ static SCM trampoline_to_c_write_subr;
static int static int
default_random_access_p (SCM port) default_random_access_p (SCM port)
{ {
return SCM_PORT_DESCRIPTOR (port)->seek != NULL; return SCM_PORT_TYPE (port)->seek != NULL;
} }
scm_t_bits scm_t_port_type *
scm_make_port_type (char *name, scm_make_port_type (char *name,
size_t (*read) (SCM port, SCM dst, size_t start, size_t (*read) (SCM port, SCM dst, size_t start,
size_t count), size_t count),
size_t (*write) (SCM port, SCM src, size_t start, size_t (*write) (SCM port, SCM src, size_t start,
size_t count)) size_t count))
{ {
scm_t_ptob_descriptor *desc; scm_t_port_type *desc;
long ptobnum;
desc = scm_gc_malloc_pointerless (sizeof (*desc), "port-type"); desc = scm_gc_malloc_pointerless (sizeof (*desc), "port-type");
memset (desc, 0, sizeof (*desc)); memset (desc, 0, sizeof (*desc));
@ -222,14 +139,9 @@ scm_make_port_type (char *name,
desc->scm_read = read ? trampoline_to_c_read_subr : SCM_BOOL_F; desc->scm_read = read ? trampoline_to_c_read_subr : SCM_BOOL_F;
desc->scm_write = write ? trampoline_to_c_write_subr : SCM_BOOL_F; desc->scm_write = write ? trampoline_to_c_write_subr : SCM_BOOL_F;
desc->random_access_p = default_random_access_p; desc->random_access_p = default_random_access_p;
scm_make_port_classes (desc);
ptobnum = scm_c_port_type_add_x (desc); return desc;
/* Make a class object if GOOPS is present. */
if (SCM_UNPACK (scm_i_port_class[0]) != 0)
scm_make_port_classes (ptobnum, name);
return scm_tc7_port + ptobnum * 256;
} }
static SCM static SCM
@ -245,7 +157,7 @@ trampoline_to_c_read (SCM port, SCM dst, SCM start, SCM count)
SCM_ASSERT_RANGE (3, count, c_start+c_count <= scm_c_bytevector_length (dst)); SCM_ASSERT_RANGE (3, count, c_start+c_count <= scm_c_bytevector_length (dst));
return scm_from_size_t return scm_from_size_t
(SCM_PORT_DESCRIPTOR (port)->c_read (port, dst, c_start, c_count)); (SCM_PORT_TYPE (port)->c_read (port, dst, c_start, c_count));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -253,7 +165,7 @@ static size_t
trampoline_to_scm_read (SCM port, SCM dst, size_t start, size_t count) trampoline_to_scm_read (SCM port, SCM dst, size_t start, size_t count)
{ {
return scm_to_size_t return scm_to_size_t
(scm_call_4 (SCM_PORT_DESCRIPTOR (port)->scm_read, port, dst, (scm_call_4 (SCM_PORT_TYPE (port)->scm_read, port, dst,
scm_from_size_t (start), scm_from_size_t (count))); scm_from_size_t (start), scm_from_size_t (count)));
} }
@ -270,7 +182,7 @@ trampoline_to_c_write (SCM port, SCM src, SCM start, SCM count)
SCM_ASSERT_RANGE (3, count, c_start+c_count <= scm_c_bytevector_length (src)); SCM_ASSERT_RANGE (3, count, c_start+c_count <= scm_c_bytevector_length (src));
return scm_from_size_t return scm_from_size_t
(SCM_PORT_DESCRIPTOR (port)->c_write (port, src, c_start, c_count)); (SCM_PORT_TYPE (port)->c_write (port, src, c_start, c_count));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -278,44 +190,40 @@ static size_t
trampoline_to_scm_write (SCM port, SCM src, size_t start, size_t count) trampoline_to_scm_write (SCM port, SCM src, size_t start, size_t count)
{ {
return scm_to_size_t return scm_to_size_t
(scm_call_4 (SCM_PORT_DESCRIPTOR (port)->scm_write, port, src, (scm_call_4 (SCM_PORT_TYPE (port)->scm_write, port, src,
scm_from_size_t (start), scm_from_size_t (count))); scm_from_size_t (start), scm_from_size_t (count)));
} }
void void
scm_set_port_scm_read (scm_t_bits tc, SCM read) scm_set_port_scm_read (scm_t_port_type *ptob, SCM read)
{ {
scm_t_ptob_descriptor *desc = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc)); ptob->scm_read = read;
desc->scm_read = read; ptob->c_read = trampoline_to_scm_read;
desc->c_read = trampoline_to_scm_read;
} }
void void
scm_set_port_scm_write (scm_t_bits tc, SCM write) scm_set_port_scm_write (scm_t_port_type *ptob, SCM write)
{ {
scm_t_ptob_descriptor *desc = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc)); ptob->scm_write = write;
desc->scm_write = write; ptob->c_write = trampoline_to_scm_write;
desc->c_write = trampoline_to_scm_write;
} }
void void
scm_set_port_print (scm_t_bits tc, int (*print) (SCM exp, SCM port, scm_set_port_print (scm_t_port_type *ptob,
scm_print_state *pstate)) int (*print) (SCM exp, SCM port, scm_print_state *pstate))
{ {
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->print = print; ptob->print = print;
} }
void void
scm_set_port_close (scm_t_bits tc, void (*close) (SCM)) scm_set_port_close (scm_t_port_type *ptob, void (*close) (SCM))
{ {
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->close = close; ptob->close = close;
} }
void void
scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p) scm_set_port_needs_close_on_gc (scm_t_port_type *ptob, int needs_close_p)
{ {
scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
if (needs_close_p) if (needs_close_p)
ptob->flags |= SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC; ptob->flags |= SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC;
else else
@ -323,35 +231,36 @@ scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p)
} }
void void
scm_set_port_seek (scm_t_bits tc, scm_t_off (*seek) (SCM, scm_t_off, int)) scm_set_port_seek (scm_t_port_type *ptob,
scm_t_off (*seek) (SCM, scm_t_off, int))
{ {
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->seek = seek; ptob->seek = seek;
} }
void void
scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM, scm_t_off)) scm_set_port_truncate (scm_t_port_type *ptob, void (*truncate) (SCM, scm_t_off))
{ {
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->truncate = truncate; ptob->truncate = truncate;
} }
void void
scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM)) scm_set_port_input_waiting (scm_t_port_type *ptob, int (*input_waiting) (SCM))
{ {
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->input_waiting = input_waiting; ptob->input_waiting = input_waiting;
} }
void void
scm_set_port_random_access_p (scm_t_bits tc, int (*random_access_p) (SCM)) scm_set_port_random_access_p (scm_t_port_type *ptob,
int (*random_access_p) (SCM))
{ {
scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
ptob->random_access_p = random_access_p; ptob->random_access_p = random_access_p;
} }
void void
scm_set_port_get_natural_buffer_sizes scm_set_port_get_natural_buffer_sizes
(scm_t_bits tc, void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *)) (scm_t_port_type *ptob,
void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *))
{ {
scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
ptob->get_natural_buffer_sizes = get_natural_buffer_sizes; ptob->get_natural_buffer_sizes = get_natural_buffer_sizes;
} }
@ -684,7 +593,7 @@ static void
initialize_port_buffers (SCM port) initialize_port_buffers (SCM port)
{ {
scm_t_port *pt = SCM_PORT (port); scm_t_port *pt = SCM_PORT (port);
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port); scm_t_port_type *ptob = SCM_PORT_TYPE (port);
size_t read_buf_size, write_buf_size; size_t read_buf_size, write_buf_size;
if (SCM_CELL_WORD_0 (port) & SCM_BUF0) if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
@ -711,18 +620,16 @@ initialize_port_buffers (SCM port)
} }
SCM SCM
scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits, scm_c_make_port_with_encoding (scm_t_port_type *ptob, unsigned long mode_bits,
SCM encoding, SCM conversion_strategy, SCM encoding, SCM conversion_strategy,
scm_t_bits stream) scm_t_bits stream)
{ {
SCM ret; SCM ret;
scm_t_port *pt; scm_t_port *pt;
scm_t_ptob_descriptor *ptob;
pt = scm_gc_typed_calloc (scm_t_port); pt = scm_gc_typed_calloc (scm_t_port);
ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tag));
ret = scm_words (tag | mode_bits, 4); ret = scm_words (scm_tc7_port | mode_bits, 4);
SCM_SET_CELL_WORD_1 (ret, stream); SCM_SET_CELL_WORD_1 (ret, stream);
SCM_SET_CELL_WORD_2 (ret, (scm_t_bits) pt); SCM_SET_CELL_WORD_2 (ret, (scm_t_bits) pt);
SCM_SET_CELL_WORD_3 (ret, (scm_t_bits) ptob); SCM_SET_CELL_WORD_3 (ret, (scm_t_bits) ptob);
@ -737,7 +644,7 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
pt->alist = SCM_EOL; pt->alist = SCM_EOL;
if (SCM_PORT_DESCRIPTOR (ret)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC) if (SCM_PORT_TYPE (ret)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
{ {
scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL); scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
scm_weak_set_add_x (scm_i_port_weak_set, ret); scm_weak_set_add_x (scm_i_port_weak_set, ret);
@ -751,20 +658,15 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
} }
SCM SCM
scm_c_make_port (scm_t_bits tag, unsigned long mode_bits, scm_t_bits stream) scm_c_make_port (scm_t_port_type *ptob,
unsigned long mode_bits, scm_t_bits stream)
{ {
return scm_c_make_port_with_encoding (tag, mode_bits, return scm_c_make_port_with_encoding (ptob, mode_bits,
scm_i_default_port_encoding (), scm_i_default_port_encoding (),
scm_i_default_port_conversion_strategy (), scm_i_default_port_conversion_strategy (),
stream); stream);
} }
SCM
scm_new_port_table_entry (scm_t_bits tag)
{
return scm_c_make_port (tag, 0, 0);
}
/* Predicates. */ /* Predicates. */
@ -860,13 +762,13 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
pt = SCM_PORT (port); pt = SCM_PORT (port);
SCM_CLR_PORT_OPEN_FLAG (port); SCM_CLR_PORT_OPEN_FLAG (port);
if (SCM_PORT_DESCRIPTOR (port)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC) if (SCM_PORT_TYPE (port)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
scm_weak_set_remove_x (scm_i_port_weak_set, port); scm_weak_set_remove_x (scm_i_port_weak_set, port);
if (SCM_PORT_DESCRIPTOR (port)->close) if (SCM_PORT_TYPE (port)->close)
/* Note! This may throw an exception. Anything after this point /* Note! This may throw an exception. Anything after this point
should be resilient to non-local exits. */ should be resilient to non-local exits. */
SCM_PORT_DESCRIPTOR (port)->close (port); SCM_PORT_TYPE (port)->close (port);
if (pt->iconv_descriptors) if (pt->iconv_descriptors)
{ {
@ -1418,7 +1320,7 @@ static size_t
scm_i_read_bytes (SCM port, SCM dst, size_t start, size_t count) scm_i_read_bytes (SCM port, SCM dst, size_t start, size_t count)
{ {
size_t filled; size_t filled;
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port); scm_t_port_type *ptob = SCM_PORT_TYPE (port);
assert (count <= SCM_BYTEVECTOR_LENGTH (dst)); assert (count <= SCM_BYTEVECTOR_LENGTH (dst));
assert (start + count <= SCM_BYTEVECTOR_LENGTH (dst)); assert (start + count <= SCM_BYTEVECTOR_LENGTH (dst));
@ -2107,7 +2009,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
{ {
long csize; long csize;
scm_t_port *pt; scm_t_port *pt;
scm_t_ptob_descriptor *ptob; scm_t_port_type *ptob;
scm_t_bits tag_word; scm_t_bits tag_word;
size_t read_buf_size, write_buf_size; size_t read_buf_size, write_buf_size;
SCM saved_read_buf; SCM saved_read_buf;
@ -2116,7 +2018,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
SCM_VALIDATE_OPENPORT (1, port); SCM_VALIDATE_OPENPORT (1, port);
pt = SCM_PORT (port); pt = SCM_PORT (port);
ptob = SCM_PORT_DESCRIPTOR (port); ptob = SCM_PORT_TYPE (port);
tag_word = SCM_CELL_WORD_0 (port) & ~(SCM_BUF0 | SCM_BUFLINE); tag_word = SCM_CELL_WORD_0 (port) & ~(SCM_BUF0 | SCM_BUFLINE);
if (scm_is_eq (mode, sym_none)) if (scm_is_eq (mode, sym_none))
@ -2237,7 +2139,7 @@ scm_end_input (SCM port)
discarded = scm_port_buffer_take (buf, NULL, (size_t) -1); discarded = scm_port_buffer_take (buf, NULL, (size_t) -1);
if (discarded != 0) if (discarded != 0)
SCM_PORT_DESCRIPTOR (port)->seek (port, -discarded, SEEK_CUR); SCM_PORT_TYPE (port)->seek (port, -discarded, SEEK_CUR);
} }
SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0, SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
@ -2538,7 +2440,7 @@ SCM_DEFINE (scm_port_read, "port-read", 1, 0, 0, (SCM port),
#define FUNC_NAME s_scm_port_read #define FUNC_NAME s_scm_port_read
{ {
SCM_VALIDATE_OPINPORT (1, port); SCM_VALIDATE_OPINPORT (1, port);
return SCM_PORT_DESCRIPTOR (port)->scm_read; return SCM_PORT_TYPE (port)->scm_read;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -2548,7 +2450,7 @@ SCM_DEFINE (scm_port_write, "port-write", 1, 0, 0,
#define FUNC_NAME s_scm_port_write #define FUNC_NAME s_scm_port_write
{ {
SCM_VALIDATE_OPOUTPORT (1, port); SCM_VALIDATE_OPOUTPORT (1, port);
return SCM_PORT_DESCRIPTOR (port)->scm_write; return SCM_PORT_TYPE (port)->scm_write;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -2595,7 +2497,7 @@ static void
scm_i_write_bytes (SCM port, SCM src, size_t start, size_t count) scm_i_write_bytes (SCM port, SCM src, size_t start, size_t count)
{ {
size_t written = 0; size_t written = 0;
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port); scm_t_port_type *ptob = SCM_PORT_TYPE (port);
assert (count <= SCM_BYTEVECTOR_LENGTH (src)); assert (count <= SCM_BYTEVECTOR_LENGTH (src));
assert (start + count <= SCM_BYTEVECTOR_LENGTH (src)); assert (start + count <= SCM_BYTEVECTOR_LENGTH (src));
@ -2787,7 +2689,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
return SCM_BOOL_T; return SCM_BOOL_T;
else else
{ {
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port); scm_t_port_type *ptob = SCM_PORT_TYPE (port);
if (ptob->input_waiting) if (ptob->input_waiting)
return scm_from_bool (ptob->input_waiting (port)); return scm_from_bool (ptob->input_waiting (port));
@ -2835,7 +2737,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
if (SCM_OPPORTP (fd_port)) if (SCM_OPPORTP (fd_port))
{ {
scm_t_port *pt = SCM_PORT (fd_port); scm_t_port *pt = SCM_PORT (fd_port);
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (fd_port); scm_t_port_type *ptob = SCM_PORT_TYPE (fd_port);
off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset); off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
off_t_or_off64_t rv; off_t_or_off64_t rv;
@ -2943,7 +2845,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
else if (SCM_OPOUTPORTP (object)) else if (SCM_OPOUTPORTP (object))
{ {
off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length); off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length);
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (object); scm_t_port_type *ptob = SCM_PORT_TYPE (object);
if (!ptob->truncate) if (!ptob->truncate)
SCM_MISC_ERROR ("port is not truncatable", SCM_EOL); SCM_MISC_ERROR ("port is not truncatable", SCM_EOL);
@ -3085,7 +2987,7 @@ scm_print_port_mode (SCM exp, SCM port)
int int
scm_port_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_port_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp)); char *type = SCM_PORT_TYPE (port)->name;
if (!type) if (!type)
type = "port"; type = "port";
scm_puts ("#<", port); scm_puts ("#<", port);
@ -3177,7 +3079,7 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
/* Void ports. */ /* Void ports. */
scm_t_bits scm_tc16_void_port = 0; scm_t_port_type *scm_void_port_type = 0;
static size_t static size_t
void_port_read (SCM port, SCM dst, size_t start, size_t count) void_port_read (SCM port, SCM dst, size_t start, size_t count)
@ -3194,7 +3096,7 @@ void_port_write (SCM port, SCM src, size_t start, size_t count)
static SCM static SCM
scm_i_void_port (long mode_bits) scm_i_void_port (long mode_bits)
{ {
return scm_c_make_port (scm_tc16_void_port, mode_bits, 0); return scm_c_make_port (scm_void_port_type, mode_bits, 0);
} }
SCM SCM
@ -3261,7 +3163,7 @@ scm_init_ports (void)
scm_c_make_gsubr ("port-write", 4, 0, 0, scm_c_make_gsubr ("port-write", 4, 0, 0,
(scm_t_subr) trampoline_to_c_write); (scm_t_subr) trampoline_to_c_write);
scm_tc16_void_port = scm_make_port_type ("void", void_port_read, scm_void_port_type = scm_make_port_type ("void", void_port_read,
void_port_write); void_port_write);
scm_i_port_weak_set = scm_c_make_weak_set (31); scm_i_port_weak_set = scm_c_make_weak_set (31);

46
libguile/ports.h
View file

@ -70,48 +70,47 @@ SCM_INTERNAL SCM scm_i_port_weak_set;
#define SCM_CLR_PORT_OPEN_FLAG(p) \ #define SCM_CLR_PORT_OPEN_FLAG(p) \
SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN) SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN)
typedef struct scm_t_port_type scm_t_port_type;
typedef struct scm_t_port scm_t_port;
#define SCM_STREAM(port) (SCM_CELL_WORD_1 (port)) #define SCM_STREAM(port) (SCM_CELL_WORD_1 (port))
#define SCM_SETSTREAM(port, stream) (SCM_SET_CELL_WORD_1 (port, stream)) #define SCM_SETSTREAM(port, stream) (SCM_SET_CELL_WORD_1 (port, stream))
#define SCM_PORT(x) ((scm_t_port *) SCM_CELL_WORD_2 (x))
#define SCM_PORT_TYPE(port) ((scm_t_port_type *) SCM_CELL_WORD_3 (port))
/* Maximum number of port types. */ /* Maximum number of port types. */
#define SCM_I_MAX_PORT_TYPE_COUNT 256 #define SCM_I_MAX_PORT_TYPE_COUNT 256
typedef struct scm_t_ptob_descriptor scm_t_ptob_descriptor;
#define SCM_TC2PTOBNUM(x) (0x0ff & ((x) >> 8))
#define SCM_PTOBNUM(x) (SCM_TC2PTOBNUM (SCM_CELL_TYPE (x)))
/* SCM_PTOBNAME can be 0 if name is missing */
#define SCM_PTOBNAME(ptobnum) (scm_c_port_type_ref (ptobnum)->name)
/* Port types, and their vtables. */ /* Port types, and their vtables. */
SCM_INTERNAL long scm_c_num_port_types (void); SCM_API scm_t_port_type *scm_make_port_type
SCM_API scm_t_ptob_descriptor* scm_c_port_type_ref (long ptobnum);
SCM_API long scm_c_port_type_add_x (scm_t_ptob_descriptor *desc);
SCM_API scm_t_bits scm_make_port_type
(char *name, (char *name,
size_t (*read) (SCM port, SCM dst, size_t start, size_t count), size_t (*read) (SCM port, SCM dst, size_t start, size_t count),
size_t (*write) (SCM port, SCM src, size_t start, size_t count)); size_t (*write) (SCM port, SCM src, size_t start, size_t count));
SCM_API void scm_set_port_scm_read (scm_t_bits tc, SCM read); SCM_API void scm_set_port_scm_read (scm_t_port_type *ptob, SCM read);
SCM_API void scm_set_port_scm_write (scm_t_bits tc, SCM write); SCM_API void scm_set_port_scm_write (scm_t_port_type *ptob, SCM write);
SCM_API void scm_set_port_print (scm_t_bits tc, SCM_API void scm_set_port_print (scm_t_port_type *ptob,
int (*print) (SCM exp, int (*print) (SCM exp,
SCM port, SCM port,
scm_print_state *pstate)); scm_print_state *pstate));
SCM_API void scm_set_port_close (scm_t_bits tc, void (*close) (SCM)); SCM_API void scm_set_port_close (scm_t_port_type *ptob, void (*close) (SCM));
SCM_API void scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p); SCM_API void scm_set_port_needs_close_on_gc (scm_t_port_type *ptob,
SCM_API void scm_set_port_seek (scm_t_bits tc, int needs_close_p);
SCM_API void scm_set_port_seek (scm_t_port_type *ptob,
scm_t_off (*seek) (SCM port, scm_t_off (*seek) (SCM port,
scm_t_off OFFSET, scm_t_off OFFSET,
int WHENCE)); int WHENCE));
SCM_API void scm_set_port_truncate (scm_t_bits tc, SCM_API void scm_set_port_truncate (scm_t_port_type *ptob,
void (*truncate) (SCM port, void (*truncate) (SCM port,
scm_t_off length)); scm_t_off length));
SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM)); SCM_API void scm_set_port_input_waiting (scm_t_port_type *ptob,
int (*input_waiting) (SCM));
SCM_API void scm_set_port_get_natural_buffer_sizes SCM_API void scm_set_port_get_natural_buffer_sizes
(scm_t_bits tc, void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *)); (scm_t_port_type *ptob,
SCM_API void scm_set_port_random_access_p (scm_t_bits tc, void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *));
SCM_API void scm_set_port_random_access_p (scm_t_port_type *ptob,
int (*random_access_p) (SCM port)); int (*random_access_p) (SCM port));
/* The input, output, error, and load ports. */ /* The input, output, error, and load ports. */
@ -138,14 +137,13 @@ SCM_API long scm_mode_bits (char *modes);
SCM_API SCM scm_port_mode (SCM port); SCM_API SCM scm_port_mode (SCM port);
/* Low-level constructors. */ /* Low-level constructors. */
SCM_API SCM scm_c_make_port_with_encoding (scm_t_bits tag, SCM_API SCM scm_c_make_port_with_encoding (scm_t_port_type *ptob,
unsigned long mode_bits, unsigned long mode_bits,
SCM encoding, SCM encoding,
SCM conversion_strategy, SCM conversion_strategy,
scm_t_bits stream); scm_t_bits stream);
SCM_API SCM scm_c_make_port (scm_t_bits tag, unsigned long mode_bits, SCM_API SCM scm_c_make_port (scm_t_port_type *ptob, unsigned long mode_bits,
scm_t_bits stream); scm_t_bits stream);
SCM_API SCM scm_new_port_table_entry (scm_t_bits tag);
/* Predicates. */ /* Predicates. */
SCM_API SCM scm_port_p (SCM x); SCM_API SCM scm_port_p (SCM x);

4
libguile/print.c
View file

@ -815,7 +815,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
break; break;
case scm_tc7_port: case scm_tc7_port:
{ {
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (exp); scm_t_port_type *ptob = SCM_PORT_TYPE (exp);
if (ptob->print && ptob->print (exp, port, pstate)) if (ptob->print && ptob->print (exp, port, pstate))
break; break;
goto punk; goto punk;
@ -1691,7 +1691,7 @@ static int
port_with_ps_print (SCM obj, SCM port, scm_print_state *pstate) port_with_ps_print (SCM obj, SCM port, scm_print_state *pstate)
{ {
obj = SCM_PORT_WITH_PS_PORT (obj); obj = SCM_PORT_WITH_PS_PORT (obj);
return SCM_PORT_DESCRIPTOR (obj)->print (obj, port, pstate); return SCM_PORT_TYPE (obj)->print (obj, port, pstate);
} }
SCM SCM

10
libguile/r6rs-ports.c
View file

@ -82,7 +82,7 @@ SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
#endif #endif
/* Bytevector input ports. */ /* Bytevector input ports. */
static scm_t_bits bytevector_input_port_type = 0; static scm_t_port_type *bytevector_input_port_type = 0;
struct bytevector_input_port { struct bytevector_input_port {
SCM bytevector; SCM bytevector;
@ -259,7 +259,7 @@ custom_binary_port_close (SCM port)
/* Custom binary input ports. */ /* Custom binary input ports. */
static scm_t_bits custom_binary_input_port_type = 0; static scm_t_port_type *custom_binary_input_port_type = 0;
static inline SCM static inline SCM
make_custom_binary_input_port (SCM read_proc, SCM get_position_proc, make_custom_binary_input_port (SCM read_proc, SCM get_position_proc,
@ -668,7 +668,7 @@ SCM_DEFINE (scm_unget_bytevector, "unget-bytevector", 2, 2, 0,
XXX: Access to a bytevector output port's internal buffer is not XXX: Access to a bytevector output port's internal buffer is not
thread-safe. */ thread-safe. */
static scm_t_bits bytevector_output_port_type = 0; static scm_t_port_type *bytevector_output_port_type = 0;
SCM_SMOB (bytevector_output_port_procedure, SCM_SMOB (bytevector_output_port_procedure,
"r6rs-bytevector-output-port-procedure", "r6rs-bytevector-output-port-procedure",
@ -860,7 +860,7 @@ initialize_bytevector_output_ports (void)
/* Custom binary output ports. */ /* Custom binary output ports. */
static scm_t_bits custom_binary_output_port_type; static scm_t_port_type *custom_binary_output_port_type;
static inline SCM static inline SCM
@ -950,7 +950,7 @@ initialize_custom_binary_output_ports (void)
/* Transcoded ports. */ /* Transcoded ports. */
static scm_t_bits transcoded_port_type = 0; static scm_t_port_type *transcoded_port_type = 0;
#define SCM_TRANSCODED_PORT_BINARY_PORT(_port) SCM_PACK (SCM_STREAM (_port)) #define SCM_TRANSCODED_PORT_BINARY_PORT(_port) SCM_PACK (SCM_STREAM (_port))

18
libguile/strports.c
View file

@ -54,7 +54,7 @@
SCM_SYMBOL (sym_UTF_8, "UTF-8"); SCM_SYMBOL (sym_UTF_8, "UTF-8");
scm_t_bits scm_tc16_strport; scm_t_port_type *scm_string_port_type;
struct string_port { struct string_port {
SCM bytevector; SCM bytevector;
@ -181,7 +181,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
stream->len = len; stream->len = len;
return return
scm_c_make_port_with_encoding (scm_tc16_strport, modes, sym_UTF_8, scm_c_make_port_with_encoding (scm_string_port_type, modes, sym_UTF_8,
scm_i_default_port_conversion_strategy (), scm_i_default_port_conversion_strategy (),
(scm_t_bits) stream); (scm_t_bits) stream);
} }
@ -375,21 +375,21 @@ scm_eval_string (SCM string)
return scm_eval_string_in_module (string, SCM_UNDEFINED); return scm_eval_string_in_module (string, SCM_UNDEFINED);
} }
static scm_t_bits static scm_t_port_type *
scm_make_string_port_type () scm_make_string_port_type ()
{ {
scm_t_bits tc = scm_make_port_type ("string", scm_t_port_type *ptob = scm_make_port_type ("string",
string_port_read, string_port_read,
string_port_write); string_port_write);
scm_set_port_seek (tc, string_port_seek); scm_set_port_seek (ptob, string_port_seek);
return tc; return ptob;
} }
void void
scm_init_strports () scm_init_strports ()
{ {
scm_tc16_strport = scm_make_string_port_type (); scm_string_port_type = scm_make_string_port_type ();
#include "libguile/strports.x" #include "libguile/strports.x"
} }

5
libguile/strports.h
View file

@ -28,7 +28,8 @@
#define SCM_STRPORTP(x) (SCM_HAS_TYP16 (x, scm_tc16_strport)) #define SCM_STRPORTP(x) \
(SCM_PORTP (x) && SCM_PORT_TYPE (x) == scm_string_port_type)
#define SCM_OPSTRPORTP(x) (SCM_STRPORTP (x) && \ #define SCM_OPSTRPORTP(x) (SCM_STRPORTP (x) && \
(SCM_CELL_WORD_0 (x) & SCM_OPN)) (SCM_CELL_WORD_0 (x) & SCM_OPN))
#define SCM_OPINSTRPORTP(x) (SCM_OPSTRPORTP (x) && \ #define SCM_OPINSTRPORTP(x) (SCM_OPSTRPORTP (x) && \
@ -38,7 +39,7 @@
SCM_API scm_t_bits scm_tc16_strport; SCM_API scm_t_port_type *scm_string_port_type;

2
libguile/tags.h
View file

@ -434,8 +434,6 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define scm_tc7_unused_14 111 #define scm_tc7_unused_14 111
#define scm_tc7_unused_15 117 #define scm_tc7_unused_15 117
#define scm_tc7_unused_16 119 #define scm_tc7_unused_16 119
/* There are 256 port subtypes. */
#define scm_tc7_port 125 #define scm_tc7_port 125
/* There are 256 smob subtypes. [**] If you change scm_tc7_smob, you must /* There are 256 smob subtypes. [**] If you change scm_tc7_smob, you must

22
libguile/vports.c
View file

@ -50,7 +50,7 @@
*/ */
static scm_t_bits scm_tc16_soft_port; static scm_t_port_type *scm_soft_port_type;
#define ENCODE_BUF_SIZE 10 #define ENCODE_BUF_SIZE 10
@ -221,31 +221,31 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
stream->input_waiting = stream->input_waiting =
vlen == 6 ? SCM_SIMPLE_VECTOR_REF (pv, 5) : SCM_BOOL_F; vlen == 6 ? SCM_SIMPLE_VECTOR_REF (pv, 5) : SCM_BOOL_F;
return scm_c_make_port (scm_tc16_soft_port, scm_i_mode_bits (modes), return scm_c_make_port (scm_soft_port_type, scm_i_mode_bits (modes),
(scm_t_bits) stream); (scm_t_bits) stream);
} }
#undef FUNC_NAME #undef FUNC_NAME
static scm_t_bits static scm_t_port_type *
scm_make_sfptob () scm_make_sfptob ()
{ {
scm_t_bits tc = scm_make_port_type ("soft", soft_port_read, scm_t_port_type *ptob = scm_make_port_type ("soft", soft_port_read,
soft_port_write); soft_port_write);
scm_set_port_close (tc, soft_port_close); scm_set_port_close (ptob, soft_port_close);
scm_set_port_needs_close_on_gc (tc, 1); scm_set_port_needs_close_on_gc (ptob, 1);
scm_set_port_get_natural_buffer_sizes (tc, scm_set_port_get_natural_buffer_sizes (ptob,
soft_port_get_natural_buffer_sizes); soft_port_get_natural_buffer_sizes);
scm_set_port_input_waiting (tc, soft_port_input_waiting); scm_set_port_input_waiting (ptob, soft_port_input_waiting);
return tc; return ptob;
} }
void void
scm_init_vports () scm_init_vports ()
{ {
scm_tc16_soft_port = scm_make_sfptob (); scm_soft_port_type = scm_make_sfptob ();
#include "libguile/vports.x" #include "libguile/vports.x"
} }

4
test-suite/standalone/test-scm-c-read.c
View file

@ -43,7 +43,7 @@ struct custom_port
/* Return a new port of type PORT_TYPE. */ /* Return a new port of type PORT_TYPE. */
static inline SCM static inline SCM
make_port (scm_t_bits port_type) make_port (scm_t_port_type *port_type)
{ {
struct custom_port *stream = scm_gc_typed_calloc (struct custom_port); struct custom_port *stream = scm_gc_typed_calloc (struct custom_port);
@ -88,7 +88,7 @@ static void *
do_start (void *arg) do_start (void *arg)
{ {
SCM port; SCM port;
scm_t_bits port_type; scm_t_port_type *port_type;
char buffer[PORT_BUFFER_SIZE + (PORT_BUFFER_SIZE / 2)]; char buffer[PORT_BUFFER_SIZE + (PORT_BUFFER_SIZE / 2)];
size_t read, last_read; size_t read, last_read;