-/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
\f
+/* Headers. */
+
#include <stdio.h>
#include "_scm.h"
#include "genio.h"
#include "fports.h"
#include "strports.h"
#include "vports.h"
-#include "kw.h"
+#include "keywords.h"
#include "ports.h"
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
#endif
+
\f
+/* The port kind table --- a dynamically resized array of port types. */
/* scm_ptobs scm_numptob
* tags for smobjects (if you know a tag you can get an index and conversely).
*/
scm_ptobfuns *scm_ptobs;
-scm_sizet scm_numptob;
+int scm_numptob;
SCM
SCM ptr;
{
int openp;
- if (SCM_GC8MARKP (ptr))
- return SCM_BOOL_F;
openp = SCM_CAR (ptr) & SCM_OPN;
- SCM_SETGC8MARK (ptr);
if (openp)
return SCM_STREAM (ptr);
else
}
\f
-/* internal SCM call */
-
-void
-scm_fflush (port)
- SCM port;
-{
- scm_sizet i = SCM_PTOBNUM (port);
- (scm_ptobs[i].fflush) (SCM_STREAM (port));
-}
-
-\f
SCM_PROC(s_char_ready_p, "char-ready?", 0, 1, 0, scm_char_ready_p);
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_char_ready_p);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1,
+ s_char_ready_p);
+
if (SCM_CRDYP (port) || !SCM_FPORTP (port))
return SCM_BOOL_T;
return (scm_input_waiting_p ((FILE *) SCM_STREAM (port), s_char_ready_p)
\f
+/* Standard ports --- current input, output, error, and more(!). */
-
-/* {Standard Ports}
- */
SCM_PROC(s_current_input_port, "current-input-port", 0, 0, 0, scm_current_input_port);
SCM
return scm_cur_errp;
}
+SCM_PROC(s_current_load_port, "current-load-port", 0, 0, 0, scm_current_load_port);
+
+SCM
+scm_current_load_port ()
+{
+ return scm_cur_loadp;
+}
+
SCM_PROC(s_set_current_input_port, "set-current-input-port", 1, 0, 0, scm_set_current_input_port);
SCM
}
\f
-
-/* {Ports - in general}
- *
- */
+/* The port table --- a table of all the open ports. */
/* Array of open ports, required for reliable MOVE->FDES etc. */
struct scm_port_table **scm_port_table;
scm_must_malloc (sizeof (struct scm_port_table),
"system port table"));
scm_port_table[scm_port_table_size]->port = port;
+ scm_port_table[scm_port_table_size]->entry = scm_port_table_size;
scm_port_table[scm_port_table_size]->revealed = 0;
scm_port_table[scm_port_table_size]->stream = 0;
scm_port_table[scm_port_table_size]->file_name = SCM_BOOL_F;
- scm_port_table[scm_port_table_size]->line_number = 1;
+ scm_port_table[scm_port_table_size]->line_number = 0;
scm_port_table[scm_port_table_size]->column_number = 0;
+ scm_port_table[scm_port_table_size]->cp
+ = scm_port_table[scm_port_table_size]->cbuf;
+ scm_port_table[scm_port_table_size]->cbufend
+ = &scm_port_table[scm_port_table_size]->cbuf[SCM_INITIAL_CBUF_SIZE];
return scm_port_table[scm_port_table_size++];
}
scm_remove_from_port_table (port)
SCM port;
{
- int i = 0;
- while (scm_port_table[i]->port != port)
+ struct scm_port_table *p = SCM_PTAB_ENTRY (port);
+ int i = p->entry;
+ /* Error if not found: too violent? May occur in GC. */
+ if (i >= scm_port_table_size)
+ scm_wta (port, "Port not in table", "scm_remove_from_port_table");
+ scm_mallocated -= (sizeof (*p)
+ + (p->cbufend - p->cbuf)
+ - SCM_INITIAL_CBUF_SIZE);
+ scm_must_free ((char *)p);
+ /* Since we have just freed slot i we can shrink the table by moving
+ the last entry to that slot... */
+ if (i < scm_port_table_size - 1)
{
- i++;
- /* Error if not found: too violent? May occur in GC. */
- if (i >= scm_port_table_size)
- scm_wta (port, "Port not in table", "scm_remove_from_port_table");
+ scm_port_table[i] = scm_port_table[scm_port_table_size - 1];
+ scm_port_table[i]->entry = i;
}
- scm_must_free ((char *)scm_port_table[i]);
- scm_mallocated -= sizeof (*scm_port_table[i]);
- scm_port_table[i] = scm_port_table[scm_port_table_size - 1];
SCM_SETPTAB_ENTRY (port, 0);
scm_port_table_size--;
}
+void
+scm_grow_port_cbuf (port, requested)
+ SCM port;
+ size_t requested;
+{
+ struct scm_port_table *p = SCM_PTAB_ENTRY (port);
+ int size = p->cbufend - p->cbuf;
+ int new_size = size * 3 / 2;
+ if (new_size < requested)
+ new_size = requested;
+ p = realloc (p, sizeof (*p) - SCM_INITIAL_CBUF_SIZE + new_size);
+ scm_port_table[p->entry] = p;
+ SCM_SETPTAB_ENTRY (port, p);
+}
+
#ifdef GUILE_DEBUG
/* Undocumented functions for debugging. */
/* Return the number of ports in the table. */
#endif
+\f
+/* Revealed counts --- an oddity inherited from SCSH. */
+
/* Find a port in the table and return its revealed count.
Also used by the garbage collector.
*/
return SCM_UNSPECIFIED;
}
+
+\f
+/* Retrieving a port's mode. */
+
/* Return the flags that characterize a port based on the mode
* string used to open a file for that port.
*
}
+\f
+/* Closing ports. */
+
/* scm_close_port
* Call the close operation on a port object.
* see also scm_close.
SCM_DEFER_INTS;
if (scm_ptobs[i].fclose)
{
- SCM_SYSCALL (rv = (scm_ptobs[i].fclose) (SCM_STREAM (port)));
+ SCM_SYSCALL (rv = (scm_ptobs[i].fclose) (port));
/* ports with a closed file descriptor can be reclosed without error. */
if (rv < 0 && errno != EBADF)
scm_syserror (s_close_port);
return SCM_UNSPECIFIED;
}
+
+\f
+/* Utter miscellany. Gosh, we should clean this up some time. */
+
SCM_PROC(s_input_port_p, "input-port?", 1, 0, 0, scm_input_port_p);
SCM
SCM port;
{
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ port = scm_cur_outp;
else
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_force_output);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1,
+ s_force_output);
}
{
scm_sizet i = SCM_PTOBNUM (port);
- SCM_SYSCALL ((scm_ptobs[i].fflush) (SCM_STREAM (port)));
+ SCM_SYSCALL ((scm_ptobs[i].fflush) (port));
return SCM_UNSPECIFIED;
}
}
if (SCM_OPOUTPORTP (port))
{
scm_sizet ptob = SCM_PTOBNUM (port);
- (scm_ptobs[ptob].fflush) (SCM_STREAM (port));
+ (scm_ptobs[ptob].fflush) (port);
}
}
return SCM_UNSPECIFIED;
SCM port;
int *len;
{
- SCM f = SCM_STREAM (port);
scm_sizet p = SCM_PTOBNUM (port);
char *buf;
/* If a char has been pushed onto the port with scm_ungetc,
read that first. */
- if (SCM_CRDYP (port))
+ while (SCM_CRDYP (port))
{
buf[*len] = SCM_CGETUN (port);
- SCM_CLRDY (port);
- if (buf[(*len)++] == '\n')
+ SCM_TRY_CLRDY (port);
+ if (buf[(*len)++] == '\n' || *len == limit - 1)
{
buf[*len] = '\0';
return buf;
limit *= 2;
}
- c = (scm_ptobs[p].fgetc) (f);
+ c = (scm_ptobs[p].fgetc) (port);
if (c != EOF)
buf[(*len)++] = c;
return cobj;
}
-SCM_PROC (s_port_line, "port-line", 0, 1, 0, scm_port_line);
+SCM_PROC (s_unread_string, "unread-string", 2, 0, 0, scm_unread_string);
SCM
-scm_port_line (port)
+scm_unread_string (str, port)
+ SCM str;
SCM port;
{
- SCM p;
+ SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str),
+ str, SCM_ARG1, s_unread_string);
- port = SCM_COERCE_OUTPORT (port);
-
- p = ((port == SCM_UNDEFINED)
- ? scm_cur_inp
- : port);
- if (!(SCM_NIMP (p) && SCM_PORTP (p)))
- return SCM_BOOL_F;
+ if (SCM_UNBNDP (port))
+ port = scm_cur_inp;
else
- return SCM_MAKINUM (SCM_LINUM (p));
+ SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
+ port, SCM_ARG2, s_unread_string);
+
+ scm_ungets (SCM_ROUCHARS (str), SCM_LENGTH (str), port);
+
+ return str;
}
-SCM_PROC (s_set_port_line_x, "set-port-line!", 1, 1, 0, scm_set_port_line_x);
+SCM_PROC (s_port_line, "port-line", 1, 0, 0, scm_port_line);
+
+SCM
+scm_port_line (port)
+ SCM port;
+{
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+ port,
+ SCM_ARG1,
+ s_port_line);
+ return SCM_MAKINUM (SCM_LINUM (port));
+}
+
+SCM_PROC (s_set_port_line_x, "set-port-line!", 2, 0, 0, scm_set_port_line_x);
SCM
scm_set_port_line_x (port, line)
SCM port;
SCM line;
{
- if (line == SCM_UNDEFINED)
- {
- line = port;
- port = scm_cur_inp;
- }
- else
- {
- port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_set_port_line_x);
- }
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+ port,
+ SCM_ARG1,
+ s_set_port_line_x);
+ SCM_ASSERT (SCM_INUMP (line), line, SCM_ARG2, s_set_port_line_x);
return SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line);
}
-SCM_PROC (s_port_column, "port-column", 0, 1, 0, scm_port_column);
+SCM_PROC (s_port_column, "port-column", 1, 0, 0, scm_port_column);
SCM
scm_port_column (port)
SCM port;
{
- SCM p;
-
port = SCM_COERCE_OUTPORT (port);
-
- p = ((port == SCM_UNDEFINED)
- ? scm_cur_inp
- : port);
- if (!(SCM_NIMP (p) && SCM_PORTP (p)))
- return SCM_BOOL_F;
- else
- return SCM_MAKINUM (SCM_COL (p));
+ SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+ port,
+ SCM_ARG1,
+ s_port_column);
+ return SCM_MAKINUM (SCM_COL (port));
}
-SCM_PROC (s_set_port_column_x, "set-port-column!", 1, 1, 0, scm_set_port_column_x);
+SCM_PROC (s_set_port_column_x, "set-port-column!", 2, 0, 0, scm_set_port_column_x);
SCM
scm_set_port_column_x (port, column)
SCM port;
SCM column;
{
- if (column == SCM_UNDEFINED)
- {
- column = port;
- port = scm_cur_inp;
- }
- else
- {
- port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_set_port_column_x);
- }
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+ port,
+ SCM_ARG1,
+ s_set_port_column_x);
+ SCM_ASSERT (SCM_INUMP (column), column, SCM_ARG2, s_set_port_column_x);
return SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column);
}
-SCM_PROC (s_port_filename, "port-filename", 0, 1, 0, scm_port_filename);
+SCM_PROC (s_port_filename, "port-filename", 1, 0, 0, scm_port_filename);
SCM
scm_port_filename (port)
SCM port;
{
- SCM p;
-
port = SCM_COERCE_OUTPORT (port);
-
- p = ((port == SCM_UNDEFINED)
- ? scm_cur_inp
- : port);
- if (!(SCM_NIMP (p) && SCM_PORTP (p)))
- return SCM_BOOL_F;
- else
- return SCM_PTAB_ENTRY (p)->file_name;
+ SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+ port,
+ SCM_ARG1,
+ s_port_filename);
+ return SCM_PTAB_ENTRY (port)->file_name;
}
-SCM_PROC (s_set_port_filename_x, "set-port-filename!", 1, 1, 0, scm_set_port_filename_x);
+SCM_PROC (s_set_port_filename_x, "set-port-filename!", 2, 0, 0, scm_set_port_filename_x);
SCM
scm_set_port_filename_x (port, filename)
SCM port;
SCM filename;
{
- if (filename == SCM_UNDEFINED)
- {
- filename = port;
- port = scm_cur_inp;
- }
- else
- {
- port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_set_port_filename_x);
- }
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+ port,
+ SCM_ARG1,
+ s_set_port_filename_x);
+ /* We allow the user to set the filename to whatever he likes. */
return SCM_PTAB_ENTRY (port)->file_name = filename;
}
/* scm_tc16_strport = */ scm_newptob (&scm_stptob);
/* scm_tc16_sfport = */ scm_newptob (&scm_sfptob);
}
-\f
\f
-/* {Void Ports}
- */
+/* Void ports. */
int scm_tc16_void_port = 0;
}
static int
-putc_void_port (int c, SCM strm)
+putc_void_port (int c, SCM port)
{
return 0; /* vestigial return value */
}
static int
-puts_void_port (char *s, SCM strm)
+puts_void_port (char *s, SCM port)
{
return 0; /* vestigial return value */
}
static scm_sizet
-write_void_port (char *ptr, scm_sizet size, scm_sizet nitems, SCM strm)
+write_void_port (char *ptr, scm_sizet size, scm_sizet nitems, SCM port)
{
int len;
len = size * nitems;
static int
-flush_void_port (SCM strm)
+flush_void_port (SCM port)
{
return 0;
}
static int
-getc_void_port (SCM strm)
+getc_void_port (SCM port)
{
return EOF;
}
static char *
-fgets_void_port (SCM strm, int *len)
+fgets_void_port (SCM port, int *len)
{
return NULL;
}
static int
-close_void_port (SCM strm)
+close_void_port (SCM port)
{
return 0; /* this is ignored by scm_close_port. */
}
}
-static struct scm_ptobfuns void_port_ptob =
+static struct scm_ptobfuns void_port_ptob =
{
- scm_mark0,
+ 0,
noop0,
print_void_port,
0, /* equal? */
close_void_port,
};
-\f
-
-
SCM
scm_void_port (mode_str)
char * mode_str;
\f
-
+/* Initialization. */
void
scm_init_ports ()
HCoop / bpt / guile.git / blobdiff