Allocate a static tc16 to directory streams

* libguile/filesys.c: Use a static tc16.
* libguile/eq.c:
* libguile/filesys.h:
* libguile/finalizers.c:
* libguile/finalizers.h:
* libguile/goops.c:
* libguile/print.c:
* libguile/scm.h:
* module/oop/goops.scm: Adapt for the new tc16.

libguile/eq.c

@@ -391,6 +391,7 @@ scm_equal_p (SCM x, SCM y)
         case scm_tc16_condition_variable:
         case scm_tc16_mutex:
         case scm_tc16_continuation:
+        case scm_tc16_directory:
           return SCM_BOOL_F;
         default:
           abort ();

libguile/filesys.c

@@ -2192,12 +2192,42 @@ scm_i_relativize_path (SCM path, SCM in_path)
 /* Examining directories.  These procedures are used by `check-guile'
    and thus compiled unconditionally.  */
 
-static scm_t_bits scm_tc16_dir;
+#define SCM_DIR_FLAG_OPEN (1L << 16)
 
-#define SCM_DIR_FLAG_OPEN (1L << 0)
+struct scm_directory
+{
+  scm_t_bits tag_and_flags;
+  DIR *ds;
+  scm_i_pthread_mutex_t mutex;
+};
 
-#define SCM_DIRP(x) (SCM_HAS_TYP16 (x, scm_tc16_dir))
+static inline int
-#define SCM_DIR_OPEN_P(x) (SCM_SMOB_FLAGS (x) & SCM_DIR_FLAG_OPEN)
+scm_is_directory (SCM x)
+{
+  return SCM_HAS_TYP16 (x, scm_tc16_directory);
+}
+
+static inline struct scm_directory*
+scm_to_directory (SCM x)
+{
+  if (!scm_is_directory (x))
+    abort ();
+  return (struct scm_directory*) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_directory (struct scm_directory *dir)
+{
+  return SCM_PACK_POINTER (dir);
+}
+
+#define SCM_DIRP(x) scm_is_directory (x)
+
+static int
+scm_dir_is_open (struct scm_directory *d)
+{
+  return d->tag_and_flags & SCM_DIR_FLAG_OPEN;
+}
 
 #define SCM_VALIDATE_DIR(pos, port) \
   SCM_MAKE_VALIDATE_MSG (pos, port, DIRP, "directory port")
@@ -2208,7 +2238,7 @@ SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
 	    "stream as returned by @code{opendir}.")
 #define FUNC_NAME s_scm_directory_stream_p
 {
-  return scm_from_bool (SCM_DIRP (obj));
+  return scm_from_bool (scm_is_directory (obj));
 }
 #undef FUNC_NAME
 
@@ -2219,18 +2249,16 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
 	    "stream.")
 #define FUNC_NAME s_scm_opendir
 {
-  DIR *ds;
+  struct scm_directory *d = scm_gc_malloc (sizeof (*d), "directory stream");
-  scm_i_pthread_mutex_t *mutex;
+  d->tag_and_flags = scm_tc16_directory | SCM_DIR_FLAG_OPEN;
-
+  
-  mutex = scm_gc_malloc_pointerless (sizeof *mutex, "dirstream-mutex");
+  STRING_SYSCALL (dirname, c_dirname, d->ds = opendir (c_dirname));
-  scm_i_pthread_mutex_init (mutex, NULL);
+  if (d->ds == NULL)
-
-  STRING_SYSCALL (dirname, c_dirname, ds = opendir (c_dirname));
-  if (ds == NULL)
     SCM_SYSERROR;
 
-  SCM_RETURN_NEWSMOB2 (scm_tc16_dir | (SCM_DIR_FLAG_OPEN << 16),
+  scm_i_pthread_mutex_init (&d->mutex, NULL);
-		       ds, SCM_UNPACK (SCM_PACK_POINTER (mutex)));
+
+  return scm_from_directory (d);
 }
 #undef FUNC_NAME
 
