mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

* stime.h: prototype for scm_times.

Browse source 
* 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.

* boot-9.scm: define tms accessors: clock, utime, stime, cutime,
cstime.
This commit is contained in:
Gary Houston 1997-08-16 18:48:44 +00:00
parent db75135d74
commit 6afcd3b2b6
12 changed files with 469 additions and 169 deletions
Download patch file Download diff file Expand all files Collapse all files

67
NEWS
View file

@ -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 also now possible for these procedures to raise an exception if an
error occurs (some errors from write can be delayed until close.) 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 ** The following new procedures have been added (most use scsh
interfaces): 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 adds the string NAME=VALUE to the environment, replacing any previous
value for NAME. 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] ** setvbuf PORT MODE [SIZE]
Set the buffering mode for PORT. MODE can be: Set the buffering mode for PORT. MODE can be:
`_IONBF' `_IONBF'
@ -139,9 +156,53 @@ value for NAME.
size. Procedures e.g., *Note open-file: File Ports, which accept a size. Procedures e.g., *Note open-file: File Ports, which accept a
mode string allow `0' to be added to request an unbuffered port. mode string allow `0' to be added to request an unbuffered port.
** primitive-exit [STATUS] ** fsync PORT/FD
Terminates the current process without unwinding the Scheme stack. Copies any unwritten data for the specified output file descriptor
This would usually be used after a fork. 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 * Changes to the gh_ interface

5
ice-9/ChangeLog
View file

@ -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> 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 * emacs.scm (emacs-load): Something has changed in the reader so

6
ice-9/boot-9.scm
View file

@ -760,6 +760,12 @@
(define (set-tm:gmtoff obj val) (vector-set! obj 9 val)) (define (set-tm:gmtoff obj val) (vector-set! obj 9 val))
(define (set-tm:zone obj val) (vector-set! obj 10 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-position . args) (apply ftell args))
(define (file-set-position . args) (apply fseek args)) (define (file-set-position . args) (apply fseek args))

31
libguile/ChangeLog
View file

@ -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> 1997-08-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* stacks.c (scm_make_stack), coop-threads.c, mit-pthreads.c * stacks.c (scm_make_stack), coop-threads.c, mit-pthreads.c

295
libguile/filesys.c
View file

