SCM port;
{
SCM ooutp = scm_cur_outp;
+ port = SCM_COERCE_OUTPORT (port);
SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_output_port);
scm_cur_outp = port;
return ooutp;
SCM port;
{
SCM oerrp = scm_cur_errp;
+ port = SCM_COERCE_OUTPORT (port);
SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_error_port);
scm_cur_errp = port;
return oerrp;
{
scm_port_table = ((struct scm_port_table **)
realloc ((char *) scm_port_table,
- (long) (sizeof (struct scm_port_table)
- * scm_port_table_room * 2)));
+ (scm_sizet) (sizeof (struct scm_port_table *)
+ * scm_port_table_room * 2)));
/* !!! error checking */
scm_port_table_room *= 2;
}
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;
return scm_port_table[scm_port_table_size++];
}
scm_port_revealed (port)
SCM port;
{
+ port = SCM_COERCE_OUTPORT (port);
SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed);
return SCM_MAKINUM (scm_revealed_count (port));
}
SCM port;
SCM rcount;
{
+ port = SCM_COERCE_OUTPORT (port);
SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_set_port_revealed_x);
SCM_ASSERT (SCM_INUMP (rcount), rcount, SCM_ARG2, s_set_port_revealed_x);
SCM_DEFER_INTS;
{
char modes[3];
modes[0] = '\0';
+
+ port = SCM_COERCE_OUTPORT (port);
SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);
if (SCM_CAR (port) & SCM_RDNG) {
if (SCM_CAR (port) & SCM_WRTNG)
scm_sizet i;
int rv;
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_close_port);
+ port = SCM_COERCE_OUTPORT (port);
+
+ SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1,
+ s_close_port);
if (SCM_CLOSEDP (port))
return SCM_BOOL_F;
i = SCM_PTOBNUM (port);
while (SCM_NNULLP (ports_ptr))
{
- SCM port = SCM_CAR (ports_ptr);
+ SCM port = SCM_COERCE_OUTPORT (SCM_CAR (ports_ptr));
if (i == 0)
SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_close_all_ports_except);
if (port == thisport)
if (SCM_UNBNDP (port))
port = scm_cur_outp;
else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_force_output);
+ {
+ port = SCM_COERCE_OUTPORT (port);
+ 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)));
* to ensure that you don't have to.
*/
-char * scm_generic_fgets SCM_P ((SCM port));
+char * scm_generic_fgets SCM_P ((SCM port, int *len));
char *
-scm_generic_fgets (port)
+scm_generic_fgets (port, len)
SCM port;
+ int *len;
{
SCM f = SCM_STREAM (port);
scm_sizet p = SCM_PTOBNUM (port);
- char *buf = NULL;
- int i = 0; /* index into current buffer position */
+ char *buf;
int limit = 80; /* current size of buffer */
int c;
- if (feof ((FILE *)f))
- return NULL;
+ /* FIXME: It would be nice to be able to check for EOF before anything. */
+
+ *len = 0;
+ buf = (char *) malloc (limit * sizeof(char));
- buf = (char *) scm_must_malloc (limit * sizeof(char), "generic_fgets");
+ /* If a char has been pushed onto the port with scm_ungetc,
+ read that first. */
+ if (SCM_CRDYP (port))
+ {
+ buf[*len] = SCM_CGETUN (port);
+ SCM_CLRDY (port);
+ if (buf[(*len)++] == '\n')
+ {
+ buf[*len] = '\0';
+ return buf;
+ }
+ }
while (1) {
- if (i >= limit-1)
+ if (*len >= limit-1)
{
- buf = (char *) scm_must_realloc (buf,
- sizeof(char) * limit,
- sizeof(char) * limit * 2,
- "generic_fgets");
+ buf = (char *) realloc (buf, sizeof(char) * limit * 2);
limit *= 2;
}
c = (scm_ptobs[p].fgetc) (f);
if (c != EOF)
- buf[i++] = c;
+ buf[(*len)++] = c;
if (c == EOF || c == '\n')
{
- if (i)
+ if (*len)
{
- buf[i] = '\0';
+ buf[*len] = '\0';
return buf;
}
- scm_must_free (buf);
+ free (buf);
return NULL;
}
}
return cobj;
}
-SCM_PROC (s_port_line, "port-line", 0, 1, 0, scm_port_line);
+SCM_PROC (s_port_line, "port-line", 1, 0, 0, scm_port_line);
SCM
scm_port_line (port)
SCM port;
{
- SCM p;
- p = ((port == SCM_UNDEFINED)
- ? scm_cur_inp
- : port);
- if (!(SCM_NIMP (p) && SCM_PORTP (p)))
- return SCM_BOOL_F;
- else
- return SCM_MAKINUM (SCM_LINUM (p));
+ 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!", 1, 1, 0, scm_set_port_line_x);
+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
- 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;
- 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));
+ port = SCM_COERCE_OUTPORT (port);
+ 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
- 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;
- 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;
+ port = SCM_COERCE_OUTPORT (port);
+ 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
- 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;
}
}
static char *
-fgets_void_port (SCM strm)
+fgets_void_port (SCM strm, int *len)
{
return NULL;
}