diff options
author | Gary Houston <ghouston@arglist.com> | 1997-08-16 18:48:44 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 1997-08-16 18:48:44 +0000 |
commit | 6afcd3b2b6b46ccbfd5f84bfd9dedb458dea894f (patch) | |
tree | c04f61db122ef10184ac0f9e97195d941d1c5aba /libguile/filesys.c | |
parent | db75135d74e48a19aa91083dc50b15a06a1bcda0 (diff) | |
download | guile-6afcd3b2b6b46ccbfd5f84bfd9dedb458dea894f.tar.gz |
* 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.
* boot-9.scm: define tms accessors: clock, utime, stime, cutime,
cstime.
Diffstat (limited to 'libguile/filesys.c')
-rw-r--r-- | libguile/filesys.c | 295 |
1 files changed, 211 insertions, 84 deletions
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 |