-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997 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
*/
/* should be called with SCM_DEFER_INTS active */
-#ifdef __STDC__
-SCM
-scm_setbuf0 (SCM port)
-#else
+
SCM
scm_setbuf0 (port)
SCM port;
-#endif
{
#ifndef NOSETBUF
#ifndef MSDOS
-#ifdef FIONREAD
#ifndef ultrix
SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0););
#endif
#endif
-#endif
#endif
return SCM_UNSPECIFIED;
}
*
* See PORT FLAGS in scm.h
*/
-#ifdef __STDC__
-long
-scm_mode_bits (char *modes)
-#else
+
long
scm_mode_bits (modes)
char *modes;
-#endif
{
return (SCM_OPN
| (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
*
* Return the new port.
*/
+SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file);
-#ifdef __STDC__
SCM
-scm_mkfile (char * name, char * modes)
-#else
-SCM
-scm_mkfile (name, modes)
- char * name;
- char * modes;
-#endif
+scm_open_file (filename, modes)
+ SCM filename;
+ SCM modes;
{
- register SCM port;
+ SCM port;
FILE *f;
+ char *file;
+ char *mode;
+
+ SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file);
+ SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file);
+ if (SCM_SUBSTRP (filename))
+ filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
+ if (SCM_SUBSTRP (modes))
+ modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
+
+ file = SCM_ROCHARS (filename);
+ mode = SCM_ROCHARS (modes);
+
SCM_NEWCELL (port);
SCM_DEFER_INTS;
- SCM_SYSCALL (f = fopen (name, modes));
+ SCM_SYSCALL (f = fopen (file, mode));
if (!f)
{
- SCM_ALLOW_INTS;
- port = SCM_BOOL_F;
+ int en = errno;
+
+ scm_syserror_msg (s_open_file, "%s: %S",
+ scm_listify (scm_makfrom0str (strerror (errno)),
+ filename,
+ SCM_UNDEFINED),
+ en);
}
else
{
struct scm_port_table * pt;
+
pt = scm_add_to_port_table (port);
SCM_SETPTAB_ENTRY (port, pt);
- if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (modes)))
+ SCM_SETCAR (port, scm_tc16_fport | scm_mode_bits (mode));
+ SCM_SETSTREAM (port, (SCM) f);
+ if (SCM_BUF0 & SCM_CAR (port))
scm_setbuf0 (port);
- SCM_SETSTREAM (port, (SCM)f);
- SCM_PTAB_ENTRY (port)->file_name = scm_makfrom0str (name);
- SCM_ALLOW_INTS;
+ SCM_PTAB_ENTRY (port)->file_name = filename;
}
+ SCM_ALLOW_INTS;
return port;
}
-SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file);
-#ifdef __STDC__
-SCM
-scm_open_file (SCM filename, SCM modes)
-#else
+
+/* Build a Scheme port from an open stdio port, FILE.
+ MODE indicates whether FILE is open for reading or writing; it uses
+ the same notation as open-file's second argument.
+ If NAME is non-zero, use it as the port's filename.
+
+ scm_stdio_to_port sets the revealed count for FILE's file
+ descriptor to 1, so that FILE won't be closed when the port object
+ is GC'd. */
SCM
-scm_open_file (filename, modes)
- SCM filename;
- SCM modes;
-#endif
+scm_stdio_to_port (file, mode, name)
+ FILE *file;
+ char *mode;
+ char *name;
{
+ long mode_bits = scm_mode_bits (mode);
SCM port;
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file);
- SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file);
- if (SCM_SUBSTRP (filename))
- filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
- if (SCM_SUBSTRP (modes))
- modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
- port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes));
+ struct scm_port_table * pt;
- if (port == SCM_BOOL_F) {
- SCM_SYSERROR (s_open_file);
- /* Force the compiler to keep filename and modes alive. */
- scm_cons (filename, modes);
+ SCM_NEWCELL (port);
+ SCM_DEFER_INTS;
+ {
+ pt = scm_add_to_port_table (port);
+ SCM_SETPTAB_ENTRY (port, pt);
+ SCM_SETCAR (port, (scm_tc16_fport | mode_bits));
+ SCM_SETSTREAM (port, (SCM) file);
+ if (SCM_BUF0 & SCM_CAR (port))
+ scm_setbuf0 (port);
+ SCM_PTAB_ENTRY (port)->file_name = scm_makfrom0str (name);
}
+ SCM_ALLOW_INTS;
+ scm_set_port_revealed_x (port, SCM_MAKINUM (1));
return port;
}
+
/* 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.
- */
+ * a file and are not returned here. */
SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
-#ifdef __STDC__
-SCM
-scm_port_mode (SCM port)
-#else
+
SCM
scm_port_mode (port)
SCM port;
-#endif
{
char modes[3];
modes[0] = '\0';
}
-#ifdef __STDC__
-static int
-prinfport (SCM exp, SCM port, int writing)
-#else
+
+static int prinfport SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
+
static int
-prinfport (exp, port, writing)
+prinfport (exp, port, pstate)
SCM exp;
SCM port;
- int writing;
-#endif
+ scm_print_state *pstate;
{
SCM name;
char * c;
else
c = "file";
}
-
+
scm_prinport (exp, port, c);
return !0;
}
-#ifdef __STDC__
-static int
-scm_fgetc (FILE * s)
-#else
+
+static int scm_fgetc SCM_P ((FILE * s));
+
static int
scm_fgetc (s)
FILE * s;
-#endif
{
if (feof (s))
return EOF;
}
#ifdef vms
-#ifdef __STDC__
-static scm_sizet
-pwrite (char *ptr, scm_sizet size, nitems, FILE *port)
-#else
+
+static scm_sizet pwrite SCM_P ((char *ptr, scm_sizet size, nitems, FILE *port));
+
static scm_sizet
pwrite (ptr, size, nitems, port)
char *ptr;
scm_sizet size, nitems;
FILE *port;
-#endif
{
scm_sizet len = size * nitems;
scm_sizet i = 0;
/* This otherwise pointless code helps some poor
* crippled C compilers cope with life.
*/
+
+static int local_fclose SCM_P ((FILE *fp));
+
static int
local_fclose (fp)
FILE * fp;
return fclose (fp);
}
+static int local_fflush SCM_P ((FILE *fp));
+
static int
local_fflush (fp)
FILE * fp;
return fflush (fp);
}
+static int local_fputc SCM_P ((int c, FILE *fp));
+
static int
local_fputc (c, fp)
int c;
return fputc (c, fp);
}
+static int local_fputs SCM_P ((char *s, FILE *fp));
+
static int
local_fputs (s, fp)
char * s;
return fputs (s, fp);
}
+static scm_sizet local_ffwrite SCM_P ((void *ptr, int size, int nitems, FILE *fp));
+
static scm_sizet
local_ffwrite (ptr, size, nitems, fp)
void * ptr;
scm_ptobfuns scm_fptob =
{
scm_mark0,
- local_fclose,
+ (int (*) SCM_P ((SCM))) local_fclose,
prinfport,
0,
- local_fputc,
- local_fputs,
- local_ffwrite,
- local_fflush,
- scm_fgetc,
- local_fclose
+ (int (*) SCM_P ((int, SCM))) local_fputc,
+ (int (*) SCM_P ((char *, SCM))) local_fputs,
+ (scm_sizet (*) SCM_P ((char *, scm_sizet, scm_sizet, SCM))) local_ffwrite,
+ (int (*) SCM_P ((SCM))) local_fflush,
+ (int (*) SCM_P ((SCM))) scm_fgetc,
+ (int (*) SCM_P ((SCM))) local_fclose
};
/* {Pipe ports}
0, /* replaced by pclose in scm_init_ioext() */
0, /* replaced by prinpipe in scm_init_ioext() */
0,
- local_fputc,
- local_fputs,
- local_ffwrite,
- local_fflush,
- scm_fgetc,
+ (int (*) SCM_P ((int, SCM))) local_fputc,
+ (int (*) SCM_P ((char *, SCM))) local_fputs,
+ (scm_sizet (*) SCM_P ((char *, scm_sizet, scm_sizet, SCM))) local_ffwrite,
+ (int (*) SCM_P ((SCM))) local_fflush,
+ (int (*) SCM_P ((SCM))) scm_fgetc,
0
}; /* replaced by pclose in scm_init_ioext() */
-
-#ifdef __STDC__
-void
-scm_init_fports (void)
-#else
void
scm_init_fports ()
-#endif
{
#include "fports.x"
}
-
HCoop / bpt / guile.git / blobdiff