summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--NEWS67
-rw-r--r--ice-9/ChangeLog5
-rw-r--r--ice-9/boot-9.scm6
-rw-r--r--libguile/ChangeLog31
-rw-r--r--libguile/filesys.c295
-rw-r--r--libguile/filesys.h13
-rw-r--r--libguile/ioext.c49
-rw-r--r--libguile/ioext.h4
-rw-r--r--libguile/posix.c139
-rw-r--r--libguile/posix.h5
-rw-r--r--libguile/stime.c23
-rw-r--r--libguile/stime.h1
12 files changed, 469 insertions, 169 deletions
diff --git a/NEWS b/NEWS
index b68e77b9a..1c59a03b6 100644
--- a/NEWS
+++ b/NEWS
@@ -65,6 +65,15 @@ was successfully closed, while #f means it was already closed. It is
also now possible for these procedures to raise an exception if an
error occurs (some errors from write can be delayed until close.)
+** the first argument to chmod, fcntl, ftell and fseek can now be a
+file descriptor.
+
+** the third argument to fcntl is now optional.
+
+** the first argument to chown can now be a file descriptor or a port.
+
+** the argument to stat can now be a port.
+
** The following new procedures have been added (most use scsh
interfaces):
@@ -119,6 +128,14 @@ If VALUE is `#f', removes NAME from the environment. Otherwise
adds the string NAME=VALUE to the environment, replacing any previous
value for NAME.
+** truncate-file OBJ SIZE
+ Truncates the file referred to by OBJ to at most SIZE bytes. OBJ
+ can be a string containing a file name or an integer file
+ descriptor or port open for output on the file. The underlying
+ system calls are `truncate' and `ftruncate'.
+
+ The return value is unspecified.
+
** setvbuf PORT MODE [SIZE]
Set the buffering mode for PORT. MODE can be:
`_IONBF'
@@ -139,9 +156,53 @@ value for NAME.
size. Procedures e.g., *Note open-file: File Ports, which accept a
mode string allow `0' to be added to request an unbuffered port.
-** primitive-exit [STATUS]
-Terminates the current process without unwinding the Scheme stack.
-This would usually be used after a fork.
+** fsync PORT/FD
+ Copies any unwritten data for the specified output file descriptor
+ to disk. If PORT/FD is a port, its buffer is flushed before the
+ underlying file descriptor is fsync'd. The return value is
+ unspecified.
+
+** open-fdes PATH FLAGS [MODES]
+ Similar to `open' but returns a file descriptor instead of a port.
+
+** procedure: execle PATH ENV [ARG] ...
+ Similar to `execl', but the environment of the new process is
+ specified by ENV, which must be a list of strings as returned by
+ the `environ' procedure.
+
+ This procedure is currently implemented using the `execve' system
+ call, but we call it `execle' because of its Scheme calling
+ interface.
+
+** procedure: primitive-exit [STATUS]
+ Terminate the current process without unwinding the Scheme stack.
+ This is would typically be useful after a fork. The exit status
+ is STATUS if supplied, otherwise zero.
+
+** procedure: times
+ Returns an object with information about real and processor time.
+ The following procedures accept such an object as an argument and
+ return a selected component:
+
+ `tms:clock'
+ The current real time, expressed as time units relative to an
+ arbitrary base.
+
+ `tms:utime'
+ The CPU time units used by the calling process.
+
+ `tms:stime'
+ The CPU time units used by the system on behalf of the
+ calling process.
+
+ `tms:cutime'
+ The CPU time units used by terminated child processes of the
+ calling process, whose status has been collected (e.g., using
+ `waitpid').
+
+ `tms:cstime'
+ Similarly, the CPU times units used by the system on behalf of
+ terminated child processes.
* Changes to the gh_ interface
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 42a9cac00..80581235f 100644
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,8 @@
+Sat Aug 16 18:44:24 1997 Gary Houston <ghouston@actrix.gen.nz>
+
+ * boot-9.scm: define tms accessors: clock, utime, stime, cutime,
+ cstime.
+
Thu Aug 14 19:55:37 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* emacs.scm (emacs-load): Something has changed in the reader so
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index ec6ed2272..85f406f53 100644
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -760,6 +760,12 @@
(define (set-tm:gmtoff obj val) (vector-set! obj 9 val))
(define (set-tm:zone obj val) (vector-set! obj 10 val))
+(define (tms:clock obj) (vector-ref obj 0))
+(define (tms:utime obj) (vector-ref obj 1))
+(define (tms:stime obj) (vector-ref obj 2))
+(define (tms:cutime obj) (vector-ref obj 3))
+(define (tms:cstime obj) (vector-ref obj 4))
+
(define (file-position . args) (apply ftell args))
(define (file-set-position . args) (apply fseek args))
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 2771382db..e48f5abbe 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,34 @@
+Sat Aug 16 18:42:15 1997 Gary Houston <ghouston@actrix.gen.nz>
+
+ * stime.h: prototype for scm_times.
+ * stime.c (scm_times): new procedure.
+ * ioext.c (scm_fseek): if the first argument is a file descriptor
+ call lseek.
+ (scm_ftell): if the first argument is a file descriptor call lseek
+ (sic).
+ * filesys.h: prototypes for scm_open_fdes, scm_fsync.
+ * filesys.c (scm_chmod): if the first argument is a file descriptor,
+ call fchmod.
+ (scm_chown): if the first argument is a port or file descriptor,
+ call fchown.
+ (scm_truncate_file): new procedure.
+ Add DEFER/ALLOW INTS to a few other procedures.
+ (scm_fsync): new procedure.
+ (scm_open_fdes): new procedure.
+ (scm_open): use scm_open_fdes. If mode isn't specified, 666 will
+ now be used.
+ (scm_fcntl): the first argument can now be a file descriptor. The
+ third argument is now optional.
+
+ * posix.c (scm_execl, scm_execlp): make the filename argument
+ compulsory, since omitting it causes SEGV.
+ (scm_sync): return unspecified instead of #f.
+ (scm_execle): new procedure.
+ (environ_list_to_c): new procedure.
+ (scm_environ): use environ_list_to_c. disable interrupts.
+ (scm_convert_exec_args): take pos and subr arguments and
+ improve error checking.
+
1997-08-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* stacks.c (scm_make_stack), coop-threads.c, mit-pthreads.c
diff --git a/libguile/filesys.c b/libguile/filesys.c
index b2b13244a..8be71a562 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -131,22 +131,40 @@
SCM_PROC (s_chown, "chown", 3, 0, 0, scm_chown);
SCM
-scm_chown (path, owner, group)
- SCM path;
+scm_chown (object, owner, group)
+ SCM object;
SCM owner;
SCM group;
{
- int val;
+ int rv;
+ int fdes;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_chown);
SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_chown);
SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown);
-
- SCM_COERCE_SUBSTR (path);
- SCM_SYSCALL (val = chown (SCM_ROCHARS (path),
- SCM_INUM (owner), SCM_INUM (group)));
- if (val != 0)
+ SCM_DEFER_INTS;
+ if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
+ {
+ if (SCM_INUMP (object))
+ fdes = SCM_INUM (object);
+ else
+ {
+ fdes = fileno ((FILE *) SCM_STREAM (object));
+ if (fdes == -1)
+ scm_syserror (s_chown);
+ }
+ SCM_SYSCALL (rv = fchown (fdes, SCM_INUM (owner), SCM_INUM (group)));
+ }
+ else
+ {
+ SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
+ object, SCM_ARG1, s_chown);
+ SCM_COERCE_SUBSTR (object);
+ SCM_SYSCALL (rv = chown (SCM_ROCHARS (object),
+ SCM_INUM (owner), SCM_INUM (group)));
+ }
+ if (rv == -1)
scm_syserror (s_chown);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
@@ -154,27 +172,37 @@ scm_chown (path, owner, group)
SCM_PROC (s_chmod, "chmod", 2, 0, 0, scm_chmod);
SCM
-scm_chmod (port_or_path, mode)
- SCM port_or_path;
+scm_chmod (object, mode)
+ SCM object;
SCM mode;
{
int rv;
+ int fdes;
+
SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod);
- SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_chmod);
- if (SCM_ROSTRINGP (port_or_path))
+ SCM_DEFER_INTS;
+ if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
{
- SCM_COERCE_SUBSTR (port_or_path);
- SCM_SYSCALL (rv = chmod (SCM_ROCHARS (port_or_path), SCM_INUM (mode)));
+ if (SCM_INUMP (object))
+ fdes = SCM_INUM (object);
+ else
+ {
+ fdes = fileno ((FILE *) SCM_STREAM (object));
+ if (fdes == -1)
+ scm_syserror (s_chmod);
+ }
+ SCM_SYSCALL (rv = fchmod (fdes, SCM_INUM (mode)));
}
else
{
- SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_chmod);
- rv = fileno ((FILE *)SCM_STREAM (port_or_path));
- if (rv != -1)
- SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode)));
+ SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
+ object, SCM_ARG1, s_chmod);
+ SCM_COERCE_SUBSTR (object);
+ SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode)));
}
- if (rv != 0)
+ if (rv == -1)
scm_syserror (s_chmod);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
@@ -200,36 +228,46 @@ scm_umask (mode)
-SCM_PROC (s_open, "open", 2, 1, 0, scm_open);
-
+SCM_PROC (s_open_fdes, "open-fdes", 2, 1, 0, scm_open_fdes);
SCM
-scm_open (path, flags, mode)
- SCM path;
- SCM flags;
- SCM mode;
+scm_open_fdes (SCM path, SCM flags, SCM mode)
{
int fd;
- SCM newpt;
- FILE *f;
- char *port_mode;
int iflags;
+ int imode;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_open);
- iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open);
-
- if (SCM_SUBSTRP (path))
- path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
+ SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
+ s_open_fdes);
+ SCM_COERCE_SUBSTR (path);
+ iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
SCM_DEFER_INTS;
if (SCM_UNBNDP (mode))
- SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags));
+ imode = 0666;
else
{
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open);
- SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, SCM_INUM (mode)));
+ SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open_fdes);
+ imode = SCM_INUM (mode);
}
+ SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode));
if (fd == -1)
- scm_syserror (s_open);
+ scm_syserror (s_open_fdes);
+ SCM_ALLOW_INTS;
+ return SCM_MAKINUM (fd);
+}
+
+SCM_PROC (s_open, "open", 2, 1, 0, scm_open);
+SCM
+scm_open (SCM path, SCM flags, SCM mode)
+{
+ SCM newpt;
+ char *port_mode;
+ int fd;
+ FILE *f;
+ int iflags;
+
+ fd = SCM_INUM (scm_open_fdes (path, flags, mode));
+ iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
SCM_NEWCELL (newpt);
if (iflags & O_RDWR)
port_mode = "r+";
@@ -239,6 +277,7 @@ scm_open (path, flags, mode)
else
port_mode = "r";
}
+ SCM_DEFER_INTS;
f = fdopen (fd, port_mode);
if (!f)
{
@@ -390,40 +429,44 @@ scm_stat2scm (stat_temp)
SCM_PROC (s_stat, "stat", 1, 0, 0, scm_stat);
SCM
-scm_stat (file)
- SCM file;
+scm_stat (object)
+ SCM object;
{
- int rv = 1;
+ int rv;
+ int fdes;
struct stat stat_temp;
- if (SCM_INUMP (file))
- SCM_SYSCALL (rv = fstat (SCM_INUM (file), &stat_temp));
- else
+ SCM_DEFER_INTS;
+ if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
{
- SCM_ASSERT (SCM_NIMP (file), file, SCM_ARG1, s_stat);
- if (SCM_FPORTP (file))
- SCM_SYSCALL (rv = fstat (fileno ((FILE *) SCM_STREAM (file)),
- &stat_temp));
+ if (SCM_INUMP (object))
+ fdes = SCM_INUM (object);
else
{
- SCM_ASSERT (SCM_ROSTRINGP (file), file, SCM_ARG1, s_stat);
- if (SCM_SUBSTRP (file))
- file = scm_makfromstr (SCM_ROCHARS (file),
- SCM_ROLENGTH (file),
- 0);
- SCM_SYSCALL (rv = stat (SCM_CHARS (file), &stat_temp));
+ fdes = fileno ((FILE *) SCM_STREAM (object));
+ if (fdes == -1)
+ scm_syserror (s_stat);
}
+ SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
}
- if (rv != 0)
+ else
+ {
+ SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
+ object, SCM_ARG1, s_stat);
+ SCM_COERCE_SUBSTR (object);
+ SCM_SYSCALL (rv = stat (SCM_ROCHARS (object), &stat_temp));
+ }
+ if (rv == -1)
{
int en = errno;
scm_syserror_msg (s_stat, "%s: %S",
scm_listify (scm_makfrom0str (strerror (errno)),
- file,
+ object,
SCM_UNDEFINED),
en);
}
+ SCM_ALLOW_INTS;
return scm_stat2scm (&stat_temp);
}
@@ -441,15 +484,21 @@ scm_link (oldpath, newpath)
{
int val;
- SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1, s_link);
+ SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath,
+ SCM_ARG1, s_link);
if (SCM_SUBSTRP (oldpath))
- oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), SCM_ROLENGTH (oldpath), 0);
- SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath, SCM_ARG2, s_link);
+ oldpath = scm_makfromstr (SCM_ROCHARS (oldpath),
+ SCM_ROLENGTH (oldpath), 0);
+ SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath,
+ SCM_ARG2, s_link);
if (SCM_SUBSTRP (newpath))
- newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath), 0);
+ newpath = scm_makfromstr (SCM_ROCHARS (newpath),
+ SCM_ROLENGTH (newpath), 0);
+ SCM_DEFER_INTS;
SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
if (val != 0)
scm_syserror (s_link);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
@@ -469,13 +518,10 @@ scm_rename (oldname, newname)
s_rename);
SCM_COERCE_SUBSTR (oldname);
SCM_COERCE_SUBSTR (newname);
+ SCM_DEFER_INTS;
#ifdef HAVE_RENAME
SCM_SYSCALL (rv = rename (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
- if (rv != 0)
- scm_syserror (s_rename);
- return SCM_UNSPECIFIED;
#else
- SCM_DEFER_INTS;
SCM_SYSCALL (rv = link (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
if (rv == 0)
{
@@ -484,11 +530,11 @@ scm_rename (oldname, newname)
/* unlink failed. remove new name */
SCM_SYSCALL (unlink (SCM_ROCHARS (newname)));
}
- SCM_ALLOW_INTS;
+#endif
if (rv != 0)
scm_syserror (s_rename);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
-#endif
}
@@ -499,14 +545,51 @@ scm_delete_file (str)
SCM str;
{
int ans;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_delete_file);
+ SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1,
+ s_delete_file);
SCM_COERCE_SUBSTR (str);
+ SCM_DEFER_INTS;
SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str)));
if (ans != 0)
scm_syserror (s_delete_file);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
+SCM_PROC (s_truncate_file, "truncate-file", 2, 0, 0, scm_truncate_file);
+SCM
+scm_truncate_file (SCM object, SCM size)
+{
+ int rv;
+ scm_sizet csize;
+ int fdes;
+
+ csize = (scm_sizet) scm_num2long (size, (char *) SCM_ARG2, s_truncate_file);
+ SCM_DEFER_INTS;
+ if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
+ {
+ if (SCM_INUMP (object))
+ fdes = SCM_INUM (object);
+ else
+ {
+ fdes = fileno ((FILE *) SCM_STREAM (object));
+ if (fdes == -1)
+ scm_syserror (s_truncate_file);
+ }
+ SCM_SYSCALL (rv = ftruncate (fdes, csize));
+ }
+ else
+ {
+ SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
+ object, SCM_ARG1, s_chown);
+ SCM_COERCE_SUBSTR (object);
+ SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), csize));
+ }
+ if (rv == -1)
+ scm_syserror (s_truncate_file);
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
+}
SCM_PROC (s_mkdir, "mkdir", 1, 1, 0, scm_mkdir);
@@ -521,6 +604,7 @@ scm_mkdir (path, mode)
SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
s_mkdir);
SCM_COERCE_SUBSTR (path);
+ SCM_DEFER_INTS;
if (SCM_UNBNDP (mode))
{
mask = umask (0);
@@ -534,6 +618,7 @@ scm_mkdir (path, mode)
}
if (rv != 0)
scm_syserror (s_mkdir);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
#else
scm_sysmissing (s_mkdir);
@@ -555,9 +640,11 @@ scm_rmdir (path)
SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
s_rmdir);
SCM_COERCE_SUBSTR (path);
+ SCM_DEFER_INTS;
SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path)));
if (val != 0)
scm_syserror (s_rmdir);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
#else
scm_sysmissing (s_rmdir);
@@ -695,9 +782,11 @@ scm_chdir (str)
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_chdir);
SCM_COERCE_SUBSTR (str);
+ SCM_DEFER_INTS;
SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str)));
if (ans != 0)
scm_syserror (s_chdir);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
@@ -1016,30 +1105,64 @@ scm_input_waiting_p (f, caller)
-SCM_PROC (s_fcntl, "fcntl", 3, 0, 0, scm_fcntl);
-
+SCM_PROC (s_fcntl, "fcntl", 2, 0, 1, scm_fcntl);
SCM
-scm_fcntl (port, cmd, value)
- SCM port;
- SCM cmd;
- SCM value;
+scm_fcntl (SCM object, SCM cmd, SCM value)
{
int rv;
+ int fdes;
+ int ivalue;
- SCM_ASSERT (SCM_OPFPORTP (port), port, SCM_ARG1, s_fcntl);
SCM_ASSERT (SCM_INUMP (cmd), cmd, SCM_ARG2, s_fcntl);
- SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG3, s_fcntl);
-
- rv = fileno ((FILE *)SCM_STREAM (port));
- if (rv != -1)
- SCM_SYSCALL (rv = fcntl (rv, SCM_INUM (cmd), SCM_INUM (value)));
- if (rv == -1)
+ if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+ fdes = fileno ((FILE *) SCM_STREAM (object));
+ else
+ {
+ SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fcntl);
+ fdes = SCM_INUM (object);
+ }
+ if (SCM_NULLP (value))
+ ivalue = 0;
+ else
+ {
+ SCM_ASSERT (SCM_INUMP (SCM_CAR (value)), value, SCM_ARG3, s_fcntl);
+ ivalue = SCM_INUM (SCM_CAR (value));
+ }
+ SCM_DEFER_INTS;
+ if (fdes != -1)
+ SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
+ else
+ rv = 0; /* avoid compiler warning. */
+ if (rv == -1 || fdes == -1)
scm_syserror (s_fcntl);
+ SCM_ALLOW_INTS;
return SCM_MAKINUM (rv);
}
-
-/* {Symbolic Links}
- */
+
+SCM_PROC (s_fsync, "fsync", 1, 0, 0, scm_fsync);
+SCM
+scm_fsync (SCM object)
+{
+ int fdes;
+
+ SCM_DEFER_INTS;
+ if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+ {
+ scm_force_output (object);
+ fdes = fileno ((FILE *) SCM_STREAM (object));
+ if (fdes == -1)
+ scm_syserror (s_fsync);
+ }
+ else
+ {
+ SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fsync);
+ fdes = SCM_INUM (object);
+ }
+ if (fsync (fdes) == -1)
+ scm_syserror (s_fsync);
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
+}
SCM_PROC (s_symlink, "symlink", 2, 0, 0, scm_symlink);
@@ -1057,9 +1180,11 @@ scm_symlink(oldpath, newpath)
s_symlink);
SCM_COERCE_SUBSTR (oldpath);
SCM_COERCE_SUBSTR (newpath);
+ SCM_DEFER_INTS;
SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath)));
if (val != 0)
scm_syserror (s_symlink);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
#else
scm_sysmissing (s_symlink);
@@ -1118,6 +1243,7 @@ scm_lstat(str)
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, (char *) SCM_ARG1,
s_lstat);
SCM_COERCE_SUBSTR (str);
+ SCM_DEFER_INTS;
SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp));
if (rv != 0)
{
@@ -1129,6 +1255,7 @@ scm_lstat(str)
SCM_UNDEFINED),
en);
}
+ SCM_ALLOW_INTS;
return scm_stat2scm(&stat_temp);
#else
scm_sysmissing (s_lstat);
@@ -1216,7 +1343,7 @@ scm_sysintern ("O_TRUNC", scm_long2num (O_TRUNC));
#ifdef O_APPEND
scm_sysintern ("O_APPEND", scm_long2num (O_APPEND));
#endif
-#ifdef O_NONBLO
+#ifdef O_NONBLOCK
scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
#endif
#ifdef O_NDELAY
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 3c251919b..f6f6fba61 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -54,15 +54,17 @@ extern long scm_tc16_dir;
#define SCM_OPDIRP(x) (SCM_CAR(x)==(scm_tc16_dir | SCM_OPN))
-extern SCM scm_chown SCM_P ((SCM path, SCM owner, SCM group));
-extern SCM scm_chmod SCM_P ((SCM port_or_path, SCM mode));
+extern SCM scm_chown SCM_P ((SCM object, SCM owner, SCM group));
+extern SCM scm_chmod SCM_P ((SCM object, SCM mode));
extern SCM scm_umask SCM_P ((SCM mode));
-extern SCM scm_open SCM_P ((SCM path, SCM flags, SCM mode));
+extern SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
+extern SCM scm_open (SCM path, SCM flags, SCM mode);
extern SCM scm_close (SCM fd_or_port);
-extern SCM scm_stat SCM_P ((SCM fd_or_path));
+extern SCM scm_stat SCM_P ((SCM object));
extern SCM scm_link SCM_P ((SCM oldpath, SCM newpath));
extern SCM scm_rename SCM_P ((SCM oldname, SCM newname));
extern SCM scm_delete_file SCM_P ((SCM str));
+extern SCM scm_truncate_file (SCM object, SCM size);
extern SCM scm_mkdir SCM_P ((SCM path, SCM mode));
extern SCM scm_rmdir SCM_P ((SCM path));
extern SCM scm_opendir SCM_P ((SCM dirname));
@@ -73,7 +75,8 @@ extern SCM scm_chdir SCM_P ((SCM str));
extern SCM scm_getcwd SCM_P ((void));
extern SCM scm_select SCM_P ((SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs));
extern int scm_input_waiting_p SCM_P ((FILE *file, char *caller));
-extern SCM scm_fcntl SCM_P ((SCM port, SCM cmd, SCM value));
+extern SCM scm_fcntl (SCM object, SCM cmd, SCM value);
+extern SCM scm_fsync (SCM object);
extern SCM scm_symlink SCM_P ((SCM oldpath, SCM newpath));
extern SCM scm_readlink SCM_P ((SCM path));
extern SCM scm_lstat SCM_P ((SCM str));
diff --git a/libguile/ioext.c b/libguile/ioext.c
index 3a4cdec98..b47c15076 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -172,16 +172,25 @@ scm_write_line (obj, port)
SCM_PROC (s_ftell, "ftell", 1, 0, 0, scm_ftell);
SCM
-scm_ftell (port)
- SCM port;
+scm_ftell (object)
+ SCM object;
{
long pos;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_ftell);
- SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port)));
+ SCM_DEFER_INTS;
+ if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+ {
+ SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (object)));
+ if (pos > 0 && SCM_CRDYP (object))
+ pos--;
+ }
+ else
+ {
+ SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_ftell);
+ SCM_SYSCALL (pos = lseek (SCM_INUM (object), 0, SEEK_CUR));
+ }
if (pos < 0)
scm_syserror (s_ftell);
- if (pos > 0 && SCM_CRDYP (port))
- pos--;
+ SCM_ALLOW_INTS;
return scm_long2num (pos);
}
@@ -190,29 +199,33 @@ scm_ftell (port)
SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek);
SCM
-scm_fseek (port, offset, whence)
- SCM port;
+scm_fseek (object, offset, whence)
+ SCM object;
SCM offset;
SCM whence;
{
int rv;
long loff;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fseek);
loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
- SCM_ASSERT (SCM_INUMP (whence) && (SCM_INUM (whence) < 3) && (SCM_INUM (whence) >= 0),
- whence, SCM_ARG3, s_fseek);
-
- SCM_CLRDY (port); /* Clear ungetted char */
- /* Values of whence are interned in scm_init_ioext. */
- rv = fseek ((FILE *)SCM_STREAM (port), loff, SCM_INUM (whence));
- if (rv != 0)
+ SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek);
+ SCM_DEFER_INTS;
+ if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+ {
+ SCM_CLRDY (object); /* Clear ungetted char */
+ rv = fseek ((FILE *)SCM_STREAM (object), loff, SCM_INUM (whence));
+ }
+ else
+ {
+ SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fseek);
+ rv = lseek (SCM_INUM (object), loff, SCM_INUM (whence));
+ }
+ if (rv < 0)
scm_syserror (s_fseek);
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
-
-
SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen);
SCM
diff --git a/libguile/ioext.h b/libguile/ioext.h
index ef9f8d1da..803dc3294 100644
--- a/libguile/ioext.h
+++ b/libguile/ioext.h
@@ -50,8 +50,8 @@
extern SCM scm_read_delimited_x SCM_P ((SCM delims, SCM buf, SCM gobble, SCM port, SCM offset, SCM length));
extern SCM scm_write_line SCM_P ((SCM obj, SCM port));
-extern SCM scm_ftell SCM_P ((SCM port));
-extern SCM scm_fseek SCM_P ((SCM port, SCM offset, SCM whence));
+extern SCM scm_ftell SCM_P ((SCM object));
+extern SCM scm_fseek SCM_P ((SCM object, SCM offset, SCM whence));
extern SCM scm_freopen SCM_P ((SCM filename, SCM modes, SCM port));
extern SCM scm_redirect_port SCM_P ((SCM into_pt, SCM from_pt));
extern SCM scm_dup_to_fdes (SCM fd_or_port, SCM newfd);
diff --git a/libguile/posix.c b/libguile/posix.c
index 048ac55bc..3cc00a030 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -719,28 +719,29 @@ scm_tcsetpgrp (port, pgid)
/* Copy exec args from an SCM vector into a new C array. */
-static char ** scm_convert_exec_args SCM_P ((SCM args));
-
static char **
-scm_convert_exec_args (args)
- SCM args;
+scm_convert_exec_args (SCM args, int pos, char *subr)
{
char **execargv;
int num_args;
int i;
+
+ SCM_ASSERT (SCM_NULLP (args)
+ || (SCM_NIMP (args) && SCM_CONSP (args)),
+ args, pos, subr);
SCM_DEFER_INTS;
num_args = scm_ilength (args);
execargv = (char **)
- scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
+ scm_must_malloc ((num_args + 1) * sizeof (char *), subr);
for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
{
scm_sizet len;
char *dst;
char *src;
SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)),
- SCM_CAR (args), "wrong type in SCM_ARG", "exec arg");
+ SCM_CAR (args), SCM_ARGn, subr);
len = 1 + SCM_ROLENGTH (SCM_CAR (args));
- dst = (char *) scm_must_malloc ((long) len, s_ttyname);
+ dst = (char *) scm_must_malloc ((long) len, subr);
src = SCM_ROCHARS (SCM_CAR (args));
while (len--)
dst[len] = src[len];
@@ -751,46 +752,99 @@ scm_convert_exec_args (args)
return execargv;
}
-SCM_PROC (s_execl, "execl", 0, 0, 1, scm_execl);
+SCM_PROC (s_execl, "execl", 1, 0, 1, scm_execl);
SCM
-scm_execl (args)
- SCM args;
+scm_execl (filename, args)
+ SCM filename, args;
{
char **execargv;
- SCM filename = SCM_CAR (args);
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_execl);
- if (SCM_SUBSTRP (filename))
- filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
- args = SCM_CDR (args);
- execargv = scm_convert_exec_args (args);
+ SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
+ SCM_ARG1, s_execl);
+ SCM_COERCE_SUBSTR (filename);
+ execargv = scm_convert_exec_args (args, SCM_ARG2, s_execl);
execv (SCM_ROCHARS (filename), execargv);
scm_syserror (s_execl);
/* not reached. */
return SCM_BOOL_F;
}
-SCM_PROC (s_execlp, "execlp", 0, 0, 1, scm_execlp);
+SCM_PROC (s_execlp, "execlp", 1, 0, 1, scm_execlp);
SCM
-scm_execlp (args)
- SCM args;
+scm_execlp (filename, args)
+ SCM filename, args;
{
char **execargv;
- SCM filename = SCM_CAR (args);
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
SCM_ARG1, s_execlp);
- if (SCM_SUBSTRP (filename))
- filename = scm_makfromstr (SCM_ROCHARS (filename),
- SCM_ROLENGTH (filename), 0);
- args = SCM_CDR (args);
- execargv = scm_convert_exec_args (args);
+ SCM_COERCE_SUBSTR (filename);
+ execargv = scm_convert_exec_args (args, SCM_ARG2, s_execlp);
execvp (SCM_ROCHARS (filename), execargv);
scm_syserror (s_execlp);
/* not reached. */
return SCM_BOOL_F;
}
+static char **
+environ_list_to_c (SCM envlist, int arg, char *proc)
+{
+ int num_strings;
+ char **result;
+ int i = 0;
+
+ SCM_REDEFER_INTS;
+ SCM_ASSERT (SCM_NULLP (envlist)
+ || (SCM_NIMP (envlist) && SCM_CONSP (envlist)),
+ envlist, arg, proc);
+ num_strings = scm_ilength (envlist);
+ result = (char **) malloc ((num_strings + 1) * sizeof (char *));
+ if (result == NULL)
+ scm_memory_error (proc);
+ while (SCM_NNULLP (envlist))
+ {
+ int len;
+ char *src;
+
+ SCM_ASSERT (SCM_NIMP (SCM_CAR (envlist))
+ && SCM_ROSTRINGP (SCM_CAR (envlist)),
+ envlist, arg, proc);
+ len = 1 + SCM_ROLENGTH (SCM_CAR (envlist));
+ result[i] = malloc ((long) len);
+ if (result[i] == NULL)
+ scm_memory_error (proc);
+ src = SCM_ROCHARS (SCM_CAR (envlist));
+ while (len--)
+ result[i][len] = src[len];
+ envlist = SCM_CDR (envlist);
+ i++;
+ }
+ result[i] = 0;
+ SCM_REALLOW_INTS;
+ return result;
+}
+
+SCM_PROC (s_execle, "execle", 2, 0, 1, scm_execle);
+
+SCM
+scm_execle (filename, env, args)
+ SCM filename, env, args;
+{
+ char **execargv;
+ char **exec_env;
+
+ SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
+ SCM_ARG1, s_execle);
+ SCM_COERCE_SUBSTR (filename);
+
+ execargv = scm_convert_exec_args (args, SCM_ARG1, s_execle);
+ exec_env = environ_list_to_c (env, SCM_ARG2, s_execle);
+ execve (SCM_ROCHARS (filename), execargv, exec_env);
+ scm_syserror (s_execle);
+ /* not reached. */
+ return SCM_BOOL_F;
+}
+
SCM_PROC (s_fork, "primitive-fork", 0, 0, 0, scm_fork);
SCM
@@ -844,33 +898,10 @@ scm_environ (env)
return scm_makfromstrs (-1, environ);
else
{
- int num_strings;
char **new_environ;
- int i = 0;
- SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
- env, SCM_ARG1, s_environ);
- num_strings = scm_ilength (env);
- new_environ = (char **) malloc ((num_strings + 1) * sizeof (char *));
- if (new_environ == NULL)
- scm_memory_error (s_environ);
- while (SCM_NNULLP (env))
- {
- int len;
- char *src;
- SCM_ASSERT (SCM_NIMP (SCM_CAR (env))
- && SCM_ROSTRINGP (SCM_CAR (env)),
- env, SCM_ARG1, s_environ);
- len = 1 + SCM_ROLENGTH (SCM_CAR (env));
- new_environ[i] = malloc ((long) len);
- if (new_environ[i] == NULL)
- scm_memory_error (s_environ);
- src = SCM_ROCHARS (SCM_CAR (env));
- while (len--)
- new_environ[i][len] = src[len];
- env = SCM_CDR (env);
- i++;
- }
- new_environ[i] = 0;
+
+ SCM_DEFER_INTS;
+ new_environ = environ_list_to_c (env, SCM_ARG1, s_environ);
/* Free the old environment, except when called for the first
* time.
*/
@@ -886,6 +917,7 @@ scm_environ (env)
first = 0;
}
environ = new_environ;
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
}
@@ -1151,12 +1183,9 @@ scm_sync()
scm_sysmissing (s_sync);
/* not reached. */
#endif
- return SCM_BOOL_F;
+ return SCM_UNSPECIFIED;
}
-
-
-
void
scm_init_posix ()
{
diff --git a/libguile/posix.h b/libguile/posix.h
index 72d1adb65..f7812d75f 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -78,8 +78,9 @@ extern SCM scm_setgid SCM_P ((SCM id));
extern SCM scm_seteuid SCM_P ((SCM id));
extern SCM scm_setegid SCM_P ((SCM id));
extern SCM scm_ttyname SCM_P ((SCM port));
-extern SCM scm_execl SCM_P ((SCM args));
-extern SCM scm_execlp SCM_P ((SCM args));
+extern SCM scm_execl SCM_P ((SCM filename, SCM args));
+extern SCM scm_execlp SCM_P ((SCM filename, SCM args));
+extern SCM scm_execle SCM_P ((SCM filename, SCM env, SCM args));
extern SCM scm_fork SCM_P ((void));
extern SCM scm_uname SCM_P ((void));
extern SCM scm_environ SCM_P ((SCM env));
diff --git a/libguile/stime.c b/libguile/stime.c
index eee6271ee..fa2919281 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -160,6 +160,29 @@ scm_get_internal_real_time()
}
#endif
+SCM_PROC (s_times, "times", 0, 0, 0, scm_times);
+SCM
+scm_times (void)
+{
+#ifdef HAVE_TIMES
+ struct tms t;
+ clock_t rv;
+
+ SCM result = scm_make_vector (SCM_MAKINUM(5), SCM_UNDEFINED, SCM_UNDEFINED);
+ rv = times (&t);
+ if (rv == -1)
+ scm_syserror (s_times);
+ SCM_VELTS (result)[0] = scm_long2num (rv);
+ SCM_VELTS (result)[1] = scm_long2num (t.tms_utime);
+ SCM_VELTS (result)[2] = scm_long2num (t.tms_stime);
+ SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime);
+ SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime);
+ return result;
+#else
+ scm_sysmissing (s_times);
+#endif
+}
+
#ifndef HAVE_TZSET
/* GNU-WIN32's cygwin.dll doesn't have this. */
#define tzset()
diff --git a/libguile/stime.h b/libguile/stime.h
index 9d5ea0d4e..e2cf5dbac 100644
--- a/libguile/stime.h
+++ b/libguile/stime.h
@@ -55,6 +55,7 @@ extern SCM scm_localtime (SCM time, SCM zone);
extern SCM scm_gmtime (SCM time);
extern SCM scm_mktime (SCM sbd_time, SCM zone);
extern SCM scm_tzset (void);
+extern SCM scm_times (void);
extern SCM scm_strftime SCM_P ((SCM format, SCM stime));
extern SCM scm_strptime SCM_P ((SCM format, SCM string));
extern void scm_init_stime SCM_P ((void));