develooper Front page | perl.perl5.porters | Postings from October 2003

[PATCH 5.8.1] make reentr.[ch] compatible with 5.8.0 again

Thread Next
From:
Jan Dubois
Date:
October 30, 2003 17:03
Subject:
[PATCH 5.8.1] make reentr.[ch] compatible with 5.8.0 again
Message ID:
mja3qv47kmrhiip1l8pfl7bij0reesjr6p@4ax.com
I found more binary compatibility problems between 5.8.0 and 5.8.1:

The layout of the REENTR structure must not change, otherwise modules
compiled under 5.8.0 may crash when used under 5.8.1.

For a quick test, you can copy e.g. Socket.so or (File::)Glob.so from
5.8.0 into 5.8.1.  These won't be a problem in real life because they
are core modules, but any other module using functions redefined in
reentr.h is at risk.

Change #19122 modified the CRYPT_R buffer definition and change #18831
added additional prototypes for random(), gethostbyaddr() and
getnetbyaddr().  It also added additional variables for the HAS_RANDOM_R
case.

The attached patch modifies reentr.pl to create reentr.h with a REENTR
layout that is backwards compatible with 5.8.0.

As you may know, I'm also interested in forward compatibility.  Many new
definitions in reentr.h use the new PL_reentrant_retint variable, which
will not resolve under 5.8.0.  Outside the core I define the reentrant
functions with either GCC inline functions or static wrappers.  Since
the static wrappers need to expand Perl preprocessor macros, they need
to be included at a later stage in perl.h.  Therefore part of reentr.h
has been split of into reentr.inc.

The changes have been tested on Windows, Linux, Solaris and HP-UX,
with both GCC and vendor compilers on the last two platforms.  All tests
were successful and all previously failing compatibility tests pass now
as well.

I did *not* add the autogenerated reentr.[ch] files to this patch, so
after you apply it, you have run run reentr.pl.  Don't forget to p4 add
reentr.inc, which is a new file.

Most of the changes in the attached patch are not applicable to the
development branch except:

* I fixed the preprocessor symbols used to define _random_retval:

  REENTRANT_PROTO_iS => REENTRANT_PROTO_I_iS
  REENTRANT_PROTO_lS => REENTRANT_PROTO_I_lS
  REENTRANT_PROTO_tS => REENTRANT_PROTO_I_St

  (Note: the last one also swapped "tS" -> "St"!)

* The expression (PL_reentrant_retint > 0 && PL_reentrant_retint == ERANGE)
  can be simplified to just (PL_reentrant_retint == ERANGE) everywhere.

Let me know if I should submit a patch with just these 2 changes for the
development track.

Cheers,
-Jan

PS: I see one potential problem with the reentr.h definitions when used
in an extension using PERL_NO_GET_CONTEXT.  The redefined functions will
then need a dTHX if they are used in normal C code outside a PPCODE or
CODE section, which is somewhat surprising.  But this is already true for
the 5.8.1 version of the macros.


==== MANIFEST#54 (text) - MANIFEST#55 (text) ==== content
Index: MANIFEST
--- MANIFEST.~1~	Thu Oct 30 16:13:27 2003
+++ MANIFEST	Thu Oct 30 16:13:27 2003
@@ -2488,6 +2488,7 @@
 README.Y2K		Notes about Year 2000 concerns
 reentr.c			Reentrant interfaces
 reentr.h			Reentrant interfaces
+reentr.inc			Reentrant interfaces
 reentr.pl			Reentrant interfaces
 regcomp.c			Regular expression compiler
 regcomp.h			Private declarations for above
==== reentr.pl#4 (text) - reentr.pl#13 (text) ==== content
Index: reentr.pl
--- reentr.pl.~1~	Thu Oct 30 16:13:27 2003
+++ reentr.pl	Thu Oct 30 16:13:27 2003
@@ -54,7 +54,11 @@
 #define REENTR_H 
 
 #ifdef USE_REENTRANT_API