@ -131,22 +131,40 @@
SCM_PROC (s_chown, "chown", 3, 0, 0, scm_chown); SCM_PROC (s_chown, "chown", 3, 0, 0, scm_chown);
SCM SCM
scm_chown (path, owner, group) scm_chown (object, owner, group)
SCM path; SCM object;
SCM owner; SCM owner;
SCM group; 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 (owner), owner, SCM_ARG2, s_chown);
SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown); SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown);
SCM_DEFER_INTS;
SCM_COERCE_SUBSTR (path); if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
SCM_SYSCALL (val = chown (SCM_ROCHARS (path), {
SCM_INUM (owner), SCM_INUM (group))); if (SCM_INUMP (object))
if (val != 0) 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_syserror (s_chown);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -154,27 +172,37 @@ scm_chown (path, owner, group)
SCM_PROC (s_chmod, "chmod", 2, 0, 0, scm_chmod); SCM_PROC (s_chmod, "chmod", 2, 0, 0, scm_chmod);
SCM SCM
scm_chmod (port_or_path, mode) scm_chmod (object, mode)
SCM port_or_path; SCM object;
SCM mode; SCM mode;
{ {
int rv; int rv;
int fdes;
SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod); SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod);
SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_chmod); SCM_DEFER_INTS;
if (SCM_ROSTRINGP (port_or_path)) if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
{ {
SCM_COERCE_SUBSTR (port_or_path); if (SCM_INUMP (object))
SCM_SYSCALL (rv = chmod (SCM_ROCHARS (port_or_path), SCM_INUM (mode))); 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 else
{ {
SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_chmod); SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
rv = fileno ((FILE *)SCM_STREAM (port_or_path)); object, SCM_ARG1, s_chmod);
if (rv != -1) SCM_COERCE_SUBSTR (object);
SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode))); SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode)));
} }
if (rv != 0) if (rv == -1)
scm_syserror (s_chmod); scm_syserror (s_chmod);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; 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
scm_open (path, flags, mode) scm_open_fdes (SCM path, SCM flags, SCM mode)
SCM path;
SCM flags;
SCM mode;
{ {
int fd; int fd;
SCM newpt;
FILE *f;
char *port_mode;
int iflags; int iflags;
int imode;
SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_open); SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open); s_open_fdes);
SCM_COERCE_SUBSTR (path);
if (SCM_SUBSTRP (path)) iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
SCM_DEFER_INTS; SCM_DEFER_INTS;
if (SCM_UNBNDP (mode)) if (SCM_UNBNDP (mode))
SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags)); imode = 0666;
else else
{ {
SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open); SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open_fdes);
SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, SCM_INUM (mode))); imode = SCM_INUM (mode);
} }
SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode));
if (fd == -1) 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); SCM_NEWCELL (newpt);
if (iflags & O_RDWR) if (iflags & O_RDWR)
port_mode = "r+"; port_mode = "r+";
@ -239,6 +277,7 @@ scm_open (path, flags, mode)
else else
port_mode = "r"; port_mode = "r";
} }
SCM_DEFER_INTS;
f = fdopen (fd, port_mode); f = fdopen (fd, port_mode);
if (!f) if (!f)
{ {
@ -390,40 +429,44 @@ scm_stat2scm (stat_temp)
SCM_PROC (s_stat, "stat", 1, 0, 0, scm_stat); SCM_PROC (s_stat, "stat", 1, 0, 0, scm_stat);
SCM SCM
scm_stat (file) scm_stat (object)
SCM file; SCM object;
{ {
int rv = 1; int rv;
int fdes;
struct stat stat_temp; struct stat stat_temp;
if (SCM_INUMP (file)) SCM_DEFER_INTS;
SCM_SYSCALL (rv = fstat (SCM_INUM (file), &stat_temp)); if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
else
{ {
SCM_ASSERT (SCM_NIMP (file), file, SCM_ARG1, s_stat); if (SCM_INUMP (object))
if (SCM_FPORTP (file)) fdes = SCM_INUM (object);
SCM_SYSCALL (rv = fstat (fileno ((FILE *) SCM_STREAM (file)),
&stat_temp));
else else
{ {
SCM_ASSERT (SCM_ROSTRINGP (file), file, SCM_ARG1, s_stat); fdes = fileno ((FILE *) SCM_STREAM (object));
if (SCM_SUBSTRP (file)) if (fdes == -1)
file = scm_makfromstr (SCM_ROCHARS (file), scm_syserror (s_stat);
SCM_ROLENGTH (file),
0);
SCM_SYSCALL (rv = stat (SCM_CHARS (file), &stat_temp));
} }
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; int en = errno;
scm_syserror_msg (s_stat, "%s: %S", scm_syserror_msg (s_stat, "%s: %S",
scm_listify (scm_makfrom0str (strerror (errno)), scm_listify (scm_makfrom0str (strerror (errno)),
file, object,
SCM_UNDEFINED), SCM_UNDEFINED),
en); en);
} }
SCM_ALLOW_INTS;
return scm_stat2scm (&stat_temp); return scm_stat2scm (&stat_temp);
} }
@ -441,15 +484,21 @@ scm_link (oldpath, newpath)
{ {
int val; 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)) if (SCM_SUBSTRP (oldpath))
oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), SCM_ROLENGTH (oldpath), 0); oldpath = scm_makfromstr (SCM_ROCHARS (oldpath),
SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath, SCM_ARG2, s_link); SCM_ROLENGTH (oldpath), 0);
SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath,
SCM_ARG2, s_link);
if (SCM_SUBSTRP (newpath)) 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))); SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
if (val != 0) if (val != 0)
scm_syserror (s_link); scm_syserror (s_link);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -469,13 +518,10 @@ scm_rename (oldname, newname)
s_rename); s_rename);
SCM_COERCE_SUBSTR (oldname); SCM_COERCE_SUBSTR (oldname);
SCM_COERCE_SUBSTR (newname); SCM_COERCE_SUBSTR (newname);
SCM_DEFER_INTS;
#ifdef HAVE_RENAME #ifdef HAVE_RENAME
SCM_SYSCALL (rv = rename (SCM_ROCHARS (oldname), SCM_ROCHARS (newname))); SCM_SYSCALL (rv = rename (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
if (rv != 0)
scm_syserror (s_rename);
return SCM_UNSPECIFIED;
#else #else
SCM_DEFER_INTS;
SCM_SYSCALL (rv = link (SCM_ROCHARS (oldname), SCM_ROCHARS (newname))); SCM_SYSCALL (rv = link (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
if (rv == 0) if (rv == 0)
{ {
@ -484,11 +530,11 @@ scm_rename (oldname, newname)
/* unlink failed. remove new name */ /* unlink failed. remove new name */
SCM_SYSCALL (unlink (SCM_ROCHARS (newname))); SCM_SYSCALL (unlink (SCM_ROCHARS (newname)));
} }
SCM_ALLOW_INTS; #endif
if (rv != 0) if (rv != 0)
scm_syserror (s_rename); scm_syserror (s_rename);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#endif
} }
@ -499,14 +545,51 @@ scm_delete_file (str)
SCM str; SCM str;
{ {
int ans; 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_COERCE_SUBSTR (str);
SCM_DEFER_INTS;
SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str))); SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str)));
if (ans != 0) if (ans != 0)
scm_syserror (s_delete_file); scm_syserror (s_delete_file);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; 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); 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, SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
s_mkdir); s_mkdir);
SCM_COERCE_SUBSTR (path); SCM_COERCE_SUBSTR (path);
SCM_DEFER_INTS;
if (SCM_UNBNDP (mode)) if (SCM_UNBNDP (mode))
{ {
mask = umask (0); mask = umask (0);
@ -534,6 +618,7 @@ scm_mkdir (path, mode)
} }
if (rv != 0) if (rv != 0)
scm_syserror (s_mkdir); scm_syserror (s_mkdir);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
scm_sysmissing (s_mkdir); scm_sysmissing (s_mkdir);
@ -555,9 +640,11 @@ scm_rmdir (path)
SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
s_rmdir); s_rmdir);
SCM_COERCE_SUBSTR (path); SCM_COERCE_SUBSTR (path);
SCM_DEFER_INTS;
SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path))); SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path)));
if (val != 0) if (val != 0)
scm_syserror (s_rmdir); scm_syserror (s_rmdir);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
scm_sysmissing (s_rmdir); 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_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_chdir);
SCM_COERCE_SUBSTR (str); SCM_COERCE_SUBSTR (str);
SCM_DEFER_INTS;
SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str))); SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str)));
if (ans != 0) if (ans != 0)
scm_syserror (s_chdir); scm_syserror (s_chdir);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; 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
scm_fcntl (port, cmd, value) scm_fcntl (SCM object, SCM cmd, SCM value)
SCM port;
SCM cmd;
SCM value;
{ {
int rv; 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 (cmd), cmd, SCM_ARG2, s_fcntl);
SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG3, s_fcntl); if (SCM_NIMP (object) && SCM_OPFPORTP (object))
fdes = fileno ((FILE *) SCM_STREAM (object));
rv = fileno ((FILE *)SCM_STREAM (port)); else
if (rv != -1) {
SCM_SYSCALL (rv = fcntl (rv, SCM_INUM (cmd), SCM_INUM (value))); SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fcntl);
if (rv == -1) 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_syserror (s_fcntl);
SCM_ALLOW_INTS;
return SCM_MAKINUM (rv); 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); SCM_PROC (s_symlink, "symlink", 2, 0, 0, scm_symlink);
@ -1057,9 +1180,11 @@ scm_symlink(oldpath, newpath)
s_symlink); s_symlink);
SCM_COERCE_SUBSTR (oldpath); SCM_COERCE_SUBSTR (oldpath);
SCM_COERCE_SUBSTR (newpath); SCM_COERCE_SUBSTR (newpath);
SCM_DEFER_INTS;
SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath))); SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath)));
if (val != 0) if (val != 0)
scm_syserror (s_symlink); scm_syserror (s_symlink);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
scm_sysmissing (s_symlink); scm_sysmissing (s_symlink);
@ -1118,6 +1243,7 @@ scm_lstat(str)
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, (char *) SCM_ARG1, SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, (char *) SCM_ARG1,
s_lstat); s_lstat);
SCM_COERCE_SUBSTR (str); SCM_COERCE_SUBSTR (str);
SCM_DEFER_INTS;
SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp)); SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp));
if (rv != 0) if (rv != 0)
{ {
@ -1129,6 +1255,7 @@ scm_lstat(str)
SCM_UNDEFINED), SCM_UNDEFINED),
en); en);
} }
SCM_ALLOW_INTS;
return scm_stat2scm(&stat_temp); return scm_stat2scm(&stat_temp);
#else #else
scm_sysmissing (s_lstat); scm_sysmissing (s_lstat);
@ -1216,7 +1343,7 @@ scm_sysintern ("O_TRUNC", scm_long2num (O_TRUNC));
#ifdef O_APPEND #ifdef O_APPEND
scm_sysintern ("O_APPEND", scm_long2num (O_APPEND)); scm_sysintern ("O_APPEND", scm_long2num (O_APPEND));
#endif #endif
#ifdef O_NONBLO #ifdef O_NONBLOCK
scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK)); scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
#endif #endif
#ifdef O_NDELAY #ifdef O_NDELAY

