Direct interface to directory streams (stolen from S48).

scsh/dirstuff1.c

@@ -13,7 +13,7 @@
 #include "scheme48.h"
 #include "dirstuff1.h"
 
-s48_value open_dir(s48_value sch_dirname)
+s48_value directory_files(s48_value sch_dirname)
 {
   char *fname;
   struct dirent *dirent;
@@ -41,7 +41,74 @@ s48_value open_dir(s48_value sch_dirname)
   S48_GC_UNPROTECT ();
   return dirlist;
 }
+s48_value
+scm_opendir(s48_value dirname)
+{
+  DIR		*dp;
+  s48_value	res;
+  char		*c_name;
+
+  c_name = s48_extract_string(dirname);
+  dp = opendir(c_name);
+  if (dp == NULL)
+    s48_raise_os_error_1(errno, dirname);
+  res = S48_MAKE_VALUE(DIR *);
+  S48_UNSAFE_EXTRACT_VALUE(res, DIR *) = dp;
+  return (res);
+}
+
+/*
+ * Interface to closedir.
+ * Note, it is ok to call closedir on an already closed directory.
+ */
+s48_value
+scm_closedir(s48_value dirstream)
+{
+  DIR	**dpp;
+
+  dpp = S48_EXTRACT_VALUE_POINTER(dirstream, DIR *);
+  if (*dpp != (DIR *)NULL) {
+    int	status = closedir(*dpp);
+    if (status == -1)
+      s48_raise_os_error_1(errno, dirstream);
+    *dpp = (DIR *)NULL;
+  }
+  return (S48_UNSPECIFIC);
+}
+
+/*
+ * Interface to readdir.
+ * If we have already read all the files that are in the directory,
+ * #F is returned.  Otherwise, a string with the next file name.
+ * Note, "." and ".." are never returned.
+ */
+s48_value
+scm_readdir(s48_value dirstream)
+{
+  DIR		**dpp;
+  struct dirent	*dep;
+  char		*name;
+
+  dpp = S48_EXTRACT_VALUE_POINTER(dirstream, DIR *);
+  if (*dpp == (DIR *)NULL)
+    s48_raise_argument_type_error(dirstream);	/* not really correct error */
+  do {
+    errno = 0;
+    dep = readdir(*dpp);
+    if (dep == (struct dirent *)NULL) {
+      if (errno != 0)
+	s48_raise_os_error_1(errno, dirstream);
+      return (S48_FALSE);
+    }
+    name = dep->d_name;
+  } while ((name[0] == '.')
+	   && (name[1] == '\0' || (name[1] == '.' && name[2] == '\0')));
+  return s48_enter_string(name);
+}
 
 void s48_init_dirstuff (){
-  S48_EXPORT_FUNCTION(open_dir);
+  S48_EXPORT_FUNCTION(directory_files);
+  S48_EXPORT_FUNCTION(scm_opendir);
+  S48_EXPORT_FUNCTION(scm_readdir);
+  S48_EXPORT_FUNCTION(scm_closedir);
 }

scsh/dirstuff1.h

@@ -1,4 +1,8 @@
 /* Exports from dirstuff1.c. */
 
-s48_value open_dir(s48_value dirname);
+s48_value directory_files(s48_value dirname);
+s48_value scm_opendir(s48_value dirname);
+s48_value scm_closedir(s48_value dirstream);
+s48_value scm_readdir(s48_value dirstream);
+
 

scsh/scsh-interfaces.scm

@@ -291,6 +291,10 @@
 	  sync-file
 	  sync-file-system
 
+	  open-directory-stream
+	  close-directory-stream
+	  read-directory-stream
+	  
 	  directory-files
 	  glob
 	  glob-quote

scsh/syscalls.scm

@@ -533,7 +533,7 @@
 ;;; Directory stuff
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(import-os-error-syscall %open-dir (dir-name) "open_dir")
+(import-os-error-syscall %open-dir (dir-name) "directory_files")
 
 (define (directory-files . args)
   (with-resources-aligned
@@ -560,6 +560,41 @@
 	  #f
 	  (string<= f1 f2))))
 
+; A record for directory streams.  It just has the name and a byte vector
+; containing the C directory object.  The name is used only for printing.
+
+(define-record directory-stream
+  name
+  c-dir)
+
+(define-record-discloser type/directory-stream
+  (lambda (ds)
+    (list 'directory-stream (directory-stream:name ds))))
+
+; Directory streams are meaningless in a resumed image.
+(define-record-resumer type/directory-stream #f)
+
+(define (open-directory-stream name)
+  (let ((dir (make-directory-stream name
+				    (open-dir name))))
+    (add-finalizer! dir close-directory-stream)
+    dir))
+
+(define (read-directory-stream dir-stream)
+  (read-dir (directory-stream:c-dir dir-stream)))
+
+(define (close-directory-stream dir-stream)
+  (let ((c-dir (directory-stream:c-dir dir-stream)))
+    (if c-dir
+	(begin
+	  (close-dir c-dir)
+	  (set-directory-stream:c-dir dir-stream #f)))))
+
+(import-os-error-syscall open-dir (name) "scm_opendir")
+(import-os-error-syscall close-dir (dir-stream) "scm_closedir")
+(import-os-error-syscall read-dir (dir-stream) "scm_readdir")
+
+
 ;;; I do this one in C, I'm not sure why:
 ;;; It is used by MATCH-FILES.
 ;;; 99/7: No one is using this function, so I'm commenting it out.