- 
+
+#ifdef PERL_CORE
+#   define PL_REENTRANT_RETINT PL_reentrant_retint
+#endif
+
 /* Deprecations: some platforms have the said reentrant interfaces
  * but they are declared obsolete and are not to be used.  Often this
  * means that the platform has threadsafed the interfaces (hopefully).
@@ -137,15 +141,19 @@
 my %seend; # the type of this function's "D"
 my %seenm; # all the types
 my %seenu; # the length of the argument list of this function
+my %seenr; # the return type of this function
 
 while (<DATA>) { # Read in the protypes.
     next if /^\s+$/;
     chomp;
     my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1);
-    my $u;
+    my ($r,$u);
     # Split off the real function name and the argument list.
     ($func, $u) = split(' ', $func);
-    $seenu{$func} = defined $u ? length $u : 0;
+    $u = "V_V" unless $u;
+    ($r, $u) = ($u =~ /^(.)_(.+)/);
+    $seenu{$func} = $u eq 'V' ? 0 : length $u;
+    $seenr{$func} = $r;
     my $FUNC = uc $func; # for output.
     push @seenf, $func;
     my %m = %map;
@@ -454,7 +462,7 @@
 #if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
 	$seend{$func} _${func}_data;
 #else
-	$seent{$func} *_${func}_struct_buffer;
+	$seent{$func} _${func}_struct;
 #endif
 EOF
     	    push @init, <<EOF;
@@ -469,7 +477,7 @@
 EOF
 	    pushssif $endif;
 	}
-        elsif ($func =~ /^(drand48|gmtime|localtime|random)$/) {
+        elsif ($func =~ /^(drand48|gmtime|localtime)$/) {
 	    pushssif $ifdef;
 	    push @struct, <<EOF;
 	$seent{$func} _${func}_struct;
@@ -478,19 +486,16 @@
 	        push @struct, <<EOF;
 	double	_${func}_double;
 EOF
-	    } elsif ($1 eq 'random') {
+	    }
+	    pushssif $endif;
+	}
+        elsif ($func =~ /^random$/) {
+	    pushssif $ifdef;
 	    push @struct, <<EOF;
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_iS
-	int	_${func}_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_lS
-	long	_${func}_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_tS
-	int32_t	_${func}_retval;
+#   if RANDOM_R_PROTO != REENTRANT_PROTO_I_St
+	$seent{$func} _${func}_struct;
 #   endif
 EOF
-	    }
 	    pushssif $endif;
 	}
         elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) {
@@ -679,7 +684,6 @@
 		$w = ", $w" if length $v;
 	    }
 	    my $call = "${func}_r($v$w)";
-	    $call = "((PL_reentrant_retint = $call))" if $r eq 'I' && $func ne 'random';
 	    push @wrap, <<EOF;
 #   if !defined($func) && ${FUNC}_R_PROTO == REENTRANT_PROTO_$p
 EOF
@@ -688,22 +692,36 @@
 #       define $func($v) $call
 EOF
 	    } else {
+		$call = "((PL_REENTRANT_RETINT = $call))" if $r eq 'I' && $func ne 'random';
 		if ($func =~ /^get/) {
 		    my $rv = $v ? ", $v" : "";
 		    if ($r eq 'I') {
-			push @wrap, <<EOF;
-#       define $func($v) ($call$test ? $true : (((PL_reentrant_retint > 0 && PL_reentrant_retint == ERANGE) || (errno == ERANGE)) ? Perl_reentrant_retry("$func"$rv) : 0))
-EOF
+			$call = qq[($call$test ? $true : (((PL_REENTRANT_RETINT == ERANGE) || (errno == ERANGE)) ? Perl_reentrant_retry("$func"$rv) : 0))];
 		    } else {
-			push @wrap, <<EOF;
-#       define $func($v) ($call$test ? $true : ((errno == ERANGE) ? Perl_reentrant_retry("$func"$rv) : 0))
-EOF
+			$call = qq[($call$test ? $true : ((errno == ERANGE) ? Perl_reentrant_retry("$func"$rv) : 0))];
                     }
 		} else {
-		    push @wrap, <<EOF;
-#       define $func($v) ($call$test ? $true : 0)
+		    $call = qq[($call$test ? $true : 0)];
+		}
+
+		my $arg = join(", ", map { $seenm{$func}{substr($a,$_,1)}." ".$v[$_] } 0..$seenu{$func}-1);
+		my $ret = $seenr{$func} eq 'V' ? "" : "return ";
+		push @wrap, <<EOF;
+#       ifdef PERL_CORE
+#           define $func($v) $call
+#       else
+#           if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
+#               define $func($v) ({int PL_REENTRANT_RETINT; $call;})
+#           else
+#               define $func($v) S_my_$func($v)
+                static $seenm{$func}{$seenr{$func}} S_my_$func($arg) {
+                    dTHX;
+                    int PL_REENTRANT_RETINT;
+                    $ret$call;
+                }
+#           endif
+#       endif
 EOF
-		}
 	    }
 	    push @wrap, <<EOF;
 #   endif
@@ -714,6 +732,38 @@
     }
 }
 
+# New struct members added here to maintain binary compatibility with 5.8.0
+
+if (exists $seena{crypt}) {
+    push @struct, <<EOF;
+#ifdef HAS_CRYPT_R
+#if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
+#else
+	struct crypt_data *_crypt_struct_buffer;
+#endif
+#endif /* HAS_CRYPT_R */
+EOF
+}
+
+if (exists $seena{random}) {
+    push @struct, <<EOF;
+#ifdef HAS_RANDOM_R
+#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_iS
+	int	_random_retval;
+#   endif
+#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_lS
+	long	_random_retval;
+#   endif
+#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_St
+	$seent{random} _random_struct;
+	int32_t	_random_retval;
+#   endif
+#endif /* HAS_RANDOM_R */
+EOF
+}
+
+
+
 local $" = '';
 
 print <<EOF;
