Change 19042 by [EMAIL PROTECTED] on 2003/03/21 07:45:54
Subject: [PATCH] readdir_r for VMS (was Re: [PATCH] configure.com: sig_num,
etc.)
From: "Craig A. Berry" <[EMAIL PROTECTED]>
Date: Thu, 20 Mar 2003 23:03:36 -0600
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/configure.com#174 edit
... //depot/perl/vms/vms.c#121 edit
... //depot/perl/vms/vmsish.h#56 edit
Differences ...
==== //depot/perl/configure.com#174 (text) ====
Index: perl/configure.com
--- perl/configure.com#173~19023~ Tue Mar 18 13:22:03 2003
+++ perl/configure.com Thu Mar 20 23:45:54 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'"
==== //depot/perl/vms/vms.c#121 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#120~18927~ Tue Mar 11 12:04:33 2003
+++ perl/vms/vms.c Thu Mar 20 23:45:54 2003
@@ -4791,6 +4791,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])
@@ -4833,6 +4845,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() */
@@ -4858,6 +4876,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);
}
/*}}}*/
@@ -4969,6 +4991,28 @@
return &dd->entry;
} /* end of readdir() */
+/*}}}*/
+
+/*
+ * 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() */
/*}}}*/
/*
==== //depot/perl/vms/vmsish.h#56 (text) ====
Index: perl/vms/vmsish.h
--- perl/vms/vmsish.h#55~16701~ Sun May 19 19:23:03 2002
+++ perl/vms/vmsish.h Thu Mar 20 23:45:54 2003
@@ -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 @@
char *pattern;
struct dirent entry;
struct dsc$descriptor_s pat;
+ void *mutex;
} DIR;
#define rewinddir(dirp) seekdir((dirp), 0)
@@ -778,6 +781,7 @@
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 *);
End of Patch.
