From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 14 Feb 2011 18:51:08 +0000 (+0000)
Subject: New (Unix) primitive CHANNEL-FILE-ATTRIBUTES for fstat.
X-Git-Tag: 20110426-Gtk~2^2~36
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=11f2a7e522ed2fdbb79ff6c8ef4906ee907da989;p=mit-scheme.git

New (Unix) primitive CHANNEL-FILE-ATTRIBUTES for fstat.

Also, I meant `eastern hemisphere' in the previous commit, unless the
earth's magnetic field has just reversed again...no, wait...
---

diff --git a/src/microcode/pruxfs.c b/src/microcode/pruxfs.c
index 04c80d25e..886c01704 100644
--- a/src/microcode/pruxfs.c
+++ b/src/microcode/pruxfs.c
@@ -28,8 +28,11 @@ USA.
 #include "scheme.h"
 #include "prims.h"
 #include "ux.h"
+#include "uxio.h"
 #include "osfs.h"
+#include "osio.h"
 
+extern void UX_read_fd_status (int fd, struct stat * s);
 extern int UX_read_file_status (const char * filename, struct stat * s);
 extern int UX_read_file_status_indirect
   (const char * filename, struct stat * s);
@@ -131,6 +134,14 @@ The file must exist and you must be the owner (or superuser).")
 
    The file_mode_string stuff was gobbled from GNU Emacs. */
 
+DEFINE_PRIMITIVE ("CHANNEL-FILE-ATTRIBUTES", Prim_channel_file_attributes, 1, 1, 0)
+{
+  struct stat s;
+  PRIMITIVE_HEADER (1);
+  UX_read_fd_status ((CHANNEL_DESCRIPTOR (arg_channel (1))), (&s));
+  return (file_attributes_internal (&s));
+}
+
 #define FILE_ATTRIBUTES_PRIMITIVE(stat_syscall)				\
 {									\
   struct stat s;							\
diff --git a/src/microcode/uxfs.c b/src/microcode/uxfs.c
index 902d1018e..1408ae25f 100644
--- a/src/microcode/uxfs.c
+++ b/src/microcode/uxfs.c
@@ -134,6 +134,12 @@ USA.
       }							\
   } while (0)
 
+void
+UX_read_fd_status (int fd, struct stat * s)
+{
+  STD_VOID_SYSTEM_CALL (syscall_fstat, (UX_fstat (fd, s)));
+}
+
 int
 UX_read_file_status (const char * filename, struct stat * s)
 {