@@ -726,7 +776,35 @@
     int dummy; /* cannot have empty structs */
 } REENTR;
 
-/* The wrappers. */
+#endif /* USE_REENTRANT_API */
+
+#endif
+EOF
+
+close(H);
+
+die "reentr.inc: $!" unless open(H, ">reentr.inc");
+select H;
+
+local $" = '';
+
+print <<EOF;
+/*
+ *    reentr.inc
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+ *  This file is built by reentrl.pl from data in reentr.pl.
+ */
+
+#ifndef REENTRINC
+#define REENTRINC
+
+#ifdef USE_REENTRANT_API
+
+/* The reentrant wrappers. */
 
 @wrap
 
@@ -1022,51 +1100,51 @@
 EOF
 
 __DATA__
-asctime S	|time	|const struct tm|B_SB|B_SBI|I_SB|I_SBI
-crypt CC	|crypt	|struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
-ctermid	B	|stdio	|		|B_B
-ctime S		|time	|const time_t	|B_SB|B_SBI|I_SB|I_SBI
-drand48		|stdlib	|struct drand48_data	|I_ST|T=double*
+asctime B_S	|time	|const struct tm|B_SB|B_SBI|I_SB|I_SBI
+crypt B_CC	|crypt	|struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
+ctermid	B_B	|stdio	|		|B_B
+ctime B_S	|time	|const time_t	|B_SB|B_SBI|I_SB|I_SBI
+drand48	d_V	|stdlib	|struct drand48_data	|I_ST|T=double*|d=double
 endgrent	|grp	|		|I_H|V_H
 endhostent	|netdb	|		|I_D|V_D|D=struct hostent_data*
 endnetent	|netdb	|		|I_D|V_D|D=struct netent_data*
 endprotoent	|netdb	|		|I_D|V_D|D=struct protoent_data*
 endpwent	|pwd	|		|I_H|V_H
 endservent	|netdb	|		|I_D|V_D|D=struct servent_data*
