summaryrefslogtreecommitdiffstats
path: root/ioext.c
diff options
context:
space:
mode:
Diffstat (limited to 'ioext.c')
-rw-r--r--ioext.c92
1 files changed, 64 insertions, 28 deletions
diff --git a/ioext.c b/ioext.c
index 4e0002d..1d7f68b 100644
--- a/ioext.c
+++ b/ioext.c
@@ -1,18 +1,18 @@
/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 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
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
- *
+ *
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
- *
+ *
* 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, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
@@ -36,7 +36,7 @@
*
* 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.
*/
/* "ioext.c" code for system calls in common between PC compilers and unix.
@@ -53,7 +53,7 @@
# include <stat.h>
# else
# include <sys/stat.h>
-#endif
+# endif
# ifdef __TURBOC__
# include <io.h>
@@ -67,7 +67,7 @@ SCM stat2scm P((struct stat *stat_temp));
#ifdef __sgi__
# include <unistd.h>
#endif
-#ifdef freebsd
+#ifdef __FreeBSD__
# include <unistd.h>
#endif
/* added by Denys Duchier */
@@ -78,6 +78,9 @@ SCM stat2scm P((struct stat *stat_temp));
#ifdef linux
# include <unistd.h>
#endif
+#ifdef GO32
+# include <unistd.h>
+#endif
#ifndef STDC_HEADERS
int chdir P((const char *path));
@@ -211,18 +214,27 @@ SCM reopen_file(filename, modes, port)
SCM filename, modes, port;
{
FILE *f;
+ char cmodes[4];
+ long flags;
ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file);
ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_reopen_file);
+ flags = mode_bits(CHARS(modes), cmodes);
DEFER_INTS;
ASSERT(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file);
- SYSCALL(f = freopen(CHARS(filename), CHARS(modes), STREAM(port)););
- if (!f) port = BOOL_F;
+ SCM_OPENCALL(f = freopen(CHARS(filename), cmodes, STREAM(port)));
+ if (!f) {
+ ALLOW_INTS;
+ return BOOL_F;
+ }
else {
SETSTREAM(port, f);
- if (BUF0 & (CAR(port) = tc16_fport | mode_bits(CHARS(modes))))
+ SCM_PORTFLAGS(port) = flags;
+ CAR(port) = scm_port_entry(tc16_fport, flags);
+ if (BUF0 & flags)
i_setbuf0(port);
}
ALLOW_INTS;
+ SCM_PORTDATA(port) = filename;
return port;
}
@@ -232,22 +244,26 @@ static char s_dup[]="duplicate-port";
SCM l_dup(oldpt, modes)
SCM oldpt, modes;
{
+ long flags;
+ char cmodes[4];
int tfd;
FILE *f;
SCM newpt;
- ASSERT(NIMP(oldpt) && OPPORTP(oldpt), oldpt, ARG1, s_dup);
+ ASSERT(NIMP(oldpt) && OPFPORTP(oldpt), oldpt, ARG1, s_dup);
ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_dup);
+ flags = mode_bits(CHARS(modes), cmodes);
NEWCELL(newpt);
DEFER_INTS;
- SYSCALL(tfd = dup(fileno(STREAM(oldpt))););
+ SCM_OPENCALL(tfd = dup(fileno(STREAM(oldpt))));
if (-1==tfd) {ALLOW_INTS;return BOOL_F;};
- SYSCALL(f = fdopen(tfd, CHARS(modes)););
+ SYSCALL(f = fdopen(tfd, cmodes););
if (!f) {
close(tfd);
wta(MAKINUM(tfd), (char *)NALLOC, s_port_type);
}
SETSTREAM(newpt, f);
- if (BUF0 & (CAR(newpt) = tc16_fport | mode_bits(CHARS(modes))))
+ CAR(newpt) = scm_port_entry(tc16_fport, flags);
+ if (BUF0 & flags)
i_setbuf0(newpt);
ALLOW_INTS;
return newpt;
@@ -258,11 +274,11 @@ SCM l_dup2(into_pt, from_pt)
{
int ans, oldfd, newfd;
DEFER_INTS;
- ASSERT(NIMP(into_pt) && OPPORTP(into_pt), into_pt, ARG1, s_dup2);
- ASSERT(NIMP(from_pt) && OPPORTP(from_pt), from_pt, ARG1, s_dup2);
+ ASSERT(NIMP(into_pt) && OPFPORTP(into_pt), into_pt, ARG1, s_dup2);
+ ASSERT(NIMP(from_pt) && OPFPORTP(from_pt), from_pt, ARG1, s_dup2);
oldfd = fileno(STREAM(into_pt));
newfd = fileno(STREAM(from_pt));
- SYSCALL(ans = dup2(oldfd, newfd););
+ SCM_OPENCALL(ans = dup2(oldfd, newfd));
if (-1==ans) {ALLOW_INTS;return BOOL_F;};
ALLOW_INTS;
return into_pt;
@@ -281,7 +297,7 @@ SCM l_opendir(dirname)
ASSERT(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir);
NEWCELL(dir);
DEFER_INTS;
- SYSCALL(ds = opendir(CHARS(dirname)););
+ SCM_OPENCALL(ds = opendir(CHARS(dirname)));
if (!ds) {ALLOW_INTS; return BOOL_F;}
CAR(dir) = tc16_dir | OPN;
SETCDR(dir, ds);
@@ -573,11 +589,10 @@ SCM l_getpid()
#ifndef __IBMC__
# ifndef macintosh
# ifndef __WATCOMC__
-# ifndef GO32
-# ifndef _Windows
-# ifdef __TURBOC__
-# include <process.h>
-# endif
+# ifndef _Windows
+# ifdef __TURBOC__
+# include <process.h>
+# endif
char s_execv[] = "execv";
char s_execvp[] = "execvp";
SCM i_execv(modes, path, args)
@@ -588,7 +603,7 @@ SCM i_execv(modes, path, args)
int i = ilength(args);
ASSERT(i>0, args, WNA, s_execv);
ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_execv);
- /* dowinds(EOL, ilength(dynwinds)); */
+ /* dowinds(EOL); */
args = cons(path, args);
DEFER_INTS;
execargv = makargvfrmstrs(args, s_execv);
@@ -626,7 +641,6 @@ SCM l_putenv(str)
ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_putenv);
return putenv(CHARS(str)) ? BOOL_F : BOOL_T;
}
-# endif
# endif
# endif
# endif
@@ -706,18 +720,40 @@ void init_ioext()
#ifndef __IBMC__
# ifndef macintosh
# ifndef __WATCOMC__
-# ifndef GO32
-# ifndef _Windows
+# ifndef _Windows
make_subr(s_execv, tc7_subr_2, lexecv);
make_subr(s_execvp, tc7_subr_2, lexecvp);
make_subr("execl", tc7_lsubr_2, lexec);
make_subr("execlp", tc7_lsubr_2, lexecp);
make_subr(s_putenv, tc7_subr_1, l_putenv);
-# endif
# endif
# endif
# endif
#endif
add_feature("i/o-extensions");
add_feature("line-i/o");
+ scm_ldstr("\n\
+(define (directory-for-each proc dirname . args)\n\
+ (define dir (opendir (if (symbol? dirname)\n\
+ (symbol->string dirname)\n\
+ dirname)))\n\
+ (if dir\n\
+ (let ((selector\n\
+ (cond ((null? args) identity)\n\
+ ((> (length args) 1)\n\
+ (slib:error 'directory-for-each\n\
+ 'too-many-arguments\n\
+ (cdr args)))\n\
+ ((procedure? (car args)) (car args))\n\
+ ((string? (car args))\n\
+ (require 'glob)\n\
+ (filename:match?? (car args)))\n\
+ (else (slib:error 'directory-for-each\n\
+ 'unknown-selector-type\n\
+ (car args))))))\n\
+ (do ((filename (readdir dir) (readdir dir)))\n\
+ ((not filename) (closedir dir))\n\
+ (and (selector filename) (proc filename))))))\n\
+");
+ add_feature("directory-for-each");
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 17:54:12 +0000