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

* ports.c, ports.h (scm_make_port_type): New interface for

Browse source 
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"
This commit is contained in:
Mikael Djurfeldt 1999-07-24 23:10:13 +00:00
parent c163662710
commit f12733c9d4
2 changed files with 185 additions and 110 deletions
Download patch file Download diff file Expand all files Collapse all files

255
libguile/ports.c
View file

@ -43,12 +43,10 @@
#include <stdio.h> #include <stdio.h>
#include "_scm.h" #include "_scm.h"
#include "genio.h" #include "objects.h"
#include "smob.h"
#include "chars.h" #include "chars.h"
#include "fports.h"
#include "strports.h"
#include "vports.h"
#include "keywords.h" #include "keywords.h"
#include "ports.h" #include "ports.h"
@ -74,7 +72,7 @@
* Indexes into this table are used when generating type * Indexes into this table are used when generating type
* tags for smobjects (if you know a tag you can get an index and conversely). * 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; int scm_numptob;
/* GC marker for a port with stream of SCM type. */ /* GC marker for a port with stream of SCM type. */
@ -90,36 +88,126 @@ scm_markstream (ptr)
return SCM_BOOL_F; 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 long
scm_newptob (ptob) scm_make_port_type (char *name,
scm_ptobfuns *ptob; int (*fill_buffer) (SCM port),
void (*write_flush) (SCM port))
{ {
char *tmp; char *tmp;
if (255 <= scm_numptob) if (255 <= scm_numptob)
goto ptoberr; 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) if (tmp)
{ {
scm_ptobs = (scm_ptobfuns *) tmp; scm_ptobs = (scm_ptob_descriptor *) tmp;
scm_ptobs[scm_numptob].mark = ptob->mark; scm_ptobs[scm_numptob].name = name;
scm_ptobs[scm_numptob].free = ptob->free; scm_ptobs[scm_numptob].mark = 0;
scm_ptobs[scm_numptob].print = ptob->print; scm_ptobs[scm_numptob].free = scm_free0;
scm_ptobs[scm_numptob].equalp = ptob->equalp; scm_ptobs[scm_numptob].print = scm_port_print;
scm_ptobs[scm_numptob].fflush = ptob->fflush; scm_ptobs[scm_numptob].equalp = 0;
scm_ptobs[scm_numptob].read_flush = ptob->read_flush; scm_ptobs[scm_numptob].fflush = (write_flush
scm_ptobs[scm_numptob].fclose = ptob->fclose; ? write_flush
scm_ptobs[scm_numptob].fill_buffer = ptob->fill_buffer; : flush_void_port);
scm_ptobs[scm_numptob].seek = ptob->seek; scm_ptobs[scm_numptob].read_flush = read_flush_void_port;
scm_ptobs[scm_numptob].ftruncate = ptob->ftruncate; scm_ptobs[scm_numptob].fclose = 0;
scm_ptobs[scm_numptob].input_waiting_p = ptob->input_waiting_p; 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_numptob++;
} }
SCM_ALLOW_INTS;
if (!tmp) 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; 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); 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; return SCM_BOOL_T;
else else
{ {
scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (ptob->input_waiting_p) if (ptob->input_waiting_p)
return (ptob->input_waiting_p (port)) ? SCM_BOOL_T : SCM_BOOL_F; return (ptob->input_waiting_p (port)) ? SCM_BOOL_T : SCM_BOOL_F;
@ -674,7 +762,7 @@ scm_putc (c, port)
SCM port; SCM port;
{ {
scm_port *pt = SCM_PTAB_ENTRY (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) if (pt->rw_active == SCM_PORT_READ)
scm_read_flush (port); scm_read_flush (port);
@ -694,7 +782,7 @@ scm_puts (s, port)
SCM port; SCM port;
{ {
scm_port *pt = SCM_PTAB_ENTRY (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) if (pt->rw_active == SCM_PORT_READ)
scm_read_flush (port); scm_read_flush (port);
@ -721,7 +809,7 @@ scm_lfwrite (ptr, size, port)
SCM port; SCM port;
{ {
scm_port *pt = SCM_PTAB_ENTRY (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) if (pt->rw_active == SCM_PORT_READ)
scm_read_flush (port); scm_read_flush (port);
@ -953,7 +1041,7 @@ scm_lseek (SCM object, SCM offset, SCM whence)
if (SCM_NIMP (object) && SCM_OPPORTP (object)) if (SCM_NIMP (object) && SCM_OPPORTP (object))
{ {
scm_port *pt = SCM_PTAB_ENTRY (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) if (!ptob->seek)
scm_misc_error (s_lseek, "port is not seekable", 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)) else if (SCM_NIMP (object) && SCM_OPOUTPORTP (object))
{ {
scm_port *pt = SCM_PTAB_ENTRY (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) if (!ptob->ftruncate)
scm_misc_error (s_truncate_file, "port is not truncatable", SCM_EOL); 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(); extern char * ttyname();
#endif #endif
void
void scm_print_port_mode (SCM exp, SCM port)
scm_prinport (exp, port, type)
SCM exp;
SCM port;
char *type;
{ {
scm_puts ("#<", port); scm_puts (SCM_CLOSEDP (exp)
if (SCM_CLOSEDP (exp)) ? "closed: "
scm_puts ("closed: ", port); : (SCM_RDNG & SCM_CAR (exp)
else ? (SCM_WRTNG & SCM_CAR (exp)
{ ? "input-output: "
if (SCM_RDNG & SCM_CAR (exp)) : "input: ")
scm_puts ("input: ", port); : (SCM_WRTNG & SCM_CAR (exp)
if (SCM_WRTNG & SCM_CAR (exp)) ? "output: "
scm_puts ("output: ", port); : "bogus: ")),
} 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);
} }
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 void
scm_ports_prehistory () scm_ports_prehistory ()
{ {
scm_numptob = 0; 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. /* WARNING: These scm_newptob calls must be done in this order.
* They must agree with the port declarations in tags.h. * They must agree with the port declarations in tags.h.
*/ */
/* scm_tc16_fport = */ scm_newptob (&scm_fptob); /* scm_tc16_fport = */ scm_make_fptob ();
/* scm_tc16_pipe was here */ scm_newptob (&scm_fptob); /* dummy. */ /* scm_tc16_pipe was here */ scm_make_fptob (); /* dummy. */
/* scm_tc16_strport = */ scm_newptob (&scm_stptob); /* scm_tc16_strport = */ scm_make_stptob ();
/* scm_tc16_sfport = */ scm_newptob (&scm_sfptob); /* scm_tc16_sfport = */ scm_make_sfptob ();
} }
/* Void ports. */ /* Void ports. */
int scm_tc16_void_port = 0; long 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;
}
static void static void
flush_void_port (SCM port) 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
scm_void_port (mode_str) scm_void_port (mode_str)
char * mode_str; char * mode_str;
@ -1274,6 +1323,6 @@ scm_init_ports ()
scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR)); scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END)); 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" #include "ports.x"
} }

40
libguile/ports.h
View file

@ -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); SCM (*mark) (SCM);
int (*free) (SCM); scm_sizet (*free) (SCM);
int (*print) (SCM exp, SCM port, scm_print_state *pstate); int (*print) (SCM exp, SCM port, scm_print_state *pstate);
SCM (*equalp) (SCM, SCM); SCM (*equalp) (SCM, SCM);
void (*fflush) (SCM port); void (*fflush) (SCM port);
@ -182,20 +183,44 @@ typedef struct scm_ptobfuns
off_t (*seek) (SCM port, off_t OFFSET, int WHENCE); off_t (*seek) (SCM port, off_t OFFSET, int WHENCE);
void (*ftruncate) (SCM port, off_t length); void (*ftruncate) (SCM port, off_t length);
int (*input_waiting_p) (SCM port); 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_numptob;
extern int scm_port_table_room; extern int scm_port_table_room;
extern SCM scm_markstream SCM_P ((SCM ptr)); 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_char_ready_p SCM_P ((SCM port));
extern SCM scm_drain_input (SCM port); extern SCM scm_drain_input (SCM port);
extern SCM scm_current_input_port SCM_P ((void)); 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_set_port_column_x SCM_P ((SCM port, SCM line));
extern SCM scm_port_filename SCM_P ((SCM port)); extern SCM scm_port_filename SCM_P ((SCM port));
extern SCM scm_set_port_filename_x SCM_P ((SCM port, SCM filename)); 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 void scm_ports_prehistory SCM_P ((void));
extern SCM scm_void_port SCM_P ((char * mode_str)); extern SCM scm_void_port SCM_P ((char * mode_str));
extern SCM scm_sys_make_void_port SCM_P ((SCM mode)); extern SCM scm_sys_make_void_port SCM_P ((SCM mode));