-getgrent	|grp	|struct group	|I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
-getgrgid T	|grp	|struct group	|I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=gid_t
-getgrnam C	|grp	|struct group	|I_CSBWR|I_CSBIR|S_CBI|I_CSBI|S_CSBI
-gethostbyaddr CWI	|netdb	|struct hostent	|I_CWISBWRE|S_CWISBWIE|S_CWISBIE|S_TWISBIE|S_CIISBIE|S_CSBIE|S_TSBIE|I_CWISD|I_CIISD|I_CII|I_TsISBWRE|D=struct hostent_data*|T=const void*|s=socklen_t
-gethostbyname C	|netdb	|struct hostent	|I_CSBWRE|S_CSBIE|I_CSD|D=struct hostent_data*
-gethostent	|netdb	|struct hostent	|I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct hostent_data*
-getlogin	|unistd	|		|I_BW|I_BI|B_BW|B_BI
-getnetbyaddr LI	|netdb	|struct netent	|I_UISBWRE|I_LISBI|S_TISBI|S_LISBI|I_TISD|I_LISD|I_IISD|I_uISBWRE|D=struct netent_data*|T=in_addr_t|U=unsigned long|u=uint32_t
-getnetbyname C	|netdb	|struct netent	|I_CSBWRE|I_CSBI|S_CSBI|I_CSD|D=struct netent_data*
-getnetent	|netdb	|struct netent	|I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct netent_data*
-getprotobyname C|netdb	|struct protoent|I_CSBWR|S_CSBI|I_CSD|D=struct protoent_data*
-getprotobynumber I	|netdb	|struct protoent|I_ISBWR|S_ISBI|I_ISD|D=struct protoent_data*
-getprotoent	|netdb	|struct protoent|I_SBWR|I_SBI|S_SBI|I_SD|D=struct protoent_data*
-getpwent	|pwd	|struct passwd	|I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
-getpwnam C	|pwd	|struct passwd	|I_CSBWR|I_CSBIR|S_CSBI|I_CSBI
-getpwuid T	|pwd	|struct passwd	|I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=uid_t
-getservbyname CC|netdb	|struct servent	|I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent_data*
-getservbyport IC|netdb	|struct servent	|I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
-getservent	|netdb	|struct servent	|I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
-getspnam C	|shadow	|struct spwd	|I_CSBWR|S_CSBI
-gmtime T	|time	|struct tm	|S_TS|I_TS|T=const time_t*
-localtime T	|time	|struct tm	|S_TS|I_TS|T=const time_t*
-random		|stdlib	|struct random_data|I_iS|I_lS|I_St|i=int*|l=long*|t=int32_t*
-readdir T	|dirent	|struct dirent	|I_TSR|I_TS|T=DIR*
-readdir64 T	|dirent	|struct dirent64|I_TSR|I_TS|T=DIR*
+getgrent S_V	|grp	|struct group	|I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
+getgrgid S_T	|grp	|struct group	|I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=gid_t
+getgrnam S_C	|grp	|struct group	|I_CSBWR|I_CSBIR|S_CBI|I_CSBI|S_CSBI
+gethostbyaddr S_CWI	|netdb	|struct hostent	|I_CWISBWRE|S_CWISBWIE|S_CWISBIE|S_TWISBIE|S_CIISBIE|S_CSBIE|S_TSBIE|I_CWISD|I_CIISD|I_CII|I_TsISBWRE|D=struct hostent_data*|T=const void*|s=socklen_t
+gethostbyname S_C	|netdb	|struct hostent	|I_CSBWRE|S_CSBIE|I_CSD|D=struct hostent_data*
+gethostent S_V	|netdb	|struct hostent	|I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct hostent_data*
+getlogin B_V	|unistd	|		|I_BW|I_BI|B_BW|B_BI
+getnetbyaddr S_LI	|netdb	|struct netent	|I_UISBWRE|I_LISBI|S_TISBI|S_LISBI|I_TISD|I_LISD|I_IISD|I_uISBWRE|D=struct netent_data*|T=in_addr_t|U=unsigned long|u=uint32_t
+getnetbyname S_C	|netdb	|struct netent	|I_CSBWRE|I_CSBI|S_CSBI|I_CSD|D=struct netent_data*
+getnetent S_V	|netdb	|struct netent	|I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct netent_data*
+getprotobyname S_C	|netdb	|struct protoent|I_CSBWR|S_CSBI|I_CSD|D=struct protoent_data*
+getprotobynumber S_I	|netdb	|struct protoent|I_ISBWR|S_ISBI|I_ISD|D=struct protoent_data*
+getprotoent S_V	|netdb	|struct protoent|I_SBWR|I_SBI|S_SBI|I_SD|D=struct protoent_data*
+getpwent S_V	|pwd	|struct passwd	|I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
+getpwnam S_C	|pwd	|struct passwd	|I_CSBWR|I_CSBIR|S_CSBI|I_CSBI
+getpwuid S_T	|pwd	|struct passwd	|I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=uid_t
+getservbyname S_CC	|netdb	|struct servent	|I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent_data*
+getservbyport S_IC	|netdb	|struct servent	|I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
+getservent S_V	|netdb	|struct servent	|I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
+getspnam S_C	|shadow	|struct spwd	|I_CSBWR|S_CSBI
+gmtime S_T	|time	|struct tm	|S_TS|I_TS|T=const time_t*
+localtime S_T	|time	|struct tm	|S_TS|I_TS|T=const time_t*
+random L_V	|stdlib	|struct random_data|I_iS|I_lS|I_St|i=int*|l=long*|t=int32_t*
+readdir S_T	|dirent	|struct dirent	|I_TSR|I_TS|T=DIR*
+readdir64 S_T	|dirent	|struct dirent64|I_TSR|I_TS|T=DIR*
 setgrent	|grp	|		|I_H|V_H
