X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ce716c52d393ac84495b7b8f262c39ecc5447cc9..c6709bf9918ed61b4a7a0ad24887085bdf1732c9:/regen/reentr.pl

diff --git a/regen/reentr.pl b/regen/reentr.pl
index 6c7b5e6..b73193c 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -18,7 +18,7 @@
 
 BEGIN {
     # Get function prototypes
-    require 'regen/regen_lib.pl';
+    require './regen/regen_lib.pl';
 }
 
 use strict;
@@ -50,15 +50,18 @@ my %map = (
 # Example #2: S_SBIE  means type func_r(type, char*, int, int*)
 # Example #3: S_CBI   means type func_r(const char*, char*, int)
 
+sub open_print_header {
+    my ($file, $quote) = @_;
+    return open_new($file, '>',
+		    { by => 'regen/reentr.pl',
+		      from => 'data in regen/reentr.pl',
+		      file => $file, style => '*',
+		      copyright => [2002, 2003, 2005 .. 2007],
+		      quote => $quote });
+}
 
-my $h = safer_open('reentr.h-new', 'reentr.h');
-select $h;
-print read_only_top(lang => 'C', by => 'regen/reentr.pl',
-		    from => 'data in regen/reentr.pl',
-		    file => 'reentr.h', style => '*',
-		    copyright => [2002, 2003, 2005 .. 2007]);
-
-print <<EOF;
+my $h = open_print_header('reentr.h');
+print $h <<EOF;
 #ifndef REENTR_H
 #define REENTR_H
 
@@ -88,13 +91,11 @@ print <<EOF;
 
 #ifdef __hpux
 #   undef HAS_CRYPT_R
-#   undef HAS_DRAND48_R
 #   undef HAS_ENDGRENT_R
 #   undef HAS_ENDPWENT_R
 #   undef HAS_GETGRENT_R
 #   undef HAS_GETPWENT_R
 #   undef HAS_SETLOCALE_R
-#   undef HAS_SRAND48_R
 #   undef HAS_STRERROR_R
 #   define NETDB_R_OBSOLETE
 #endif
@@ -105,6 +106,11 @@ print <<EOF;
 #   define NETDB_R_OBSOLETE
 #endif
 
+#if defined(__GLIBC__) && (__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 24))
+#   undef HAS_READDIR_R
+#   undef HAS_READDIR64_R
+#endif
+
 /*
  * As of OpenBSD 3.7, reentrant functions are now working, they just are
  * incompatible with everyone else.  To make OpenBSD happy, we have to
@@ -148,9 +154,6 @@ print <<EOF;
 #ifdef I_NETDB
 #   include <netdb.h>
 #endif
-#ifdef I_STDLIB
-#   include <stdlib.h>	/* drand48_data */
-#endif
 #ifdef I_CRYPT
 #   ifdef I_CRYPT
 #       include <crypt.h>
@@ -174,7 +177,7 @@ 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
 
-while (<DATA>) { # Read in the protypes.
+while (<DATA>) { # Read in the protoypes.
     next if /^\s+$/;
     chomp;
     my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1);
@@ -200,9 +203,8 @@ while (<DATA>) { # Read in the protypes.
     }
 
     # If given the -U option open up the metaconfig unit for this function.
-    if ($opts{U} && open(U, ">d_${func}_r.U"))  {
+    if ($opts{U} && open(U, ">", "d_${func}_r.U"))  {
     	binmode U;
-	select U;
     }
 
     if ($opts{U}) {
@@ -223,7 +225,7 @@ while (<DATA>) { # Read in the protypes.
 	    push @prereq, 'i_systime';
 	}
 	# Output the metaconfig unit header.
-	print <<EOF;
+	print U <<"EOF";
 ?RCS: \$Id: d_${func}_r.U,v $
 ?RCS:
 ?RCS: Copyright (c) 2002,2003 Jarkko Hietaniemi
@@ -268,7 +270,7 @@ eval \$inlibc
 case "\$d_${func}_r" in
 "\$define")
 EOF
-	print <<EOF;
+	print U <<"EOF";
 	hdrs="$hdrs"
 	case "\$d_${func}_r_proto:\$usethreads" in
 	":define")	d_${func}_r_proto=define
@@ -284,7 +286,7 @@ EOF
         my ($r, $a) = ($p =~ /^(.)_(.+)/);
 	my $v = join(", ", map { $m{$_} } split '', $a);
 	if ($opts{U}) {
-	    print <<EOF ;
+	    print U <<"EOF";
 	case "\$${func}_r_proto" in
 	''|0) try='$m{$r} ${func}_r($v);'
 	./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;;
@@ -300,7 +302,7 @@ EOF
 	$seenm{$func} = \%m;
     }
     if ($opts{U}) {
-	print <<EOF;
+	print U <<"EOF";
 	case "\$${func}_r_proto" in
 	''|0)	d_${func}_r=undef
  	        ${func}_r_proto=0
@@ -331,15 +333,11 @@ EOF
 
 close DATA;
 
-# Prepare to continue writing the reentr.h.
-
-select $h;
-
 {
     # Write out all the known prototype signatures.
     my $i = 1;
     for my $p (sort keys %seenp) {
-	print "#define REENTRANT_PROTO_${p}	${i}\n";
+	print $h "#define REENTRANT_PROTO_${p}	${i}\n";
 	$i++;
     }
 }
@@ -506,30 +504,6 @@ EOF
 EOF
 	    pushssif $endif;
 	}
