Change all primitives that use the `stat' and `lstat' system calls to

check for EINTR, and to signal system-call errors if the file's
existence cannot be determined.  Change the FILE-EXISTS? primitive to
return zero (instead of #F, as previously) if the file being tested is
a symbolic link but it doesn't point at anything.

diff --git a/v7/src/microcode/osfs.h b/v7/src/microcode/osfs.h
index 0e2c379962a882df00adc565f81b600bc3634953..8e6f3068c004ae0917a63c63cfcb919147f6ddf8 100644 (file)
--- a/v7/src/microcode/osfs.h
+++ b/v7/src/microcode/osfs.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osfs.h,v 1.2 1991/04/12 03:20:38 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osfs.h,v 1.3 1991/10/29 13:58:53 cph Exp $
 
 Copyright (c) 1990-91 Massachusetts Institute of Technology
 
@@ -37,7 +37,7 @@ MIT in each case. */
 
 #include "os.h"
 
-enum file_existence { file_does_exist, file_doesnt_exist, file_may_exist };
+enum file_existence { file_does_exist, file_doesnt_exist, file_is_link };
 
 extern enum file_existence EXFUN (OS_file_existence_test, (CONST char * name));
 extern int EXFUN (OS_file_access, (CONST char * name, unsigned int mode));

diff --git a/v7/src/microcode/prosfs.c b/v7/src/microcode/prosfs.c
index c2c0cb0eabc6bd3f8140617ec89ef9b0f25a7cab..63b2f283ce5174a7244395619f49a23213efd3e4 100644 (file)
--- a/v7/src/microcode/prosfs.c
+++ b/v7/src/microcode/prosfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosfs.c,v 1.3 1991/04/12 03:20:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosfs.c,v 1.4 1991/10/29 13:58:58 cph Exp $
 
 Copyright (c) 1987-91 Massachusetts Institute of Technology
 
@@ -49,14 +49,20 @@ MIT in each case. */
 \f
 DEFINE_PRIMITIVE ("FILE-EXISTS?", Prim_file_exists_p, 1, 1,
   "Return #T iff FILENAME refers to an existing file.\n\
-Otherwise #F is returned, in which case either:\n\
-  (1) the file doesn't exist, or\n\
-  (2) it's not possible to determine whether the file exists.")
+Return #F if the file doesn't exist.\n\
+Return zero if it's a symbolic link that points to a nonexisting file.\n\
+Signal an error if the file's existence is indeterminate.")
 {
   PRIMITIVE_HEADER (1);
-  PRIMITIVE_RETURN
-    (BOOLEAN_TO_OBJECT
-     ((OS_file_existence_test (STRING_ARG (1))) == file_does_exist));
+  {
+    enum file_existence result = (OS_file_existence_test (STRING_ARG (1)));
+    PRIMITIVE_RETURN
+      ((result == file_doesnt_exist)
+       ? SHARP_F
+       : (result == file_does_exist)
+       ? SHARP_T
+       : FIXNUM_ZERO);
+  }
 }
 
 DEFINE_PRIMITIVE ("FILE-ACCESS", Prim_file_access, 2, 2,

diff --git a/v7/src/microcode/pruxfs.c b/v7/src/microcode/pruxfs.c
index 40338c966aa703fdb1db80b3c11c0e44d814797e..90574156dd757e2de888c404cd92ad4ae4c29463 100644 (file)
--- a/v7/src/microcode/pruxfs.c
+++ b/v7/src/microcode/pruxfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.45 1991/09/05 22:26:48 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.46 1991/10/29 13:59:04 cph Exp $
 
 Copyright (c) 1987-91 Massachusetts Institute of Technology
 
@@ -39,6 +39,11 @@ MIT in each case. */
 #include "ux.h"
 #include "osfs.h"
 
+extern int EXFUN
+  (UX_read_file_status, (CONST char * filename, struct stat * s));
+extern int EXFUN
+  (UX_read_file_status_indirect, (CONST char * filename, struct stat * s));
+
 static SCHEME_OBJECT EXFUN (file_attributes_internal, (struct stat * s));
 static void EXFUN (file_mode_string, (struct stat * s, char * a));
 static char EXFUN (file_type_letter, (struct stat * s));
@@ -56,9 +61,9 @@ DEFINE_PRIMITIVE ("FILE-MODES", Prim_file_modes, 1, 1,
   struct stat stat_result;
   PRIMITIVE_HEADER (1);
   PRIMITIVE_RETURN
-    (((UX_stat ((STRING_ARG (1)), (&stat_result))) < 0)
-     ? SHARP_F
-     : (LONG_TO_UNSIGNED_FIXNUM ((stat_result . st_mode) & 07777)));
+    ((UX_read_file_status_indirect ((STRING_ARG (1)), (&stat_result)))
+     ? (LONG_TO_UNSIGNED_FIXNUM ((stat_result . st_mode) & 07777))
+     : SHARP_F);
 }
 
 DEFINE_PRIMITIVE ("SET-FILE-MODES!", Prim_set_file_modes, 2, 2,
@@ -75,9 +80,9 @@ DEFINE_PRIMITIVE ("FILE-MOD-TIME", Prim_file_mod_time, 1, 1, 0)
   struct stat s;
   PRIMITIVE_HEADER (1);
   PRIMITIVE_RETURN
-    (((UX_lstat ((STRING_ARG (1)), (&s))) < 0)
-     ? SHARP_F
-     : (long_to_integer (s . st_mtime)));
+    ((UX_read_file_status ((STRING_ARG (1)), (&s)))
+     ? (long_to_integer (s . st_mtime))
+     : SHARP_F);
 }
 
 DEFINE_PRIMITIVE ("FILE-MOD-TIME-INDIRECT", Prim_file_mod_time_indirect, 1, 1, 0)
@@ -85,9 +90,9 @@ DEFINE_PRIMITIVE ("FILE-MOD-TIME-INDIRECT", Prim_file_mod_time_indirect, 1, 1, 0
   struct stat s;
   PRIMITIVE_HEADER (1);
   PRIMITIVE_RETURN
-    (((UX_stat ((STRING_ARG (1)), (&s))) < 0)
-     ? SHARP_F
-     : (long_to_integer (s . st_mtime)));
+    ((UX_read_file_status_indirect ((STRING_ARG (1)), (&s)))
+     ? (long_to_integer (s . st_mtime))
+     : SHARP_F);
 }
 \f
 /* Returns a vector of 10 items:
@@ -112,9 +117,9 @@ DEFINE_PRIMITIVE ("FILE-MOD-TIME-INDIRECT", Prim_file_mod_time_indirect, 1, 1, 0
   struct stat s;                                                       \
   PRIMITIVE_HEADER (1);                                                        \
   PRIMITIVE_RETURN                                                     \
-    (((stat_syscall ((STRING_ARG (1)), (&s))) < 0)                     \
-     ? SHARP_F                                                         \
-     : (file_attributes_internal (&s)));                               \
+    ((stat_syscall ((STRING_ARG (1)), (&s)))                           \
+     ? (file_attributes_internal (&s))                                 \
+     : SHARP_F);                                                       \
 }
 
 DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1, 1,
@@ -122,11 +127,11 @@ DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1, 1,
 If the file exists and its status information is accessible, the result\n\
 is a vector of 10 items (see the reference manual for details).  Otherwise\n\
 the result is #F.")
-     FILE_ATTRIBUTES_PRIMITIVE (UX_lstat)
+     FILE_ATTRIBUTES_PRIMITIVE (UX_read_file_status)
 
 DEFINE_PRIMITIVE ("FILE-ATTRIBUTES-INDIRECT", Prim_file_attributes_indirect, 1, 1,
   "Like FILE-ATTRIBUTES but indirect through symbolic links.")
-     FILE_ATTRIBUTES_PRIMITIVE (UX_stat)
+     FILE_ATTRIBUTES_PRIMITIVE (UX_read_file_status_indirect)
 
 static SCHEME_OBJECT
 DEFUN (file_attributes_internal, (s), struct stat * s)
@@ -202,16 +207,16 @@ DEFUN (file_mode_string, (s, a), struct stat * s AND char * a)
   rwx ((((s -> st_mode) & 0070) << 3), (& (a [4])));
   rwx ((((s -> st_mode) & 0007) << 6), (& (a [7])));
 #ifdef S_ISUID
-   if (((s -> st_mode) & S_ISUID) != 0)
-     (a[3]) = (((a[3]) == 'x') ? 's' : 'S');
+  if (((s -> st_mode) & S_ISUID) != 0)
+    (a[3]) = (((a[3]) == 'x') ? 's' : 'S');
 #endif
 #ifdef S_ISGID
-   if (((s -> st_mode) & S_ISGID) != 0)
-     (a[6]) = (((a [6]) == 'x') ? 's' : 'S');
+  if (((s -> st_mode) & S_ISGID) != 0)
+    (a[6]) = (((a [6]) == 'x') ? 's' : 'S');
 #endif
 #ifdef S_ISVTX
-   if (((s -> st_mode) & S_ISVTX) != 0)
-     (a[9]) = (((a [9]) == 'x') ? 't' : 'T');
+  if (((s -> st_mode) & S_ISVTX) != 0)
+    (a[9]) = (((a [9]) == 'x') ? 't' : 'T');
 #endif
 }
 \f

diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm
index 6c6c16f90a4b95f6923cba71b81d61081f3632de..db083a774599ccc507752b4deb85597e98520e50 100644 (file)
--- a/v7/src/microcode/utabmd.scm
+++ b/v7/src/microcode/utabmd.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.59 1991/09/05 22:27:17 markf Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.60 1991/10/29 13:59:11 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987-91 Massachusetts Institute of Technology
 ;;;
@@ -631,6 +631,8 @@
               UTIME
               VFORK
               WRITE
+              STAT
+              LSTAT
               ))
 \f
 ;;; [] System-call errors
@@ -696,4 +698,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.59 1991/09/05 22:27:17 markf Exp $"
\ No newline at end of file
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.60 1991/10/29 13:59:11 cph Exp $"
\ No newline at end of file

diff --git a/v7/src/microcode/ux.h b/v7/src/microcode/ux.h
index 147f9e9bc9ecf7735219568504652672e07b9579..d0ce8289004b1e6c7c47c70ecc4c29fd2af0b1c6 100644 (file)
--- a/v7/src/microcode/ux.h
+++ b/v7/src/microcode/ux.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.h,v 1.27 1991/10/16 00:27:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.h,v 1.28 1991/10/29 13:59:20 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -114,7 +114,9 @@ enum syscall_names
   syscall_unlink,
   syscall_utime,
   syscall_vfork,
-  syscall_write
+  syscall_write,
+  syscall_stat,
+  syscall_lstat
 };
 
 enum syserr_names

diff --git a/v7/src/microcode/uxfs.c b/v7/src/microcode/uxfs.c
index bff41317e9fb8bed2689c15048f618b37540f075..01035292f1989d82b234ef86455122f8a393f3ed 100644 (file)
--- a/v7/src/microcode/uxfs.c
+++ b/v7/src/microcode/uxfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxfs.c,v 1.4 1991/04/12 03:20:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxfs.c,v 1.5 1991/10/29 13:59:31 cph Exp $
 
 Copyright (c) 1990-1 Massachusetts Institute of Technology
 
@@ -35,30 +35,57 @@ MIT in each case. */
 #include "ux.h"
 #include "osfs.h"
 \f
-enum file_existence
-DEFUN (OS_file_existence_test, (name), CONST char * name)
+int
+DEFUN (UX_read_file_status, (filename, s),
+       CONST char * filename AND
+       struct stat * s)
 {
-  struct stat s;
-  return
-    (((UX_stat (name, (&s))) < 0)
-     ? (((errno == ENOENT) || (errno == ENOTDIR))
-       ? file_doesnt_exist
-       : file_may_exist)
-     : file_does_exist);
+  while ((UX_lstat (filename, s)) < 0)
+    {
+      if (errno == EINTR)
+       continue;
+      if ((errno == ENOENT) || (errno == ENOTDIR))
+       return (0);
+      error_system_call (errno, syscall_lstat);
+    }
+  return (1);
 }
 
 int
-DEFUN (OS_file_access, (name, mode), CONST char * name AND unsigned int mode)
+DEFUN (UX_read_file_status_indirect, (filename, s),
+       CONST char * filename AND
+       struct stat * s)
 {
-  return ((UX_access (name, mode)) == 0);
+  while ((UX_stat (filename, s)) < 0)
+    {
+      if (errno == EINTR)
+       continue;
+      if ((errno == ENOENT) || (errno == ENOTDIR))
+       return (0);
+      error_system_call (errno, syscall_stat);
+    }
+  return (1);
 }
 
+enum file_existence
+DEFUN (OS_file_existence_test, (name), CONST char * name)
+{
+  struct stat s;
+  return
+    ((UX_read_file_status_indirect (name, (&s)))
+     ? file_does_exist
+     : (UX_read_file_status (name, (&s)))
+     ? file_is_link
+     : file_doesnt_exist);
+}
+\f
 int
 DEFUN (OS_file_directory_p, (name), CONST char * name)
 {
   struct stat s;
-  return (((UX_stat (name, (&s))) == 0) &&
-         (((s . st_mode) & S_IFMT) == S_IFDIR));
+  return
+    ((UX_read_file_status_indirect (name, (&s)))
+     && (((s . st_mode) & S_IFMT) == S_IFDIR));
 }
 
 CONST char *
@@ -66,8 +93,8 @@ DEFUN (OS_file_soft_link_p, (name), CONST char * name)
 {
 #ifdef HAVE_SYMBOLIC_LINKS
   struct stat s;
-  if (((UX_lstat (name, (&s))) < 0)
-      || (((s . st_mode) & S_IFMT) != S_IFLNK))
+  if (! ((UX_read_file_status (name, (&s)))
+        && (((s . st_mode) & S_IFMT) == S_IFLNK)))
     return (0);
   {
     int scr;
@@ -93,6 +120,12 @@ DEFUN (OS_file_soft_link_p, (name), CONST char * name)
   return (0);
 #endif
 }
+\f
+int
+DEFUN (OS_file_access, (name, mode), CONST char * name AND unsigned int mode)
+{
+  return ((UX_access (name, mode)) == 0);
+}
 
 void
 DEFUN (OS_file_remove, (name), CONST char * name)
@@ -104,12 +137,12 @@ void
 DEFUN (OS_file_remove_link, (name), CONST char * name)
 {
   struct stat s;
-  if (((UX_lstat (name, (&s))) == 0) &&
-      ((((s . st_mode) & S_IFMT) == S_IFREG)
+  if ((UX_read_file_status (name, (&s)))
+      && ((((s . st_mode) & S_IFMT) == S_IFREG)
 #ifdef HAVE_SYMBOLIC_LINKS
-       || (((s . st_mode) & S_IFMT) == S_IFLNK)
+         || (((s . st_mode) & S_IFMT) == S_IFLNK)
 #endif
-       ))
+         ))
     UX_unlink (name);
 }
 

diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm
index 71fe9ab77654f2dab718b807cb7d9cd9998c2c5c..9f5dd4cd0afe0ce1555f4099fbd41d63ed7d93ea 100644 (file)
--- a/v8/src/microcode/utabmd.scm
+++ b/v8/src/microcode/utabmd.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.59 1991/09/05 22:27:17 markf Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.60 1991/10/29 13:59:11 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987-91 Massachusetts Institute of Technology
 ;;;
@@ -631,6 +631,8 @@
               UTIME
               VFORK
               WRITE
+              STAT
+              LSTAT
               ))
 \f
 ;;; [] System-call errors
@@ -696,4 +698,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.59 1991/09/05 22:27:17 markf Exp $"
\ No newline at end of file
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.60 1991/10/29 13:59:11 cph Exp $"
\ No newline at end of file