13
libguile/filesys.h
View file

@ -54,15 +54,17 @@ extern long scm_tc16_dir;
#define SCM_OPDIRP(x) (SCM_CAR(x)==(scm_tc16_dir | SCM_OPN)) #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_chown SCM_P ((SCM object, SCM owner, SCM group));
extern SCM scm_chmod SCM_P ((SCM port_or_path, SCM mode)); extern SCM scm_chmod SCM_P ((SCM object, SCM mode));
extern SCM scm_umask SCM_P ((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_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_link SCM_P ((SCM oldpath, SCM newpath));
extern SCM scm_rename SCM_P ((SCM oldname, SCM newname)); extern SCM scm_rename SCM_P ((SCM oldname, SCM newname));
extern SCM scm_delete_file SCM_P ((SCM str)); 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_mkdir SCM_P ((SCM path, SCM mode));
extern SCM scm_rmdir SCM_P ((SCM path)); extern SCM scm_rmdir SCM_P ((SCM path));
extern SCM scm_opendir SCM_P ((SCM dirname)); 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_getcwd SCM_P ((void));
extern SCM scm_select SCM_P ((SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)); 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 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_symlink SCM_P ((SCM oldpath, SCM newpath));
extern SCM scm_readlink SCM_P ((SCM path)); extern SCM scm_readlink SCM_P ((SCM path));
extern SCM scm_lstat SCM_P ((SCM str)); extern SCM scm_lstat SCM_P ((SCM str));

49
libguile/ioext.c
View file

@ -172,16 +172,25 @@ scm_write_line (obj, port)
SCM_PROC (s_ftell, "ftell", 1, 0, 0, scm_ftell); SCM_PROC (s_ftell, "ftell", 1, 0, 0, scm_ftell);
SCM SCM
scm_ftell (port) scm_ftell (object)
SCM port; SCM object;
{ {
long pos; long pos;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_ftell); SCM_DEFER_INTS;
SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port))); 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) if (pos < 0)
scm_syserror (s_ftell); scm_syserror (s_ftell);
if (pos > 0 && SCM_CRDYP (port)) SCM_ALLOW_INTS;
pos--;
return scm_long2num (pos); return scm_long2num (pos);
} }
@ -190,29 +199,33 @@ scm_ftell (port)
SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek); SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek);
SCM SCM
scm_fseek (port, offset, whence) scm_fseek (object, offset, whence)
SCM port; SCM object;
SCM offset; SCM offset;
SCM whence; SCM whence;
{ {
int rv; int rv;
long loff; long loff;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fseek);
loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek); loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
SCM_ASSERT (SCM_INUMP (whence) && (SCM_INUM (whence) < 3) && (SCM_INUM (whence) >= 0), SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek);
whence, SCM_ARG3, s_fseek); SCM_DEFER_INTS;
if (SCM_NIMP (object) && SCM_OPFPORTP (object))
SCM_CLRDY (port); /* Clear ungetted char */ {
/* Values of whence are interned in scm_init_ioext. */ SCM_CLRDY (object); /* Clear ungetted char */
rv = fseek ((FILE *)SCM_STREAM (port), loff, SCM_INUM (whence)); rv = fseek ((FILE *)SCM_STREAM (object), loff, SCM_INUM (whence));
if (rv != 0) }
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_syserror (s_fseek);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen); SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen);
SCM SCM

