From f12733c9d43d6147d9e7bf09cf51225945a1a97c Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sat, 24 Jul 1999 23:10:13 +0000 Subject: [PATCH] * ports.c, ports.h (scm_make_port_type): New interface for creation of port types (replaces scm_newptob). Just as for the smobs, we need to separate the internal representation of smob types from the interface, so that we easily can add new fields and rearrange things without caring about backward compatibility. This change was forced by the need in GOOPS to create classes representing port types. (scm_set_ptob_mark, scm_set_ptob_free, scm_set_ptob_print, scm_set_ptob_equalp, scm_set_ptob_flush_input, scm_set_ptob_close, scm_set_ptob_seek, scm_set_ptob_truncate, scm_set_ptob_input_waiting_p): New setters. (scm_newptob): Rewritten to use scm_make_port_type. For backward compatibility. (scm_ptobs): Changed type scm_ptobfuns --> scm_ptob_descriptor. (scm_prinport): Removed. (scm_port_print): Added. (scm_print_port_mode): Added. (void_port_ptob, print_void_port, close_void_port, noop0): Removed. Removed #include "genio.h" Added #include "objects.h", #include "smobs.h" --- libguile/ports.c | 255 ++++++++++++++++++++++++++++------------------- libguile/ports.h | 40 ++++++-- 2 files changed, 185 insertions(+), 110 deletions(-) diff --git a/libguile/ports.c b/libguile/ports.c index 4e27a0c55..6f62a2047 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -43,12 +43,10 @@ #include #include "_scm.h" -#include "genio.h" +#include "objects.h" +#include "smob.h" #include "chars.h" -#include "fports.h" -#include "strports.h" -#include "vports.h" #include "keywords.h" #include "ports.h" @@ -74,7 +72,7 @@ * Indexes into this table are used when generating type * tags for smobjects (if you know a tag you can get an index and conversely). */ -scm_ptobfuns *scm_ptobs; +scm_ptob_descriptor *scm_ptobs; int scm_numptob; /* GC marker for a port with stream of SCM type. */ @@ -90,36 +88,126 @@ scm_markstream (ptr) return SCM_BOOL_F; } +/* + * This is how different port types currently use ptob fields. + * + * fports: free, flush, read_flush, close, + * fill_buffer, seek, truncate, input_waiting_p + * + * strports: mark, flush, read_flush, + * fill_buffer, seek, truncate + * + * softports: mark, flush, read_flush, close, + * fill_buffer + * + * voidports: (default values) + * + * We choose to use an interface similar to the smob interface with + * fill_buffer and write_flush as standard fields, passed to the port + * type constructor, and optional fields set by setters. + */ + +static void flush_void_port (SCM port); +static void read_flush_void_port (SCM port, int offset); long -scm_newptob (ptob) - scm_ptobfuns *ptob; +scm_make_port_type (char *name, + int (*fill_buffer) (SCM port), + void (*write_flush) (SCM port)) { char *tmp; if (255 <= scm_numptob) goto ptoberr; - tmp = (char *) realloc ((char *) scm_ptobs, (1 + scm_numptob) * sizeof (scm_ptobfuns)); + SCM_DEFER_INTS; + SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs, + (1 + scm_numptob) + * sizeof (scm_ptob_descriptor))); if (tmp) { - scm_ptobs = (scm_ptobfuns *) tmp; - scm_ptobs[scm_numptob].mark = ptob->mark; - scm_ptobs[scm_numptob].free = ptob->free; - scm_ptobs[scm_numptob].print = ptob->print; - scm_ptobs[scm_numptob].equalp = ptob->equalp; - scm_ptobs[scm_numptob].fflush = ptob->fflush; - scm_ptobs[scm_numptob].read_flush = ptob->read_flush; - scm_ptobs[scm_numptob].fclose = ptob->fclose; - scm_ptobs[scm_numptob].fill_buffer = ptob->fill_buffer; - scm_ptobs[scm_numptob].seek = ptob->seek; - scm_ptobs[scm_numptob].ftruncate = ptob->ftruncate; - scm_ptobs[scm_numptob].input_waiting_p = ptob->input_waiting_p; + scm_ptobs = (scm_ptob_descriptor *) tmp; + scm_ptobs[scm_numptob].name = name; + scm_ptobs[scm_numptob].mark = 0; + scm_ptobs[scm_numptob].free = scm_free0; + scm_ptobs[scm_numptob].print = scm_port_print; + scm_ptobs[scm_numptob].equalp = 0; + scm_ptobs[scm_numptob].fflush = (write_flush + ? write_flush + : flush_void_port); + scm_ptobs[scm_numptob].read_flush = read_flush_void_port; + scm_ptobs[scm_numptob].fclose = 0; + scm_ptobs[scm_numptob].fill_buffer = fill_buffer; + scm_ptobs[scm_numptob].seek = 0; + scm_ptobs[scm_numptob].ftruncate = 0; + scm_ptobs[scm_numptob].input_waiting_p = 0; scm_numptob++; } + SCM_ALLOW_INTS; if (!tmp) - ptoberr:scm_wta (SCM_MAKINUM ((long) scm_numptob), (char *) SCM_NALLOC, "newptob"); + ptoberr:scm_wta (SCM_MAKINUM ((long) scm_numptob), + (char *) SCM_NALLOC, "scm_make_port_type"); + /* Make a class object if Goops is present */ + if (scm_port_class) + scm_make_port_classes (scm_numptob - 1, SCM_PTOBNAME (scm_numptob - 1)); return scm_tc7_port + (scm_numptob - 1) * 256; } +void +scm_set_ptob_mark (long tc, SCM (*mark) (SCM)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].mark = mark; +} + +void +scm_set_ptob_free (long tc, scm_sizet (*free) (SCM)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].free = free; +} + +void +scm_set_ptob_print (long tc, int (*print) (SCM exp, SCM port, + scm_print_state *pstate)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].print = print; +} + +void +scm_set_ptob_equalp (long tc, SCM (*equalp) (SCM, SCM)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].equalp = equalp; +} + +void +scm_set_ptob_flush_input (long tc, void (*flush_input) (SCM port, int offset)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].read_flush = flush_input; +} + +void +scm_set_ptob_close (long tc, int (*close) (SCM)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].fclose = close; +} + +void +scm_set_ptob_seek (long tc, off_t (*seek) (SCM port, + off_t OFFSET, + int WHENCE)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].seek = seek; +} + +void +scm_set_ptob_truncate (long tc, void (*truncate) (SCM port, off_t length)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].ftruncate = truncate; +} + +void +scm_set_ptob_input_waiting_p (long tc, int (*waitingp) (SCM)) +{ + scm_ptobs[SCM_TC2PTOBNUM (tc)].input_waiting_p = waitingp; +} + SCM_PROC(s_char_ready_p, "char-ready?", 0, 1, 0, scm_char_ready_p); @@ -145,7 +233,7 @@ scm_char_ready_p (port) return SCM_BOOL_T; else { - scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; + scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (ptob->input_waiting_p) return (ptob->input_waiting_p (port)) ? SCM_BOOL_T : SCM_BOOL_F; @@ -674,7 +762,7 @@ scm_putc (c, port) SCM port; { scm_port *pt = SCM_PTAB_ENTRY (port); - scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; + scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (pt->rw_active == SCM_PORT_READ) scm_read_flush (port); @@ -694,7 +782,7 @@ scm_puts (s, port) SCM port; { scm_port *pt = SCM_PTAB_ENTRY (port); - scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; + scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (pt->rw_active == SCM_PORT_READ) scm_read_flush (port); @@ -721,7 +809,7 @@ scm_lfwrite (ptr, size, port) SCM port; { scm_port *pt = SCM_PTAB_ENTRY (port); - scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; + scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (pt->rw_active == SCM_PORT_READ) scm_read_flush (port); @@ -953,7 +1041,7 @@ scm_lseek (SCM object, SCM offset, SCM whence) if (SCM_NIMP (object) && SCM_OPPORTP (object)) { scm_port *pt = SCM_PTAB_ENTRY (object); - scm_ptobfuns *ptob = scm_ptobs + SCM_PTOBNUM (object); + scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object); if (!ptob->seek) scm_misc_error (s_lseek, "port is not seekable", @@ -1008,7 +1096,7 @@ scm_truncate_file (SCM object, SCM length) else if (SCM_NIMP (object) && SCM_OPOUTPORTP (object)) { scm_port *pt = SCM_PTAB_ENTRY (object); - scm_ptobfuns *ptob = scm_ptobs + SCM_PTOBNUM (object); + scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object); if (!ptob->ftruncate) scm_misc_error (s_truncate_file, "port is not truncatable", SCM_EOL); @@ -1126,69 +1214,60 @@ scm_set_port_filename_x (port, filename) extern char * ttyname(); #endif - -void -scm_prinport (exp, port, type) - SCM exp; - SCM port; - char *type; +void +scm_print_port_mode (SCM exp, SCM port) { - scm_puts ("#<", port); - if (SCM_CLOSEDP (exp)) - scm_puts ("closed: ", port); - else - { - if (SCM_RDNG & SCM_CAR (exp)) - scm_puts ("input: ", port); - if (SCM_WRTNG & SCM_CAR (exp)) - scm_puts ("output: ", port); - } - scm_puts (type, port); - scm_putc (' ', port); - if (SCM_OPFPORTP (exp)) - { - int fdes = (SCM_FSTREAM (exp))->fdes; - - if (isatty (fdes)) - scm_puts (ttyname (fdes), port); - else - scm_intprint (fdes, 10, port); - } - else - { - scm_intprint (SCM_CDR (exp), 16, port); - } - scm_putc ('>', port); + scm_puts (SCM_CLOSEDP (exp) + ? "closed: " + : (SCM_RDNG & SCM_CAR (exp) + ? (SCM_WRTNG & SCM_CAR (exp) + ? "input-output: " + : "input: ") + : (SCM_WRTNG & SCM_CAR (exp) + ? "output: " + : "bogus: ")), + port); } +int +scm_port_print (SCM exp, SCM port, scm_print_state *pstate) +{ + char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp)); + if (!type) + type = "port"; + scm_puts ("#<", port); + scm_print_port_mode (exp, port); + scm_puts (type, port); + scm_putc (' ', port); + scm_intprint (SCM_CDR (exp), 16, port); + scm_putc ('>', port); + return 1; +} + +extern void scm_make_fptob (); +extern void scm_make_stptob (); +extern void scm_make_sfptob (); void scm_ports_prehistory () { scm_numptob = 0; - scm_ptobs = (scm_ptobfuns *) malloc (sizeof (scm_ptobfuns)); + scm_ptobs = (scm_ptob_descriptor *) malloc (sizeof (scm_ptob_descriptor)); /* WARNING: These scm_newptob calls must be done in this order. * They must agree with the port declarations in tags.h. */ - /* scm_tc16_fport = */ scm_newptob (&scm_fptob); - /* scm_tc16_pipe was here */ scm_newptob (&scm_fptob); /* dummy. */ - /* scm_tc16_strport = */ scm_newptob (&scm_stptob); - /* scm_tc16_sfport = */ scm_newptob (&scm_sfptob); + /* scm_tc16_fport = */ scm_make_fptob (); + /* scm_tc16_pipe was here */ scm_make_fptob (); /* dummy. */ + /* scm_tc16_strport = */ scm_make_stptob (); + /* scm_tc16_sfport = */ scm_make_sfptob (); } /* Void ports. */ -int scm_tc16_void_port = 0; - -static int -print_void_port (SCM exp, SCM port, scm_print_state *pstate) -{ - scm_prinport (exp, port, "void"); - return 1; -} +long scm_tc16_void_port = 0; static void flush_void_port (SCM port) @@ -1200,36 +1279,6 @@ read_flush_void_port (SCM port, int offset) { } -static int -close_void_port (SCM port) -{ - return 0; /* this is ignored by scm_close_port. */ -} - - - -static int -noop0 (SCM stream) -{ - return 0; -} - - -static struct scm_ptobfuns void_port_ptob = -{ - 0, - noop0, - print_void_port, - 0, /* equal? */ - flush_void_port, - read_flush_void_port, - close_void_port, - 0, - 0, - 0, - 0, -}; - SCM scm_void_port (mode_str) char * mode_str; @@ -1274,6 +1323,6 @@ scm_init_ports () scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR)); scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END)); - scm_tc16_void_port = scm_newptob (&void_port_ptob); + scm_tc16_void_port = scm_make_port_type ("void", 0, 0); #include "ports.x" } diff --git a/libguile/ports.h b/libguile/ports.h index 69d790a1b..fabb44a1b 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -169,10 +169,11 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */ -typedef struct scm_ptobfuns +typedef struct scm_ptob_descriptor { + char *name; SCM (*mark) (SCM); - int (*free) (SCM); + scm_sizet (*free) (SCM); int (*print) (SCM exp, SCM port, scm_print_state *pstate); SCM (*equalp) (SCM, SCM); void (*fflush) (SCM port); @@ -182,20 +183,44 @@ typedef struct scm_ptobfuns off_t (*seek) (SCM port, off_t OFFSET, int WHENCE); void (*ftruncate) (SCM port, off_t length); int (*input_waiting_p) (SCM port); -} scm_ptobfuns; +} scm_ptob_descriptor; -#define SCM_PTOBNUM(x) (0x0ff & (SCM_CAR(x)>>8)) +#define SCM_TC2PTOBNUM(x) (0x0ff & ((x) >> 8)) +#define SCM_PTOBNUM(x) (SCM_TC2PTOBNUM (SCM_CAR (x))) +/* SCM_PTOBNAME can be 0 if name is missing */ +#define SCM_PTOBNAME(ptobnum) scm_ptobs[ptobnum].name -extern scm_ptobfuns *scm_ptobs; +extern scm_ptob_descriptor *scm_ptobs; extern int scm_numptob; extern int scm_port_table_room; extern SCM scm_markstream SCM_P ((SCM ptr)); -extern long scm_newptob SCM_P ((scm_ptobfuns *ptob)); +extern long scm_make_port_type (char *name, + int (*fill_buffer) (SCM port), + void (*write_flush) (SCM port)); +extern void scm_set_ptob_mark (long tc, SCM (*mark) (SCM)); +extern void scm_set_ptob_free (long tc, scm_sizet (*free) (SCM)); +extern void scm_set_ptob_print (long tc, + int (*print) (SCM exp, + SCM port, + scm_print_state *pstate)); +extern void scm_set_ptob_equalp (long tc, SCM (*equalp) (SCM, SCM)); +extern void scm_set_ptob_flush_input (long tc, + void (*flush_input) (SCM port, + int offset)); +extern void scm_set_ptob_close (long tc, int (*close) (SCM)); +extern void scm_set_ptob_seek (long tc, + off_t (*seek) (SCM port, + off_t OFFSET, + int WHENCE)); +extern void scm_set_ptob_truncate (long tc, + void (*truncate) (SCM port, + off_t length)); +extern void scm_set_ptob_input_waiting_p (long tc, int (*waitingp) (SCM)); extern SCM scm_char_ready_p SCM_P ((SCM port)); extern SCM scm_drain_input (SCM port); extern SCM scm_current_input_port SCM_P ((void)); @@ -244,7 +269,8 @@ extern SCM scm_port_column SCM_P ((SCM port)); extern SCM scm_set_port_column_x SCM_P ((SCM port, SCM line)); extern SCM scm_port_filename SCM_P ((SCM port)); extern SCM scm_set_port_filename_x SCM_P ((SCM port, SCM filename)); -extern void scm_prinport SCM_P ((SCM exp, SCM port, char *type)); +extern int scm_port_print (SCM exp, SCM port, scm_print_state *); +extern void scm_print_port_mode (SCM exp, SCM port); extern void scm_ports_prehistory SCM_P ((void)); extern SCM scm_void_port SCM_P ((char * mode_str)); extern SCM scm_sys_make_void_port SCM_P ((SCM mode));