Add new primitive `file-attributes-indirect' that uses `stat' instead

of `lstat'.

diff --git a/v7/src/microcode/pruxfs.c b/v7/src/microcode/pruxfs.c
index e10d61d66d276d878e0cf9d6741484012c14bed4..1c48577c6ae9b9a7e90e5de5bada5a6cf2c8aa55 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.36 1989/09/20 23:12:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.37 1989/12/08 01:49:51 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -308,7 +308,7 @@ file_symlink_p (filename)
 #endif /* S_IFLNK */
 
 DEFINE_PRIMITIVE ("FILE-SYMLINK?", Prim_file_symlink_p, 1, 1,
-  "Returns #T if the argument file name is a symbolic link;\n\
+  "If FILENAME is a symbolic link, returns its contents;\n\
 otherwise returns #F.")
 {
   PRIMITIVE_HEADER (1);
@@ -338,6 +338,7 @@ otherwise returns #F.")
 
    The filemodestring stuff was gobbled from GNU Emacs. */
 
+static SCHEME_OBJECT file_attributes_internal ();
 static void filemodestring ();
 static void rwx ();
 static void setst ();
@@ -355,17 +356,33 @@ is a vector of 10 items (see the reference manual for details).  Otherwise\n\
 the result is #F.")
 {
   struct stat stat_result;
-  extern SCHEME_OBJECT allocate_marked_vector ();
-  SCHEME_OBJECT result;
-  extern SCHEME_OBJECT allocate_string ();
-  SCHEME_OBJECT modes;
   PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN
+    (((lstat ((STRING_ARG (1)), (& stat_result))) < 0)
+     ? SHARP_F
+     : (file_attributes_internal (& stat_result)));
+}
 
-  if ((lstat ((STRING_ARG (1)), (& stat_result))) < 0)
-    PRIMITIVE_RETURN (SHARP_F);
-  result = (allocate_marked_vector (TC_VECTOR, 10, true));
-  modes = (allocate_string (10));
-  switch ((stat_result . st_mode) & S_IFMT)
+DEFINE_PRIMITIVE ("FILE-ATTRIBUTES-INDIRECT", Prim_file_attributes_indirect, 1, 1,
+  "Like FILE-ATTRIBUTES except that it indirects through symbolic links.")
+{
+  struct stat stat_result;
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN
+    (((stat ((STRING_ARG (1)), (& stat_result))) < 0)
+     ? SHARP_F
+     : (file_attributes_internal (& stat_result)));
+}
+\f
+static SCHEME_OBJECT
+file_attributes_internal (stat_result)
+     struct stat * stat_result;
+{
+  extern SCHEME_OBJECT allocate_marked_vector ();
+  extern SCHEME_OBJECT allocate_string ();
+  SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 10, true));
+  SCHEME_OBJECT modes = (allocate_string (10));
+  switch ((stat_result -> st_mode) & S_IFMT)
     {
     case S_IFDIR:
       VECTOR_SET (result, 0, SHARP_T);
@@ -379,17 +396,17 @@ the result is #F.")
       VECTOR_SET (result, 0, SHARP_F);
       break;
     }
-  VECTOR_SET (result, 1, (LONG_TO_UNSIGNED_FIXNUM (stat_result . st_nlink)));
-  VECTOR_SET (result, 2, (LONG_TO_UNSIGNED_FIXNUM (stat_result . st_uid)));
-  VECTOR_SET (result, 3, (LONG_TO_UNSIGNED_FIXNUM (stat_result . st_gid)));
-  VECTOR_SET (result, 4, (long_to_integer (stat_result . st_atime)));
-  VECTOR_SET (result, 5, (long_to_integer (stat_result . st_mtime)));
-  VECTOR_SET (result, 6, (long_to_integer (stat_result . st_ctime)));
-  VECTOR_SET (result, 7, (long_to_integer (stat_result . st_size)));
-  filemodestring ((& stat_result), (STRING_LOC (modes, 0)));
+  VECTOR_SET (result, 1, (long_to_integer (stat_result -> st_nlink)));
+  VECTOR_SET (result, 2, (long_to_integer (stat_result -> st_uid)));
+  VECTOR_SET (result, 3, (long_to_integer (stat_result -> st_gid)));
+  VECTOR_SET (result, 4, (long_to_integer (stat_result -> st_atime)));
+  VECTOR_SET (result, 5, (long_to_integer (stat_result -> st_mtime)));
+  VECTOR_SET (result, 6, (long_to_integer (stat_result -> st_ctime)));
+  VECTOR_SET (result, 7, (long_to_integer (stat_result -> st_size)));
+  filemodestring (stat_result, (STRING_LOC (modes, 0)));
   VECTOR_SET (result, 8, modes);
-  VECTOR_SET (result, 9, (LONG_TO_UNSIGNED_FIXNUM (stat_result . st_ino)));
-  PRIMITIVE_RETURN (result);
+  VECTOR_SET (result, 9, (long_to_integer (stat_result -> st_ino)));
+  return (result);
 }
 \f
 /* filemodestring - set file attribute data

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 41be6f3e710a13858270b7fdbce9775112dd9739..e7655eb76b0507fd9ef712261724de69f4678761 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.14 1989/12/07 05:54:59 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.15 1989/12/08 01:50:01 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     14
+#define SUBVERSION     15
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 8efe2d74ec69ed72f1d50aa355014b8f2c7ae53b..eac45dee11621b24b78546019191d7c53ac31ed9 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.14 1989/12/07 05:54:59 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.15 1989/12/08 01:50:01 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     14
+#define SUBVERSION     15
 #endif
 
 #ifndef UCODE_TABLES_FILENAME