4
libguile/ioext.h
View file

@ -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_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_write_line SCM_P ((SCM obj, SCM port));
extern SCM scm_ftell SCM_P ((SCM port)); extern SCM scm_ftell SCM_P ((SCM object));
extern SCM scm_fseek SCM_P ((SCM port, SCM offset, SCM whence)); 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_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_redirect_port SCM_P ((SCM into_pt, SCM from_pt));
extern SCM scm_dup_to_fdes (SCM fd_or_port, SCM newfd); extern SCM scm_dup_to_fdes (SCM fd_or_port, SCM newfd);

139
libguile/posix.c
View file

@ -719,28 +719,29 @@ scm_tcsetpgrp (port, pgid)
/* Copy exec args from an SCM vector into a new C array. */ /* Copy exec args from an SCM vector into a new C array. */
static char ** scm_convert_exec_args SCM_P ((SCM args));
static char ** static char **
scm_convert_exec_args (args) scm_convert_exec_args (SCM args, int pos, char *subr)
SCM args;
{ {
char **execargv; char **execargv;
int num_args; int num_args;
int i; int i;
SCM_ASSERT (SCM_NULLP (args)
|| (SCM_NIMP (args) && SCM_CONSP (args)),
args, pos, subr);
SCM_DEFER_INTS; SCM_DEFER_INTS;
num_args = scm_ilength (args); num_args = scm_ilength (args);
execargv = (char **) 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) for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
{ {
scm_sizet len; scm_sizet len;
char *dst; char *dst;
char *src; char *src;
SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)), 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)); 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)); src = SCM_ROCHARS (SCM_CAR (args));
while (len--) while (len--)
dst[len] = src[len]; dst[len] = src[len];
@ -751,46 +752,99 @@ scm_convert_exec_args (args)
return execargv; return execargv;
} }
SCM_PROC (s_execl, "execl", 0, 0, 1, scm_execl); SCM_PROC (s_execl, "execl", 1, 0, 1, scm_execl);
SCM SCM
scm_execl (args) scm_execl (filename, args)
SCM args; SCM filename, args;
{ {
char **execargv; char **execargv;
SCM filename = SCM_CAR (args); SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_execl); SCM_ARG1, s_execl);
if (SCM_SUBSTRP (filename)) SCM_COERCE_SUBSTR (filename);
filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0); execargv = scm_convert_exec_args (args, SCM_ARG2, s_execl);
args = SCM_CDR (args);
execargv = scm_convert_exec_args (args);
execv (SCM_ROCHARS (filename), execargv); execv (SCM_ROCHARS (filename), execargv);
scm_syserror (s_execl); scm_syserror (s_execl);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; 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
scm_execlp (args) scm_execlp (filename, args)
SCM args; SCM filename, args;
{ {
char **execargv; char **execargv;
SCM filename = SCM_CAR (args);
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
SCM_ARG1, s_execlp); SCM_ARG1, s_execlp);
if (SCM_SUBSTRP (filename)) SCM_COERCE_SUBSTR (filename);
filename = scm_makfromstr (SCM_ROCHARS (filename), execargv = scm_convert_exec_args (args, SCM_ARG2, s_execlp);
SCM_ROLENGTH (filename), 0);
args = SCM_CDR (args);
execargv = scm_convert_exec_args (args);
execvp (SCM_ROCHARS (filename), execargv); execvp (SCM_ROCHARS (filename), execargv);
scm_syserror (s_execlp); scm_syserror (s_execlp);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; 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_PROC (s_fork, "primitive-fork", 0, 0, 0, scm_fork);
SCM SCM
@ -844,33 +898,10 @@ scm_environ (env)
return scm_makfromstrs (-1, environ); return scm_makfromstrs (-1, environ);
else else
{ {
int num_strings;
char **new_environ; char **new_environ;
int i = 0;
SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)), SCM_DEFER_INTS;
env, SCM_ARG1, s_environ); new_environ = environ_list_to_c (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;
/* Free the old environment, except when called for the first /* Free the old environment, except when called for the first
* time. * time.
*/ */
@ -886,6 +917,7 @@ scm_environ (env)
first = 0; first = 0;
} }
environ = new_environ; environ = new_environ;
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
} }
@ -1151,12 +1183,9 @@ scm_sync()
scm_sysmissing (s_sync); scm_sysmissing (s_sync);
/* not reached. */ /* not reached. */
#endif #endif
return SCM_BOOL_F; return SCM_UNSPECIFIED;
} }
void void
scm_init_posix () scm_init_posix ()
{ {

5
libguile/posix.h
View file

@ -78,8 +78,9 @@ extern SCM scm_setgid SCM_P ((SCM id));
extern SCM scm_seteuid SCM_P ((SCM id)); extern SCM scm_seteuid SCM_P ((SCM id));
extern SCM scm_setegid SCM_P ((SCM id)); extern SCM scm_setegid SCM_P ((SCM id));
extern SCM scm_ttyname SCM_P ((SCM port)); extern SCM scm_ttyname SCM_P ((SCM port));
extern SCM scm_execl SCM_P ((SCM args)); extern SCM scm_execl SCM_P ((SCM filename, SCM args));
extern SCM scm_execlp SCM_P ((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_fork SCM_P ((void));
extern SCM scm_uname SCM_P ((void)); extern SCM scm_uname SCM_P ((void));
extern SCM scm_environ SCM_P ((SCM env)); extern SCM scm_environ SCM_P ((SCM env));

23
libguile/stime.c
View file

@ -160,6 +160,29 @@ scm_get_internal_real_time()
} }
#endif #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 #ifndef HAVE_TZSET
/* GNU-WIN32's cygwin.dll doesn't have this. */ /* GNU-WIN32's cygwin.dll doesn't have this. */
#define tzset() #define tzset()

1
libguile/stime.h
View file

@ -55,6 +55,7 @@ extern SCM scm_localtime (SCM time, SCM zone);
extern SCM scm_gmtime (SCM time); extern SCM scm_gmtime (SCM time);
extern SCM scm_mktime (SCM sbd_time, SCM zone); extern SCM scm_mktime (SCM sbd_time, SCM zone);
extern SCM scm_tzset (void); extern SCM scm_tzset (void);
extern SCM scm_times (void);
extern SCM scm_strftime SCM_P ((SCM format, SCM stime)); extern SCM scm_strftime SCM_P ((SCM format, SCM stime));
extern SCM scm_strptime SCM_P ((SCM format, SCM string)); extern SCM scm_strptime SCM_P ((SCM format, SCM string));
extern void scm_init_stime SCM_P ((void)); extern void scm_init_stime SCM_P ((void));