[PATCH] readdir_r for VMS (was Re: [PATCH] configure.com: sig_num, etc.)

[Craig A. Berry]

Thanks to those who replied to my query about readdir and thread safety.
I've dug around a bit, read the POSIX spec for readdir_r, and come up
with the implementation in the attached patch. It basically just adds a
mutex gizmo to the directory stream structure and puts a lock on it
while calling the ordinary readdir and assigning return values. All
tests pass with a threaded build of this on top of [EMAIL PROTECTED]
(though they did before the patch as well).
To really stress test this with multiple threads going after the same
directory stream I'd need an SMP machine to test on, which I don't have.
But I think we are at least somewhat safer than we were before.
The affected files are:

configure.com
vms/vms.c
vms/vmsish.h

--- configure.com;-0    Wed Mar 19 11:07:12 2003
+++ configure.com       Thu Mar 20 10:02:45 2003
@@ -5919,7 +5919,7 @@
 $ WC "d_gmtime_r='undef'"      ! leave undef'd; we use my_gmtime
 $ WC "d_localtime_r='undef'"   ! leave undef'd; we use my_localtime
 $ WC "d_random_r='undef'"
-$ WC "d_readdir_r='undef'"     ! leave undef'd; we use Perl_readdir
+$ WC "d_readdir_r='define'"    ! always defined; we roll our own
 $ WC "d_readdir64_r='undef'"
 $ WC "d_setgrent_r='undef'"
 $ WC "d_sethostent_r='undef'"
@@ -5965,7 +5965,7 @@
 $ WC "gmtime_r_proto='0'"
 $ WC "localtime_r_proto='0'"
 $ WC "random_r_proto='0'"
-$ WC "readdir_r_proto='0'"     ! leave undef'd; we use Perl_readdir
+$ WC "readdir_r_proto='REENTRANT_PROTO_I_TSR'"  ! always defined; we roll our own
 $ WC "readdir64_r_proto='0'"
 $ WC "setgrent_r_proto='0'"
 $ WC "sethostent_r_proto='0'"
--- vms/vms.c;-0        Tue Mar 11 15:20:00 2003
+++ vms/vms.c   Thu Mar 20 13:13:52 2003
@@ -4827,6 +4827,18 @@
  *  Minor modifications to original routines.
  */
 
+/* readdir may have been redefined by reentr.h, so make sure we get
+ * the local version for what we do here.
+ */
+#ifdef readdir
+# undef readdir
+#endif
+#if !defined(PERL_IMPLICIT_CONTEXT)
+# define readdir Perl_readdir
+#else
+# define readdir(a) Perl_readdir(aTHX_ a)
+#endif
+
     /* Number of elements in vms_versions array */
 #define VERSIZE(e)     (sizeof e->vms_versions / sizeof e->vms_versions[0])
 
@@ -4869,6 +4881,12 @@
     dd->pat.dsc$w_length = strlen(dd->pattern);
     dd->pat.dsc$b_dtype = DSC$K_DTYPE_T;
     dd->pat.dsc$b_class = DSC$K_CLASS_S;
+#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+    New(1308,dd->mutex,1,perl_mutex);
+    MUTEX_INIT( (perl_mutex *) dd->mutex );
+#else
+    dd->mutex = NULL;
+#endif
 
     return dd;
 }  /* end of opendir() */
@@ -4894,6 +4912,10 @@
 {
     (void)lib$find_file_end(&dd->context);
     Safefree(dd->pattern);
+#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+    MUTEX_DESTROY( (perl_mutex *) dd->mutex );
+    Safefree(dd->mutex);
+#endif
     Safefree((char *)dd);
 }
 /*}}}*/
@@ -5008,6 +5030,28 @@
 /*}}}*/
 
 /*
+ *  Read the next entry from the directory -- thread-safe version.
+ */
+/*{{{ int readdir_r(DIR *dd, struct dirent *entry, struct dirent **result)*/
+int
+Perl_readdir_r(pTHX_ DIR *dd, struct dirent *entry, struct dirent **result)
+{
+    int retval;
+
+    MUTEX_LOCK( (perl_mutex *) dd->mutex );
+
+    entry = readdir(dd);
+    *result = entry;
+    retval = ( *result == NULL ? errno : 0 );
+
+    MUTEX_UNLOCK( (perl_mutex *) dd->mutex );
+
+    return retval;
+
+}  /* end of readdir_r() */
+/*}}}*/
+
+/*
  *  Return something that can be used in a seekdir later.
  */
 /*{{{ long telldir(DIR *dd)*/
--- vms/vmsish.h;-0     Fri Jul 19 17:50:14 2002
+++ vms/vmsish.h        Thu Mar 20 10:02:46 2003
@@ -147,4 +147,5 @@
 #define my_flush               Perl_my_flush
 #define readdir                        Perl_readdir
+#define readdir_r              Perl_readdir_r
 #else
 #define my_getenv_len(a,b,c)   Perl_my_getenv_len(aTHX_ a,b,c)
@@ -192,4 +193,5 @@
 #define my_flush(a)            Perl_my_flush(aTHX_ a)
 #define readdir(a)             Perl_readdir(aTHX_ a)
+#define readdir_r(a,b,c)       Perl_readdir_r(aTHX_ a,b,c)
 #endif
 #define my_gconvert            Perl_my_gconvert
@@ -564,4 +566,5 @@
     struct dirent              entry;
     struct dsc$descriptor_s    pat;
+    void                       *mutex;
 } DIR;
 
@@ -779,4 +782,5 @@
 void   Perl_vms_image_init (int *, char ***);
 struct dirent *        Perl_readdir (pTHX_ DIR *);
+int    Perl_readdir_r(pTHX_ DIR *, struct dirent *, struct dirent **);
 long   telldir (DIR *);
 void   Perl_seekdir (pTHX_ DIR *, long);