-/* Copyright (C) 1995,1996 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
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
+ * If you do not wish that, delete this exception notice. */
\f
+/* Headers. */
+
#include <stdio.h>
#include "_scm.h"
#include "genio.h"
#include "chars.h"
#include "markers.h"
+#include "filesys.h"
#include "fports.h"
#include "strports.h"
#include "vports.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
scm_ptobs[scm_numptob].fwrite = ptob->fwrite;
scm_ptobs[scm_numptob].fflush = ptob->fflush;
scm_ptobs[scm_numptob].fgetc = ptob->fgetc;
+ scm_ptobs[scm_numptob].fgets = ptob->fgets;
scm_ptobs[scm_numptob].fclose = ptob->fclose;
scm_numptob++;
}
}
\f
-/* internal SCM call */
-
-void
-scm_fflush (port)
- SCM port;
-{
- scm_sizet i = SCM_PTOBNUM (port);
- (scm_ptobs[i].fflush) (SCM_STREAM (port));
-}
-
-\f
-
-
-#ifdef __IBMC__
-# define MSDOS
-#endif
-#ifdef MSDOS
-# ifndef GO32
-# include <io.h>
-# include <conio.h>
-
-static int input_waiting SCM_P ((FILE *f));
-
-static int
-input_waiting (f)
- FILE *f;
-{
- if (feof (f))
- return 1;
- if (fileno (f) == fileno (stdin) && (isatty (fileno (stdin))))
- return kbhit ();
- return -1;
-}
-# endif
-#else
-# ifdef _DCC
-# include <ioctl.h>
-# else
-# ifndef AMIGA
-# ifndef vms
-# ifdef MWC
-# include <sys/io.h>
-# else
-# ifndef THINK_C
-# ifndef ARM_ULIB
-# include <sys/ioctl.h>
-# endif
-# endif
-# endif
-# endif
-# endif
-# endif
-
-
-
-static int input_waiting SCM_P ((FILE *f));
-
-static int
-input_waiting(f)
- FILE *f;
-{
-# ifdef FIONREAD
- long remir;
- if (feof(f)) return 1;
- ioctl(fileno(f), FIONREAD, &remir);
- return remir;
-# else
- return -1;
-# endif
-}
-#endif
-SCM_PROC(s_char_ready_p, "char-ready?", 1, 0, 0, scm_char_ready_p);
+SCM_PROC(s_char_ready_p, "char-ready?", 0, 1, 0, scm_char_ready_p);
SCM
scm_char_ready_p (port)
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 input_waiting ((FILE *)SCM_STREAM (port)) ? SCM_BOOL_T : SCM_BOOL_F;
-}
-
-
-\f
-
-SCM_PROC (s_ungetc_char_ready_p, "ungetc-char-ready?", 1, 0, 0, scm_ungetc_char_ready_p);
-
-SCM
-scm_ungetc_char_ready_p (port)
- SCM port;
-{
- if (SCM_UNBNDP (port))
- port = scm_cur_inp;
- else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_ungetc_char_ready_p);
- return (SCM_CRDYP (port)
+ return (scm_input_waiting_p ((FILE *) SCM_STREAM (port), s_char_ready_p)
? SCM_BOOL_T
: SCM_BOOL_F);
}
\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
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;
}
\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_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_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]->representation = scm_regular_port;
+ 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--;
}
-#ifdef DEBUG
+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. */
-static char s_pt_size[] = "pt-size";
+SCM_PROC(s_pt_size, "pt-size", 0, 0, 0, scm_pt_size);
SCM
scm_pt_size ()
{
}
/* Return the ith member of the port table. */
-static char s_pt_member[] = "pt-member";
-
+SCM_PROC(s_pt_member, "pt-member", 1, 0, 0, scm_pt_member);
SCM
scm_pt_member (member)
SCM member;
#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.
*/
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;
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.
+ *
+ * See PORT FLAGS in scm.h
+ */
+
+long
+scm_mode_bits (modes)
+ char *modes;
+{
+ return (SCM_OPN
+ | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
+ | ( strchr (modes, 'w')
+ || strchr (modes, 'a')
+ || strchr (modes, '+') ? SCM_WRTNG : 0)
+ | (strchr (modes, '0') ? SCM_BUF0 : 0));
+}
+
+
+/* Return the mode flags from an open port.
+ * Some modes such as "append" are only used when opening
+ * a file and are not returned here. */
+
+SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
+
+SCM
+scm_port_mode (port)
+ SCM port;
+{
+ 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)
+ strcpy (modes, "r+");
+ else
+ strcpy (modes, "r");
+ }
+ else if (SCM_CAR (port) & SCM_WRTNG)
+ strcpy (modes, "w");
+ if (SCM_CAR (port) & SCM_BUF0)
+ strcat (modes, "0");
+ return scm_makfromstr (modes, strlen (modes), 0);
+}
+
+
+\f
+/* Closing ports. */
+
/* scm_close_port
* Call the close operation on a port object.
+ * see also scm_close.
*/
SCM_PROC(s_close_port, "close-port", 1, 0, 0, scm_close_port);
SCM port;
{
scm_sizet i;
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_close_port);
+ int rv;
+
+ 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_UNSPECIFIED;
+ return SCM_BOOL_F;
i = SCM_PTOBNUM (port);
SCM_DEFER_INTS;
if (scm_ptobs[i].fclose)
- SCM_SYSCALL ((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);
+ }
+ else
+ rv = 0;
scm_remove_from_port_table (port);
SCM_SETAND_CAR (port, ~SCM_OPN);
SCM_ALLOW_INTS;
- return SCM_UNSPECIFIED;
+ return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
}
SCM_PROC(s_close_all_ports_except, "close-all-ports-except", 0, 0, 1, scm_close_all_ports_except);
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)
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_eof_object_p (x)
SCM x;
{
- return (SCM_EOF_VAL == x) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_EOF_OBJECT_P (x) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_force_output, "force-output", 0, 1, 0, scm_force_output);
SCM port;
{
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ 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)));
+ SCM_SYSCALL ((scm_ptobs[i].fflush) (port));
return SCM_UNSPECIFIED;
}
}
+SCM_PROC (s_flush_all_ports, "flush-all-ports", 0, 0, 0, scm_flush_all_ports);
+SCM
+scm_flush_all_ports (void)
+{
+ int i;
+
+ for (i = 0; i < scm_port_table_size; i++)
+ {
+ SCM port = scm_port_table[i]->port;
+ if (SCM_OPOUTPORTP (port))
+ {
+ scm_sizet ptob = SCM_PTOBNUM (port);
+ (scm_ptobs[ptob].fflush) (port);
+ }
+ }
+ return SCM_UNSPECIFIED;
+}
SCM_PROC(s_read_char, "read-char", 0, 1, 0, scm_read_char);
port = scm_cur_inp;
else
SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_char);
- c = scm_gen_getc (port);
+ c = scm_getc (port);
if (EOF == c)
return SCM_EOF_VAL;
return SCM_MAKICHR (c);
port = scm_cur_inp;
else
SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_peek_char);
- c = scm_gen_getc (port);
+ c = scm_getc (port);
if (EOF == c)
return SCM_EOF_VAL;
- scm_gen_ungetc (c, port);
+ scm_ungetc (c, port);
return SCM_MAKICHR (c);
}
+/*
+ * A generic fgets method. We supply this method so that ports which
+ * can't use fgets(3) (like string ports or soft ports) can still use
+ * line-based i/o. The generic method calls the port's own fgetc method
+ * for input. It should be possible to write a more efficient
+ * method for any given port representation -- this is supplied just
+ * to ensure that you don't have to.
+ */
+
+char * scm_generic_fgets SCM_P ((SCM port, int *len));
+
+char *
+scm_generic_fgets (port, len)
+ SCM port;
+ int *len;
+{
+ scm_sizet p = SCM_PTOBNUM (port);
+
+ char *buf;
+ int limit = 80; /* current size of buffer */
+ int c;
+
+ /* FIXME: It would be nice to be able to check for EOF before anything. */
+
+ *len = 0;
+ buf = (char *) malloc (limit * sizeof(char));
+
+ /* If a char has been pushed onto the port with scm_ungetc,
+ read that first. */
+ while (SCM_CRDYP (port))
+ {
+ buf[*len] = SCM_CGETUN (port);
+ SCM_TRY_CLRDY (port);
+ if (buf[(*len)++] == '\n' || *len == limit - 1)
+ {
+ buf[*len] = '\0';
+ return buf;
+ }
+ }
+
+ while (1) {
+ if (*len >= limit-1)
+ {
+ buf = (char *) realloc (buf, sizeof(char) * limit * 2);
+ limit *= 2;
+ }
+
+ c = (scm_ptobs[p].fgetc) (port);
+ if (c != EOF)
+ buf[(*len)++] = c;
+
+ if (c == EOF || c == '\n')
+ {
+ if (*len)
+ {
+ buf[*len] = '\0';
+ return buf;
+ }
+ free (buf);
+ return NULL;
+ }
+ }
+}
+
SCM_PROC (s_unread_char, "unread-char", 2, 0, 0, scm_unread_char);
SCM
c = SCM_ICHR (cobj);
- scm_gen_ungetc (c, port);
+ scm_ungetc (c, port);
return cobj;
}
+SCM_PROC (s_unread_string, "unread-string", 2, 0, 0, scm_unread_string);
+SCM
+scm_unread_string (str, port)
+ SCM str;
+ SCM port;
+{
+ SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str),
+ str, SCM_ARG1, s_unread_string);
+
+ if (SCM_UNBNDP (port))
+ port = scm_cur_inp;
+ else
+ SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
+ port, SCM_ARG2, s_unread_string);
-SCM_PROC (s_port_line, "port-line", 0, 1, 0, scm_port_line);
+ scm_ungets (SCM_ROUCHARS (str), SCM_LENGTH (str), port);
+
+ return str;
+}
+
+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;
}
SCM port;
char *type;
{
- scm_gen_puts (scm_regular_string, "#<", port);
+ scm_puts ("#<", port);
if (SCM_CLOSEDP (exp))
- scm_gen_puts (scm_regular_string, "closed: ", port);
+ scm_puts ("closed: ", port);
else
{
if (SCM_RDNG & SCM_CAR (exp))
- scm_gen_puts (scm_regular_string, "input: ", port);
+ scm_puts ("input: ", port);
if (SCM_WRTNG & SCM_CAR (exp))
- scm_gen_puts (scm_regular_string, "output: ", port);
+ scm_puts ("output: ", port);
}
- scm_gen_puts (scm_regular_string, type, port);
- scm_gen_putc (' ', port);
+ scm_puts (type, port);
+ scm_putc (' ', port);
#ifndef MSDOS
#ifndef __EMX__
#ifndef _DCC
#ifndef AMIGA
#ifndef THINK_C
if (SCM_OPENP (exp) && scm_tc16_fport == SCM_TYP16 (exp) && isatty (fileno ((FILE *)SCM_STREAM (exp))))
- scm_gen_puts (scm_regular_string, ttyname (fileno ((FILE *)SCM_STREAM (exp))), port);
+ scm_puts (ttyname (fileno ((FILE *)SCM_STREAM (exp))), port);
else
#endif
#endif
scm_intprint ((long) fileno ((FILE *)SCM_STREAM (exp)), 10, port);
else
scm_intprint (SCM_CDR (exp), 16, port);
- scm_gen_putc ('>', port);
+ scm_putc ('>', port);
}
/* 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
-print_void_port (exp, port, writing)
- SCM exp;
- SCM port;
- int writing;
+print_void_port (SCM exp, SCM port, scm_print_state *pstate)
{
scm_prinport (exp, port, "void");
return 1;
}
static int
-putc_void_port (c, strm)
- int c;
- SCM strm;
+putc_void_port (int c, SCM port)
{
return 0; /* vestigial return value */
}
static int
-puts_void_port (s, strm)
- char * s;
- SCM strm;
+puts_void_port (char *s, SCM port)
{
return 0; /* vestigial return value */
}
static scm_sizet
-write_void_port (ptr, size, nitems, strm)
- void * ptr;
- int size;
- int 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_P ((SCM strm));
-
static int
-flush_void_port (strm)
- SCM strm;
+flush_void_port (SCM port)
{
return 0;
}
-static int getc_void_port SCM_P ((SCM strm));
-
static int
-getc_void_port (strm)
- SCM strm;
+getc_void_port (SCM port)
{
return EOF;
}
-
-static int close_void_port SCM_P ((SCM strm));
+static char *
+fgets_void_port (SCM port, int *len)
+{
+ return NULL;
+}
static int
-close_void_port (strm)
- SCM strm;
+close_void_port (SCM port)
{
return 0; /* this is ignored by scm_close_port. */
}
-static int noop0 SCM_P ((SCM stream));
-
static int
-noop0 (stream)
- SCM stream;
+noop0 (SCM stream)
{
return 0;
}
-static struct scm_ptobfuns void_port_ptob =
+static struct scm_ptobfuns void_port_ptob =
{
- scm_mark0,
+ 0,
noop0,
print_void_port,
0, /* equal? */
write_void_port,
flush_void_port,
getc_void_port,
+ fgets_void_port,
close_void_port,
};
-\f
-
-
SCM
scm_void_port (mode_str)
char * mode_str;
scm_sys_make_void_port (mode)
SCM mode;
{
- SCM_ASSERT (SCM_NIMP (mode) && SCM_STRINGP (mode), mode,
+ SCM_ASSERT (SCM_NIMP (mode) && SCM_ROSTRINGP (mode), mode,
SCM_ARG1, s_sys_make_void_port);
+ SCM_COERCE_SUBSTR (mode);
return scm_void_port (SCM_ROCHARS (mode));
}
\f
-
+/* Initialization. */
void
scm_init_ports ()
HCoop / bpt / guile.git / blobdiff