mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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
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

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>
* 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: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))

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>
* 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
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

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))
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));

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
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

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_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);

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. */
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 ()
{

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_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));

23
libguile/stime.c
View file

@ -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()

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_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));