@@ -2243,15 +2271,14 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
 #define FUNC_NAME s_scm_readdir
 {
   SCM_VALIDATE_DIR (1, port);
-  if (!SCM_DIR_OPEN_P (port))
+  struct scm_directory *d = scm_to_directory (port);
+  if (!scm_dir_is_open (d))
     SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
 
-  scm_i_pthread_mutex_t *mutex = (scm_i_pthread_mutex_t *) SCM_SMOB_DATA_2 (port);
-  DIR *dir = (DIR *) SCM_SMOB_DATA_1 (port);
   char *name = 0;
   SCM_I_LOCKED_SYSCALL
-    (mutex,
+    (&d->mutex,
-     struct dirent_or_dirent64 *rdent = readdir_or_readdir64 (dir);
+     struct dirent_or_dirent64 *rdent = readdir_or_readdir64 (d->ds);
      if (rdent) name = strdup (rdent->d_name));
   if (name)
     return scm_take_locale_string (name);
@@ -2268,17 +2295,14 @@ SCM_DEFINE (scm_rewinddir, "rewinddir", 1, 0, 0,
 	    "@code{readdir} will return the first directory entry.")
 #define FUNC_NAME s_scm_rewinddir
 {
-  scm_i_pthread_mutex_t *mutex;
-
   SCM_VALIDATE_DIR (1, port);
-  if (!SCM_DIR_OPEN_P (port))
+  struct scm_directory *d = scm_to_directory (port);
+  if (!scm_dir_is_open (d))
     SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
 
-  mutex = (scm_i_pthread_mutex_t *) SCM_SMOB_DATA_2 (port);
+  scm_i_pthread_mutex_lock (&d->mutex);
-
+  rewinddir (d->ds);
-  scm_i_pthread_mutex_lock (mutex);
+  scm_i_pthread_mutex_unlock (&d->mutex);
-  rewinddir ((DIR *) SCM_SMOB_DATA_1 (port));
-  scm_i_pthread_mutex_unlock (mutex);
 
   return SCM_UNSPECIFIED;
 }
@@ -2292,16 +2316,18 @@ SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0,
 #define FUNC_NAME s_scm_closedir
 {
   SCM_VALIDATE_DIR (1, port);
+  struct scm_directory *d = scm_to_directory (port);
 
-  if (SCM_DIR_OPEN_P (port))
+  if (scm_dir_is_open (d))
     {
       int sts;
 
-      SCM_SYSCALL (sts = closedir ((DIR *) SCM_SMOB_DATA_1 (port)));
+      SCM_SYSCALL (sts = closedir (d->ds));
       if (sts != 0)
 	SCM_SYSERROR;
 
-      SCM_SET_SMOB_DATA_0 (port, scm_tc16_dir);
+      // Clear open flag.
+      d->tag_and_flags = scm_tc16_directory;
     }
 
   return SCM_UNSPECIFIED;
@@ -2310,31 +2336,29 @@ SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0,
 
 
 #ifdef HAVE_POSIX
-static int
+int
-scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
+scm_i_print_directory (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
+  struct scm_directory *d = scm_to_directory (exp);
   scm_puts ("#<", port);
-  if (!SCM_DIR_OPEN_P (exp))
+  if (!scm_dir_is_open (d))
     scm_puts ("closed: ", port);
   scm_puts ("directory stream ", port);
-  scm_uintprint (SCM_SMOB_DATA_1 (exp), 16, port);
+  scm_uintprint ((uintptr_t) d->ds, 16, port);
   scm_putc ('>', port);
   return 1;
 }
 
 
-static size_t
+void
-scm_dir_free (SCM p)
+scm_i_finalize_directory (struct scm_thread *thread, SCM dir)
 {
-  scm_i_pthread_mutex_t *mutex;
+  struct scm_directory *d = scm_to_directory (dir);
 
-  if (SCM_DIR_OPEN_P (p))
+  if (scm_dir_is_open (d))
-    closedir ((DIR *) SCM_SMOB_DATA_1 (p));
+    closedir (d->ds);
 
-  mutex = (scm_i_pthread_mutex_t *) SCM_SMOB_DATA_2 (p);
+  scm_i_pthread_mutex_destroy (&d->mutex);
-  scm_i_pthread_mutex_destroy (mutex);
-
-  return 0;
 }
 #endif
 
@@ -2344,10 +2368,6 @@ void
 scm_init_filesys ()
 {
 #ifdef HAVE_POSIX
-  scm_tc16_dir = scm_make_smob_type ("directory", 0);
-  scm_set_smob_free (scm_tc16_dir, scm_dir_free);
-  scm_set_smob_print (scm_tc16_dir, scm_dir_print);
-
 #ifdef O_RDONLY
   scm_c_define ("O_RDONLY", scm_from_int (O_RDONLY));
 #endif 	       

libguile/filesys.h

@@ -70,6 +70,8 @@ SCM_API SCM scm_basename (SCM filename, SCM suffix);
 SCM_API SCM scm_canonicalize_path (SCM path);
 SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
 SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
+SCM_INTERNAL int scm_i_print_directory (SCM exp, SCM port, scm_print_state *pstate);
+SCM_INTERNAL void scm_i_finalize_directory (struct scm_thread*, SCM);
 
 SCM_INTERNAL void scm_init_filesys (void);
 

libguile/finalizers.c

@@ -36,6 +36,7 @@
 #include "continuations.h"
 #include "eval.h"
 #include "extensions.h"
+#include "filesys.h"
 #include "foreign.h"
 #include "gc-internal.h"
 #include "gsubr.h"
@@ -76,6 +77,7 @@ enum builtin_finalizer_kind
     FINALIZE_KIND_STRUCT,
     FINALIZE_KIND_SMOB,
     FINALIZE_KIND_PORT,
+    FINALIZE_KIND_DIRECTORY,
   };
 
 static SCM
@@ -125,6 +127,12 @@ scm_i_add_port_finalizer (struct scm_thread *thread, SCM obj)
   return add_builtin_finalizer (thread, obj, FINALIZE_KIND_PORT);
 }
 
+SCM
+scm_i_add_directory_finalizer (struct scm_thread *thread, SCM obj)
+{
+  return add_builtin_finalizer (thread, obj, FINALIZE_KIND_DIRECTORY);
+}
+
 SCM
 scm_i_add_pointer_finalizer (struct scm_thread *thread, SCM obj, SCM free)
 {
@@ -173,6 +181,9 @@ run_finalizer (struct scm_thread *thread, SCM obj, SCM closure)
         case FINALIZE_KIND_PORT:
           scm_i_finalize_port (thread, obj);
           break;
+        case FINALIZE_KIND_DIRECTORY:
+          scm_i_finalize_directory (thread, obj);
+          break;
         default:
           abort ();
         }

libguile/finalizers.h

@@ -32,6 +32,8 @@ SCM_INTERNAL SCM scm_i_add_smob_finalizer (struct scm_thread *thread,
                                            SCM obj);
 SCM_INTERNAL SCM scm_i_add_port_finalizer (struct scm_thread *thread,
                                            SCM obj);
+SCM_INTERNAL SCM scm_i_add_directory_finalizer (struct scm_thread *thread,
+                                                SCM obj);
 SCM_INTERNAL SCM scm_i_add_pointer_finalizer (struct scm_thread *thread,
                                               SCM obj, SCM free);
 SCM_INTERNAL SCM scm_i_add_finalizer (struct scm_thread *thread, SCM obj,

libguile/goops.c

@@ -142,6 +142,7 @@ static SCM class_character_set;
 static SCM class_condition_variable;
 static SCM class_mutex;
 static SCM class_continuation;
+static SCM class_directory;
 
 static struct scm_ephemeron_table *vtable_class_map;
 static SCM pre_goops_vtables = SCM_EOL;
@@ -354,6 +355,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
                 return class_mutex;
               case scm_tc16_continuation:
                 return class_continuation;
+              case scm_tc16_directory:
+                return class_directory;
               default:
                 abort ();
               }
@@ -992,6 +995,7 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   class_condition_variable = scm_variable_ref (scm_c_lookup ("<condition-variable>"));
   class_mutex = scm_variable_ref (scm_c_lookup ("<mutex>"));
   class_continuation = scm_variable_ref (scm_c_lookup ("<continuation>"));
+  class_directory = scm_variable_ref (scm_c_lookup ("<directory>"));
 
   create_smob_classes ();
   create_struct_classes ();

libguile/print.c

@@ -42,6 +42,7 @@
 #include "ephemerons.h"
 #include "eval.h"
 #include "finalizers.h"
+#include "filesys.h"
 #include "fluids.h"
 #include "foreign.h"
 #include "frames.h"
@@ -801,6 +802,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
               case scm_tc16_continuation:
                 scm_i_print_continuation (exp, port, pstate);
                 break;
+              case scm_tc16_directory:
+                scm_i_print_directory (exp, port, pstate);
+                break;
               default:
                 abort ();
             }

libguile/scm.h

@@ -512,8 +512,8 @@ typedef uintptr_t scm_t_bits;
 #define scm_tc16_condition_variable	0x017f
 #define scm_tc16_mutex			0x027f
 #define scm_tc16_continuation		0x037f
+#define scm_tc16_directory		0x047f
 /*
-#define scm_tc16_directory		0x077f
 #define scm_tc16_hook			0x097f
 #define scm_tc16_macro			0x0a7f
 #define scm_tc16_malloc			0x0b7f

module/oop/goops.scm

@@ -1087,6 +1087,7 @@ slots as we go."
 (define-standard-class <condition-variable> (<top>))
 (define-standard-class <mutex> (<top>))
 (define-standard-class <continuation> (<top>))
+(define-standard-class <directory> (<top>))
 (define-standard-class <thread> (<top>))
 (define-standard-class <number> (<top>))
 (define-standard-class <complex> (<number>))
@@ -3539,7 +3540,6 @@ var{initargs}."
 (define <hook> (find-subclass <top> '<hook>))
 (define <bitvector> (find-subclass <top> '<bitvector>))
 (define <random-state> (find-subclass <top> '<random-state>))
-(define <directory> (find-subclass <top> '<directory>))
 (define <array> (find-subclass <top> '<array>))
 (define <macro> (find-subclass <top> '<macro>))