-sethostent I	|netdb	|		|I_ID|V_ID|D=struct hostent_data*
-setlocale IC	|locale	|		|I_ICBI
-setnetent I	|netdb	|		|I_ID|V_ID|D=struct netent_data*
-setprotoent I	|netdb	|		|I_ID|V_ID|D=struct protoent_data*
+sethostent V_I	|netdb	|		|I_ID|V_ID|D=struct hostent_data*
+setlocale B_IC	|locale	|		|I_ICBI
+setnetent V_I	|netdb	|		|I_ID|V_ID|D=struct netent_data*
+setprotoent V_I	|netdb	|		|I_ID|V_ID|D=struct protoent_data*
 setpwent	|pwd	|		|I_H|V_H
-setservent I	|netdb	|		|I_ID|V_ID|D=struct servent_data*
-srand48 L	|stdlib	|struct drand48_data	|I_LS
-srandom	T	|stdlib	|struct random_data|I_TS|T=unsigned int
-strerror I	|string	|		|I_IBW|I_IBI|B_IBW
-tmpnam B	|stdio	|		|B_B
-ttyname	I	|unistd	|		|I_IBW|I_IBI|B_IBI
+setservent V_I	|netdb	|		|I_ID|V_ID|D=struct servent_data*
+srand48 V_L	|stdlib	|struct drand48_data	|I_LS
+srandom	V_T	|stdlib	|struct random_data|I_TS|T=unsigned int
+strerror B_I	|string	|		|I_IBW|I_IBI|B_IBW
+tmpnam B_B	|stdio	|		|B_B
+ttyname	B_I	|unistd	|		|I_IBW|I_IBI|B_IBI
==== perl.h#73 (text) - perl.h#74 (text) ==== content
Index: perl.h
--- perl.h.~1~	Thu Oct 30 16:13:27 2003
+++ perl.h	Thu Oct 30 16:13:27 2003
@@ -3592,6 +3592,8 @@
 END_EXTERN_C
 #endif
 
+#include "reentr.inc"
+
 #undef PERLVAR
 #undef PERLVARA
 #undef PERLVARI
==== installperl#21 (xtext) - installperl#22 (xtext) ==== content
Index: installperl
--- installperl.~1~	Thu Oct 30 16:13:27 2003
+++ installperl	Thu Oct 30 16:13:27 2003
@@ -403,7 +403,7 @@
 }
 else {
     # [als] hard-coded 'libperl' name... not good!
-    @corefiles = <*.h libperl*.*>;
+    @corefiles = <*.h *.inc libperl*.*>;
 
     # AIX needs perl.exp installed as well.
     push(@corefiles,'perl.exp') if $^O eq 'aix';
==== win32/Makefile#82 (text) - win32/Makefile#84 (text) ==== content
Index: win32/Makefile
--- win32/Makefile.~1~	Thu Oct 30 16:13:27 2003
+++ win32/Makefile	Thu Oct 30 16:13:27 2003
@@ -886,6 +886,7 @@
 	cd win32
 	if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
 	$(XCOPY) ..\*.h $(COREDIR)\*.*
+	$(XCOPY) ..\*.inc $(COREDIR)\*.*
 	$(XCOPY) *.h $(COREDIR)\*.*
 	$(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
 	$(RCOPY) include $(COREDIR)\*.*
==== win32/makefile.mk#61 (text) - win32/makefile.mk#63 (text) ==== content
Index: win32/makefile.mk
--- win32/makefile.mk.~1~	Thu Oct 30 16:13:27 2003
+++ win32/makefile.mk	Thu Oct 30 16:13:27 2003
@@ -967,6 +967,7 @@
 	cd .. && miniperl configpm
 	if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
 	$(XCOPY) ..\*.h $(COREDIR)\*.*
+	$(XCOPY) ..\*.inc $(COREDIR)\*.*
 	$(XCOPY) *.h $(COREDIR)\*.*
 	$(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
 	$(RCOPY) include $(COREDIR)\*.*
End of Patch.


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About