-        elsif ($func =~ /^(drand48|random|srandom)$/) {
-	    pushssif $ifdef;
-	    push @struct, <<EOF;
-	$seent{$func} _${func}_struct;
-EOF
-	    if ($1 eq 'drand48') {
-	        push @struct, <<EOF;
-	double	_${func}_double;
-EOF
-	    } elsif ($1 eq 'random') {
-	    push @struct, <<EOF;
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_iS
-	int	_${func}_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_lS
-	long	_${func}_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_St
-	int32_t	_${func}_retval;
-#   endif
-EOF
-	    }
-	    pushssif $endif;
-	}
         elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) {
 	    pushssif $ifdef;
 	    # 'genfunc' can be read either as 'generic' or 'genre',
@@ -589,7 +563,7 @@ EOF
 	    my $GENFUNC = uc $genfunc;
 	    my $D = ifprotomatch($FUNC, grep {/D/} @p);
 	    my $d = $seend{$func};
-	    $d =~ s/\*$//; # snip: we need need the base type.
+	    $d =~ s/\*$//; # snip: we need the base type.
 	    push @struct, <<EOF;
 	$seent{$func}	_${genfunc}_struct;
 #   if $D
@@ -666,18 +640,12 @@ EOF
 	    my $genfunc = $func;
 	    if ($genfunc =~ /^(?:get|set|end)(pw|gr|host|net|proto|serv|sp)/) {
 		$genfunc = "${1}ent";
-	    } elsif ($genfunc eq 'srand48') {
-		$genfunc = "drand48";
 	    }
 	    my $b = $a;
 	    my $w = '';
 	    substr($b, 0, $seenu{$func}) = '';
-	    if ($func =~ /^random$/) {
-		$true = "PL_reentrant_buffer->_random_retval";
-	    } elsif ($b =~ /R/) {
+	    if ($b =~ /R/) {
 		$true = "PL_reentrant_buffer->_${genfunc}_ptr";
-	    } elsif ($b =~ /T/ && $func eq 'drand48') {
-		$true = "PL_reentrant_buffer->_${genfunc}_double";
 	    } elsif ($b =~ /S/) {
 		if ($func =~ /^readdir/) {
 		    $true = "PL_reentrant_buffer->_${genfunc}_struct";
@@ -708,10 +676,6 @@ EOF
 				  $func =~ /^crypt$/ ?
 				  "PL_reentrant_buffer->_${genfunc}_struct_buffer" :
 				  "&PL_reentrant_buffer->_${genfunc}_struct") :
-			     $_ eq 'T' && $func eq 'drand48' ?
-				 "&PL_reentrant_buffer->_${genfunc}_double" :
-			     $_ =~ /^[ilt]$/ && $func eq 'random' ?
-				 "&PL_reentrant_buffer->_random_retval" :
 				 $_
 			 } split '', $b;
 		$w = ", $w" if length $v;
@@ -765,7 +729,7 @@ EOF
 
 local $" = '';
 
-print <<EOF;
+print $h <<EOF;
 
 /* Defines for indicating which special features are supported. */
 
@@ -788,17 +752,17 @@ read_only_bottom_close_and_rename($h);
 
 # Prepare to write the reentr.c.
 
-my $c = safer_open('reentr.c-new', 'reentr.c');
-select $c;
-my $top = read_only_top(lang => 'C', by => 'regen/reentr.pl',
-			from => 'data in regen/reentr.pl',
-			file => 'reentr.c', style => '*',
-			copyright => [2002, 2003, 2005 .. 2007]);
+my $c = open_print_header('reentr.c', <<'EOQ');
+ */
 
-$top =~ s! \*/\n! *
+/*
  * "Saruman," I said, standing away from him, "only one hand at a time can
- *  wield the One, and you know that well, so do not trouble to say we\!"
+ *  wield the One, and you know that well, so do not trouble to say we!"
  *
+ *     [p.260 of _The Lord of the Rings_, II/ii: "The Council of Elrond"]
+ */
+
+/*
  * This file contains a collection of automatically created wrappers
  * (created by running reentr.pl) for reentrant (thread-safe) versions of
  * various library calls, such as getpwent_r.  The wrapping is done so
@@ -806,16 +770,24 @@ $top =~ s! \*/\n! *
  * care about the differences between various platforms' idiosyncrasies
  * regarding these reentrant interfaces.  
  */
-!s;
+EOQ
 
-print $top, <<EOF;
+print $c <<"EOF";
 #include "EXTERN.h"
 #define PERL_IN_REENTR_C
 #include "perl.h"
 #include "reentr.h"
 
+#define RenewDouble(data_pointer, size_pointer, type) \\
+    STMT_START { \\
+	const size_t size = *(size_pointer) * 2; \\
+	Renew((data_pointer), (size), type); \\
+	*(size_pointer) = size; \\
+    } STMT_END
+
 void
 Perl_reentrant_size(pTHX) {
+	PERL_UNUSED_CONTEXT;
 #ifdef USE_REENTRANT_API
 #define REENTRANTSMALLSIZE	 256	/* Make something up. */
 #define REENTRANTUSUALSIZE	4096	/* Make something up. */
@@ -825,6 +797,7 @@ Perl_reentrant_size(pTHX) {
 
 void
 Perl_reentrant_init(pTHX) {
+	PERL_UNUSED_CONTEXT;
 #ifdef USE_REENTRANT_API
 	Newx(PL_reentrant_buffer, 1, REENTR);
 	Perl_reentrant_size(aTHX);
@@ -834,6 +807,7 @@ Perl_reentrant_init(pTHX) {
 
 void
 Perl_reentrant_free(pTHX) {
+	PERL_UNUSED_CONTEXT;
 #ifdef USE_REENTRANT_API
 @free
 	Safefree(PL_reentrant_buffer);
@@ -843,10 +817,10 @@ Perl_reentrant_free(pTHX) {
 void*
 Perl_reentrant_retry(const char *f, ...)
 {
-    dTHX;
     void *retptr = NULL;
     va_list ap;
 #ifdef USE_REENTRANT_API
+    dTHX;
     /* Easier to special case this here than in embed.pl. (Look at what it
        generates for proto.h) */
     PERL_ARGS_ASSERT_REENTRANT_RETRY;
@@ -878,9 +852,8 @@ Perl_reentrant_retry(const char *f, ...)
 		PERL_REENTRANT_MAXSIZE / 2)
 #endif
 	    {
-		PL_reentrant_buffer->_hostent_size *= 2;
-		Renew(PL_reentrant_buffer->_hostent_buffer,
-		      PL_reentrant_buffer->_hostent_size, char);
+		RenewDouble(PL_reentrant_buffer->_hostent_buffer,
+			&PL_reentrant_buffer->_hostent_size, char);
 		switch (PL_op->op_type) {
 	        case OP_GHBYADDR:
 		    p0    = va_arg(ap, void *);
@@ -911,9 +884,8 @@ Perl_reentrant_retry(const char *f, ...)
 #endif
 	    {
 		Gid_t gid;
-		PL_reentrant_buffer->_grent_size *= 2;
-		Renew(PL_reentrant_buffer->_grent_buffer,
-		      PL_reentrant_buffer->_grent_size, char);
+		RenewDouble(PL_reentrant_buffer->_grent_buffer,
+		      &PL_reentrant_buffer->_grent_size, char);
 		switch (PL_op->op_type) {
 	        case OP_GGRNAM:
 		    p0 = va_arg(ap, void *);
@@ -946,9 +918,8 @@ Perl_reentrant_retry(const char *f, ...)
 #endif
 	    {
 		Netdb_net_t net;
-		PL_reentrant_buffer->_netent_size *= 2;
-		Renew(PL_reentrant_buffer->_netent_buffer,
-		      PL_reentrant_buffer->_netent_size, char);
+		RenewDouble(PL_reentrant_buffer->_netent_buffer,
+		      &PL_reentrant_buffer->_netent_size, char);
 		switch (PL_op->op_type) {
 	        case OP_GNBYADDR:
 		    net = va_arg(ap, Netdb_net_t);
@@ -978,9 +949,8 @@ Perl_reentrant_retry(const char *f, ...)
 #endif
 	    {
 		Uid_t uid;
-		PL_reentrant_buffer->_pwent_size *= 2;
-		Renew(PL_reentrant_buffer->_pwent_buffer,
-		      PL_reentrant_buffer->_pwent_size, char);
+		RenewDouble(PL_reentrant_buffer->_pwent_buffer,
+		      &PL_reentrant_buffer->_pwent_size, char);
 		switch (PL_op->op_type) {
 	        case OP_GPWNAM:
 		    p0 = va_arg(ap, void *);
@@ -992,8 +962,10 @@ Perl_reentrant_retry(const char *f, ...)
 		    uid = va_arg(ap, Uid_t);
 #endif
 		    retptr = getpwuid(uid); break;
+#if defined(HAS_GETPWENT) || defined(HAS_GETPWENT_R)
 	        case OP_GPWENT:
 		    retptr = getpwent(); break;
+#endif
 	        default:
 		    SETERRNO(ERANGE, LIB_INVARG);
 		    break;
@@ -1012,9 +984,8 @@ Perl_reentrant_retry(const char *f, ...)
 		PERL_REENTRANT_MAXSIZE / 2)
 #endif
 	    {
-		PL_reentrant_buffer->_protoent_size *= 2;
-		Renew(PL_reentrant_buffer->_protoent_buffer,
-		      PL_reentrant_buffer->_protoent_size, char);
+		RenewDouble(PL_reentrant_buffer->_protoent_buffer,
+		      &PL_reentrant_buffer->_protoent_size, char);
 		switch (PL_op->op_type) {
 	        case OP_GPBYNAME:
 		    p0 = va_arg(ap, void *);
@@ -1042,9 +1013,8 @@ Perl_reentrant_retry(const char *f, ...)
 		PERL_REENTRANT_MAXSIZE / 2)
 #endif
 	    {
-		PL_reentrant_buffer->_servent_size *= 2;
-		Renew(PL_reentrant_buffer->_servent_buffer,
-		      PL_reentrant_buffer->_servent_size, char);
+		RenewDouble(PL_reentrant_buffer->_servent_buffer,
+		      &PL_reentrant_buffer->_servent_size, char);
 		switch (PL_op->op_type) {
 	        case OP_GSBYNAME:
 		    p0 = va_arg(ap, void *);
@@ -1084,7 +1054,6 @@ 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*
 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*
@@ -1111,7 +1080,6 @@ getservbyname CC|netdb	|struct servent	|I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent
 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
-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*
 setgrent	|grp	|		|I_H|V_H
@@ -1121,8 +1089,6 @@ setnetent I	|netdb	|		|I_ID|V_ID|D=struct netent_data*
 setprotoent 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