From: Craig A. Berry <craigberry@mac.com>
Date: Thu, 20 Mar 2003 23:03:36 +0000 (-0600)
Subject: readdir_r for VMS (was Re: [PATCH] configure.com: sig_num, etc.)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a9852f7cb9f92ad2f16959090e68f5c92d1fe0f1;p=p5sagit%2Fp5-mst-13.2.git

readdir_r for VMS (was Re: [PATCH] configure.com: sig_num, etc.)
From: "Craig A. Berry" <craigberry@mac.com>
Message-ID: <3E7A9D28.1040706@mac.com>

p4raw-id: //depot/perl@19042
---

diff --git a/configure.com b/configure.com
index 196c5b0..b6955cf 100644
--- a/configure.com
+++ b/configure.com
@@ -5919,7 +5919,7 @@ $ WC "d_getspnam_r='undef'"
 $ 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 "getspnam_r_proto='0'"
 $ 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'"
diff --git a/vms/vms.c b/vms/vms.c
index e0788f8..d5c8a98 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -4791,6 +4791,18 @@ Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
  *  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])
 
@@ -4833,6 +4845,12 @@ Perl_opendir(pTHX_ char *name)
     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() */
@@ -4858,6 +4876,10 @@ closedir(DIR *dd)
 {
     (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);
 }
 /*}}}*/
@@ -4972,6 +4994,28 @@ Perl_readdir(pTHX_ DIR *dd)
 /*}}}*/
 
 /*
+ *  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)*/
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 3ae8992..7f326a8 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -146,6 +146,7 @@
 #define my_getpwuid		Perl_my_getpwuid
 #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)
 #define vmssetenv(a,b,c)	Perl_vmssetenv(aTHX_ a,b,c)
@@ -191,6 +192,7 @@
 #define my_getpwuid(a)		Perl_my_getpwuid(aTHX_ a)
 #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
 #define telldir		Perl_telldir
@@ -563,6 +565,7 @@ typedef struct _dirdesc {
     char			*pattern;
     struct dirent		entry;
     struct dsc$descriptor_s	pat;
+    void			*mutex;
 } DIR;
 
 #define rewinddir(dirp)		seekdir((dirp), 0)
@@ -778,6 +781,7 @@ void	Perl_csighandler_init (void);
 int	Perl_my_utime (pTHX_ char *, struct utimbuf *);
 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);
 void	closedir (DIR *);