Define new primitive FILE-EXISTS-DIRECT?.

diff --git a/v7/src/microcode/ntfs.c b/v7/src/microcode/ntfs.c
index 01198b33109b1425e6d1dd7ef138a6e632416012..ea62dc773ef7ad21feffdf5dbd37e54fc367e092 100644 (file)
--- a/v7/src/microcode/ntfs.c
+++ b/v7/src/microcode/ntfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ntfs.c,v 1.24 1999/01/02 06:11:34 cph Exp $
+$Id: ntfs.c,v 1.25 1999/12/21 18:48:25 cph Exp $
 
 Copyright (c) 1992-1999 Massachusetts Institute of Technology
 
@@ -152,7 +152,7 @@ create_file_for_info (const char * namestring)
 }
 \f
 enum file_existence
-DEFUN (OS_file_existence_test, (name), CONST char * name)
+OS_file_existence_test (const char * name)
 {
   BY_HANDLE_FILE_INFORMATION info;
   return
@@ -161,6 +161,12 @@ DEFUN (OS_file_existence_test, (name), CONST char * name)
      : file_doesnt_exist);
 }
 
+enum file_existence
+OS_file_existence_test_direct (const char * name)
+{
+  return (OS_file_existence_test (name));
+}
+
 #define R_OK 4
 #define W_OK 2
 #define X_OK 1

diff --git a/v7/src/microcode/os2fs.c b/v7/src/microcode/os2fs.c
index 6f866316ae3913a0f752a77f17660f74d4097b48..ceb760fce4d0cc7e55de24164f3de1e7f9a8ab30 100644 (file)
--- a/v7/src/microcode/os2fs.c
+++ b/v7/src/microcode/os2fs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: os2fs.c,v 1.10 1999/01/02 06:11:34 cph Exp $
+$Id: os2fs.c,v 1.11 1999/12/21 18:48:32 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -90,9 +90,16 @@ OS2_write_file_status (const char * filename, FILESTATUS3 * info)
 enum file_existence
 OS_file_existence_test (const char * filename)
 {
-  return ((OS2_read_file_status (filename))
-         ? file_does_exist
-         : file_doesnt_exist);
+  return
+    ((OS2_read_file_status (filename))
+     ? file_does_exist
+     : file_doesnt_exist);
+}
+
+enum file_existence
+OS_file_existence_test_direct (const char * filename)
+{
+  return (OS_file_existence_test (filename));
 }
 
 #define R_OK 4

diff --git a/v7/src/microcode/osfs.h b/v7/src/microcode/osfs.h
index 07416142cf92e64d16beacd7a9bcfdc5016b5018..07d85eb3c3268800b3eb118f787300722aa9eec4 100644 (file)
--- a/v7/src/microcode/osfs.h
+++ b/v7/src/microcode/osfs.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: osfs.h,v 1.7 1999/01/02 06:11:34 cph Exp $
+$Id: osfs.h,v 1.8 1999/12/21 18:48:47 cph Exp $
 
 Copyright (c) 1990-1999 Massachusetts Institute of Technology
 
@@ -27,6 +27,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 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 enum file_existence EXFUN
+  (OS_file_existence_test_direct, (CONST char * name));
 extern int EXFUN (OS_file_access, (CONST char * name, unsigned int mode));
 extern int EXFUN (OS_file_directory_p, (CONST char * name));
 extern CONST char * EXFUN (OS_file_soft_link_p, (CONST char * name));

diff --git a/v7/src/microcode/prosfs.c b/v7/src/microcode/prosfs.c
index 790e7c5139546eaa266a4b29a012d856631eedd5..57d21f3e41c88184e1de07d9a59c042cb9a26a6b 100644 (file)
--- a/v7/src/microcode/prosfs.c
+++ b/v7/src/microcode/prosfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: prosfs.c,v 1.13 1999/01/02 06:11:34 cph Exp $
+$Id: prosfs.c,v 1.14 1999/12/21 18:48:29 cph Exp $
 
 Copyright (c) 1987-1999 Massachusetts Institute of Technology
 
@@ -63,6 +63,25 @@ Signal an error if the file's existence is indeterminate.")
   }
 }
 
+DEFINE_PRIMITIVE ("FILE-EXISTS-DIRECT?", Prim_file_exists_direct_p, 1, 1,
+  "Return #T iff FILENAME refers to an existing file.\n\
+Return #F if the file doesn't exist.\n\
+Return zero if it's a symbolic link.\n\
+Signal an error if the file's existence is indeterminate.")
+{
+  PRIMITIVE_HEADER (1);
+  {
+    enum file_existence result
+      = (OS_file_existence_test_direct (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,
   "Return #T iff FILENAME exists and is accessible according to MODE.\n\
 MODE is an integer between 0 and 7 inclusive, bitwise encoded:\n\

diff --git a/v7/src/microcode/uxfs.c b/v7/src/microcode/uxfs.c
index de8ce3fdf01883442bfd43f3bd0dec45fe16ee6d..3f215e5914667a7558b400c82b70bfe4ff4bb77e 100644 (file)
--- a/v7/src/microcode/uxfs.c
+++ b/v7/src/microcode/uxfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: uxfs.c,v 1.17 1999/01/02 06:11:34 cph Exp $
+$Id: uxfs.c,v 1.18 1999/12/21 18:48:34 cph Exp $
 
 Copyright (c) 1990-1999 Massachusetts Institute of Technology
 
@@ -152,12 +152,31 @@ 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);
+  if (!UX_read_file_status (name, (&s)))
+    return (file_doesnt_exist);
+#ifdef HAVE_SYMBOLIC_LINKS
+  if (((s . st_mode) & S_IFMT) == S_IFLNK)
+    {
+      if (UX_read_file_status_indirect (name, (&s)))
+       return (file_does_exist);
+      else
+       return (file_is_link);
+    }
+#endif
+  return (file_does_exist);
+}
+
+enum file_existence
+DEFUN (OS_file_existence_test_direct, (name), CONST char * name)
+{
+  struct stat s;
+  if (!UX_read_file_status (name, (&s)))
+    return (file_doesnt_exist);
+#ifdef HAVE_SYMBOLIC_LINKS
+  if (((s . st_mode) & S_IFMT) == S_IFLNK)
+    return (file_is_link);
+#endif
+  return (file_does_exist);
 }
 \f
 CONST char *

diff --git a/v7/src/runtime/sfile.scm b/v7/src/runtime/sfile.scm
index 2d60e401fae1635ab795943a2498e4467825c15b..31393ae1aa77e6ddc83540e579d60e066de76b40 100644 (file)
--- a/v7/src/runtime/sfile.scm
+++ b/v7/src/runtime/sfile.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: sfile.scm,v 14.22 1999/11/19 14:12:53 cph Exp $
+$Id: sfile.scm,v 14.23 1999/12/21 18:50:47 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -24,8 +24,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (declare (usual-integrations))
 \f
-(define (file-exists? filename)
-  ((ucode-primitive file-exists? 1) (->namestring (merge-pathnames filename))))
+(define (file-exists-direct? filename)
+  (let ((result
+        ((ucode-primitive file-exists-direct? 1)
+         (->namestring (merge-pathnames filename)))))
+    (if (eq? 0 result)
+       #t
+       result)))
+
+(define (file-exists-indirect? filename)
+  (let ((result
+        ((ucode-primitive file-exists? 1)
+         (->namestring (merge-pathnames filename)))))
+    (if (eq? 0 result)
+       #f
+       result)))
+
+(define file-exists? file-exists-indirect?)
 
 (define (rename-file from to)
   ((ucode-primitive file-rename) (->namestring (merge-pathnames from))