X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/b430fd0465bf67481688d8bedfceb885abf2a170..c8c7fdd1a93cac2b3a20ec43fed0b1327c000811:/reentr.pl diff --git a/reentr.pl b/reentr.pl index ae56377..85ec64a 100644 --- a/reentr.pl +++ b/reentr.pl @@ -128,29 +128,32 @@ print <) { +my %seenh; # the different prototypes signatures for this function +my %seena; # the different prototypes signatures for this function in order +my @seenf; # all the seen functions +my %seenp; # the different prototype signatures for all functions +my %seent; # the return type of this function +my %seens; # the type of this function's "S" +my %seend; # the type of this function's "D" +my %seenu; # the length of the argument list of this function + +while () { # Read in the protypes. next if /^\s+$/; chomp; - my ($f, $h, $t, @p) = split(/\s*\|\s*/, $_, -1); + my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1); my $u; - ($f, $u) = split(' ', $f); - $seenu{$f} = defined $u ? length $u : 0; - my $F = uc $f; - push @seenf, $f; + # Split off the real function name and the argument list. + ($func, $u) = split(' ', $func); + $seenu{$func} = defined $u ? length $u : 0; + my $FUNC = uc $func; # for output. + push @seenf, $func; my %m = %map; - if ($t) { - $m{S} = "$t*"; - $m{R} = "$t**"; + if ($type) { + $m{S} = "$type*"; + $m{R} = "$type**"; } + + # Set any special mapping variables (like X=x_t) if (@p) { while ($p[-1] =~ /=/) { my ($k, $v) = ($p[-1] =~ /^([A-Za-z])\s*=\s*(.*)/); @@ -158,12 +161,32 @@ while () { pop @p; } } - if ($opts{U} && open(U, ">d_${f}_r.U")) { + + # If given the -U option open up the metaconfig unit for this function. + if ($opts{U} && open(U, ">d_${func}_r.U")) { select U; } - my $prereqh = $h eq 'stdio' ? '' : "i_$h"; # There's no i_stdio. - print <) { ?RCS: ?RCS: Generated by the reentr.pl from the Perl 5.8 distribution. ?RCS: -?MAKE:d_${f}_r ${f}_r_proto: Inlibc Protochk Hasproto i_systypes $prereqh usethreads +?MAKE:d_${func}_r ${func}_r_proto: @prereq ?MAKE: -pick add \$@ %< -?S:d_${f}_r: -?S: This variable conditionally defines the HAS_${F}_R symbol, -?S: which indicates to the C program that the ${f}_r() +?S:d_${func}_r: +?S: This variable conditionally defines the HAS_${FUNC}_R symbol, +?S: which indicates to the C program that the ${func}_r() ?S: routine is available. ?S:. -?S:${f}_r_proto: -?S: This variable encodes the prototype of ${f}_r. +?S:${func}_r_proto: +?S: This variable encodes the prototype of ${func}_r. +?S: It is zero if d_${func}_r is undef, and one of the +?S: REENTRANT_PROTO_T_ABC macros of reentr.h if d_${func}_r +?S: is defined. ?S:. -?C:HAS_${F}_R: -?C: This symbol, if defined, indicates that the ${f}_r routine -?C: is available to ${f} re-entrantly. +?C:HAS_${FUNC}_R: +?C: This symbol, if defined, indicates that the ${func}_r routine +?C: is available to ${func} re-entrantly. ?C:. -?C:${F}_R_PROTO: -?C: This symbol encodes the prototype of ${f}_r. +?C:${FUNC}_R_PROTO: +?C: This symbol encodes the prototype of ${func}_r. +?C: It is zero if d_${func}_r is undef, and one of the +?C: REENTRANT_PROTO_T_ABC macros of reentr.h if d_${func}_r +?C: is defined. ?C:. -?H:#\$d_${f}_r HAS_${F}_R /**/ -?H:#define ${F}_R_PROTO \$${f}_r_proto /**/ +?H:#\$d_${func}_r HAS_${FUNC}_R /**/ +?H:#define ${FUNC}_R_PROTO \$${func}_r_proto /**/ ?H:. -?T:try hdrs d_${f}_r_proto -?LINT:set d_${f}_r -?LINT:set ${f}_r_proto -: see if ${f}_r exists -set ${f}_r d_${f}_r +?T:try hdrs d_${func}_r_proto +?LINT:set d_${func}_r +?LINT:set ${func}_r_proto +: see if ${func}_r exists +set ${func}_r d_${func}_r eval \$inlibc -case "\$d_${f}_r" in +case "\$d_${func}_r" in "\$define") - hdrs="\$i_systypes sys/types.h define stdio.h \$i_${h} $h.h" - case "\$d_${f}_r_proto:\$usethreads" in - ":define") d_${f}_r_proto=define - set d_${f}_r_proto ${f}_r \$hdrs +EOF + print <{$p}++; - push @{$seena{$f}}, $p; - $seenp{$p}++; - $seent{$f} = $t; - $seens{$f} = $m{S}; - $seend{$f} = $m{D}; - } - if ($opts{U}) { - print <&4 ;; - * ) case "\$${f}_r_proto" in + } + $seenh{$func}->{$p}++; + push @{$seena{$func}}, $p; + $seenp{$p}++; + $seent{$func} = $type; + $seens{$func} = $m{S}; + $seend{$func} = $m{D}; + } + if ($opts{U}) { + print <&4 ;; + * ) case "\$${func}_r_proto" in REENTRANT_PROTO*) ;; - *) ${f}_r_proto="REENTRANT_PROTO_\$${f}_r_proto" ;; + *) ${func}_r_proto="REENTRANT_PROTO_\$${func}_r_proto" ;; esac echo "Prototype: \$try" ;; esac ;; *) case "\$usethreads" in - define) echo "${f}_r has no prototype, not using it." >&4 ;; + define) echo "${func}_r has no prototype, not using it." >&4 ;; esac + d_${func}_r=undef + ${func}_r_proto=0 ;; esac ;; -*) ${f}_r_proto=0 +*) ${func}_r_proto=0 ;; esac @@ -258,9 +292,12 @@ 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"; @@ -268,18 +305,18 @@ select H; } } +my @struct; # REENTR struct members +my @size; # struct member buffer size initialization code +my @init; # struct member buffer initialization (malloc) code +my @free; # struct member buffer release (free) code +my @wrap; # the wrapper (foo(a) -> foo_r(a,...)) cpp code +my @define; # defines for optional features + sub ifprotomatch { - my $F = shift; - join " || ", map { "${F}_R_PROTO == REENTRANT_PROTO_$_" } @_; + my $FUNC = shift; + join " || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @_; } -my @struct; -my @size; -my @init; -my @free; -my @wrap; -my @define; - sub pushssif { push @struct, @_; push @size, @_; @@ -288,12 +325,12 @@ sub pushssif { } sub pushinitfree { - my $f = shift; + my $func = shift; push @init, <_${f}_buffer, PL_reentrant_buffer->_${f}_size, char); + New(31338, PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); EOF push @free, <_${f}_buffer); + Safefree(PL_reentrant_buffer->_${func}_buffer); EOF } @@ -305,18 +342,23 @@ sub define { /* The @F using \L$n? */ EOF - for my $f (@F) { - my $F = uc $f; - my $h = "${F}_R_HAS_$n"; - push @H, $h; - my @h = grep { /$p/ } @{$seena{$f}}; + my $GENFUNC; + for my $func (@F) { + my $FUNC = uc $func; + my $HAS = "${FUNC}_R_HAS_$n"; + push @H, $HAS; + my @h = grep { /$p/ } @{$seena{$func}}; + unless (defined $GENFUNC) { + $GENFUNC = $FUNC; + $GENFUNC =~ s/^GET//; + } if (@h) { - push @define, "#if defined(HAS_${F}_R) && (" . join(" || ", map { "${F}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n"; + push @define, "#if defined(HAS_${FUNC}_R) && (" . join(" || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n"; push @define, <_${f}_size = 256; /* Make something up. */ + PL_reentrant_buffer->_${func}_size = REENTRANTSMALLSIZE; EOF - pushinitfree $f; + pushinitfree $func; pushssif $endif; } - elsif ($f =~ /^(crypt)$/) { + elsif ($func =~ /^(crypt)$/) { pushssif $ifdef; push @struct, <_${f}_struct.initialized = 0; + PL_reentrant_buffer->_${func}_struct.initialized = 0; + /* work around glibc-2.2.5 bug */ + PL_reentrant_buffer->_${func}_struct.current_saltbits = 0; #endif EOF pushssif $endif; } - elsif ($f =~ /^(drand48|gmtime|localtime|random)$/) { + elsif ($func =~ /^(drand48|gmtime|localtime|random)$/) { pushssif $ifdef; push @struct, <_${g}_size = 1024; + PL_reentrant_buffer->_${genfunc}_size = 1024; EOF } else { push @struct, <_${g}_fptr = NULL; +# ifdef USE_${GENFUNC}_FPTR + PL_reentrant_buffer->_${genfunc}_fptr = NULL; # endif EOF - my $sc = $g eq 'getgrent' ? + my $sc = $genfunc eq 'getgrent' ? '_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX'; + my $sz = $genfunc eq 'getgrent' ? + '_grent_size' : '_pwent_size'; push @size, <_${g}_size = sysconf($sc); + PL_reentrant_buffer->_${genfunc}_size = sysconf($sc); + if (PL_reentrant_buffer->$sz == -1) + PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # else # if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) - PL_reentrant_buffer->_${g}_size = SIABUFSIZ; + PL_reentrant_buffer->_${genfunc}_size = SIABUFSIZ; # else # ifdef __sgi - PL_reentrant_buffer->_${g}_size = BUFSIZ; + PL_reentrant_buffer->_${genfunc}_size = BUFSIZ; # else - PL_reentrant_buffer->_${g}_size = 256; + PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE; # endif # endif # endif EOF } - pushinitfree $g; + pushinitfree $genfunc; pushssif $endif; } - elsif ($f =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) { + elsif ($func =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) { pushssif $ifdef; - my $g = $f; - $g =~ s/byname/ent/; - my $G = uc $g; - my $D = ifprotomatch($F, grep {/D/} @p); - my $d = $seend{$f}; + my $genfunc = $func; + $genfunc =~ s/byname/ent/; + $genfunc =~ s/^get//; + my $GENFUNC = uc $genfunc; + my $D = ifprotomatch($FUNC, grep {/D/} @p); + my $d = $seend{$func}; + $d =~ s/\*$//; # snip: we need need the base type. push @struct, <_${g}_size = 2048; /* Any better ideas? */ + PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE; #endif EOF push @init, <_${g}_buffer, PL_reentrant_buffer->_${g}_size, char); + New(31338, PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); #endif EOF push @free, <_${g}_buffer); + Safefree(PL_reentrant_buffer->_${genfunc}_buffer); #endif EOF pushssif $endif; } - elsif ($f =~ /^(readdir|readdir64)$/) { + elsif ($func =~ /^(readdir|readdir64)$/) { pushssif $ifdef; - my $R = ifprotomatch($F, grep {/R/} @p); + my $R = ifprotomatch($FUNC, grep {/R/} @p); push @struct, <_${f}_size = sizeof($seent{$f}) + MAXPATHLEN + 1; + PL_reentrant_buffer->_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1; EOF push @init, <_${f}_struct = ($seent{$f}*)safemalloc(PL_reentrant_buffer->_${f}_size); + PL_reentrant_buffer->_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size); EOF push @free, <_${f}_struct); + Safefree(PL_reentrant_buffer->_${func}_struct); EOF pushssif $endif; } push @wrap, $ifdef; -# Doesn't implement the buffer growth loop for glibc gethostby*(). push @wrap, <_${g}_ptr" : + "&PL_reentrant_buffer->_${genfunc}_ptr" : $_ eq 'E' ? - "&PL_reentrant_buffer->_${g}_errno" : + "&PL_reentrant_buffer->_${genfunc}_errno" : $_ eq 'B' ? - "PL_reentrant_buffer->_${g}_buffer" : + "PL_reentrant_buffer->_${genfunc}_buffer" : $_ =~ /^[WI]$/ ? - "PL_reentrant_buffer->_${g}_size" : + "PL_reentrant_buffer->_${genfunc}_size" : $_ eq 'H' ? - "&PL_reentrant_buffer->_${g}_fptr" : + "&PL_reentrant_buffer->_${genfunc}_fptr" : $_ eq 'D' ? - "&PL_reentrant_buffer->_${g}_data" : + "&PL_reentrant_buffer->_${genfunc}_data" : $_ eq 'S' ? - ($f =~ /^readdir/ ? - "PL_reentrant_buffer->_${g}_struct" : - "&PL_reentrant_buffer->_${g}_struct" ) : - $_ eq 'T' && $f eq 'drand48' ? - "&PL_reentrant_buffer->_${g}_double" : + ($func =~ /^readdir/ ? + "PL_reentrant_buffer->_${genfunc}_struct" : + "&PL_reentrant_buffer->_${genfunc}_struct" ) : + $_ eq 'T' && $func eq 'drand48' ? + "&PL_reentrant_buffer->_${genfunc}_double" : $_ } split '', $b; $w = ", $w" if length $v; } - my $call = "${f}_r($v$w)"; + my $call = "${func}_r($v$w)"; $call = "((errno = $call))" if $r eq 'I'; push @wrap, <reentr.c"); select C; print <op_type) { -#ifdef USE_GETHOSTENT_BUFFER +#ifdef USE_HOSTENT_BUFFER case OP_GHBYADDR: case OP_GHBYNAME: case OP_GHOSTENT: { - if (PL_reentrant_buffer->_gethostent_size <= REENTRANTHALFMAXSIZE) { - PL_reentrant_buffer->_gethostent_size *= 2; - Renew(PL_reentrant_buffer->_gethostent_buffer, - PL_reentrant_buffer->_gethostent_size, char); +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_hostent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { + PL_reentrant_buffer->_hostent_size *= 2; + Renew(PL_reentrant_buffer->_hostent_buffer, + PL_reentrant_buffer->_hostent_size, char); switch (PL_op->op_type) { case OP_GHBYADDR: p0 = va_arg(ap, void *); @@ -741,16 +820,20 @@ Perl_reentrant_retry(const char *f, ...) } break; #endif -#ifdef USE_GETGRENT_BUFFER +#ifdef USE_GRENT_BUFFER case OP_GGRNAM: case OP_GGRGID: case OP_GGRENT: { - if (PL_reentrant_buffer->_getgrent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_grent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { Gid_t gid; - PL_reentrant_buffer->_getgrent_size *= 2; - Renew(PL_reentrant_buffer->_getgrent_buffer, - PL_reentrant_buffer->_getgrent_size, char); + PL_reentrant_buffer->_grent_size *= 2; + Renew(PL_reentrant_buffer->_grent_buffer, + PL_reentrant_buffer->_grent_size, char); switch (PL_op->op_type) { case OP_GGRNAM: p0 = va_arg(ap, void *); @@ -767,16 +850,20 @@ Perl_reentrant_retry(const char *f, ...) } break; #endif -#ifdef USE_GETNETENT_BUFFER +#ifdef USE_NETENT_BUFFER case OP_GNBYADDR: case OP_GNBYNAME: case OP_GNETENT: { - if (PL_reentrant_buffer->_getnetent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_netent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { Netdb_net_t net; - PL_reentrant_buffer->_getnetent_size *= 2; - Renew(PL_reentrant_buffer->_getnetent_buffer, - PL_reentrant_buffer->_getnetent_size, char); + PL_reentrant_buffer->_netent_size *= 2; + Renew(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); @@ -791,19 +878,24 @@ Perl_reentrant_retry(const char *f, ...) break; } } + SETERRNO(ERANGE, LIB_INVARG); } break; #endif -#ifdef USE_GETPWENT_BUFFER +#ifdef USE_PWENT_BUFFER case OP_GPWNAM: case OP_GPWUID: case OP_GPWENT: { - if (PL_reentrant_buffer->_getpwent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_pwent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { Uid_t uid; - PL_reentrant_buffer->_getpwent_size *= 2; - Renew(PL_reentrant_buffer->_getpwent_buffer, - PL_reentrant_buffer->_getpwent_size, char); + PL_reentrant_buffer->_pwent_size *= 2; + Renew(PL_reentrant_buffer->_pwent_buffer, + PL_reentrant_buffer->_pwent_size, char); switch (PL_op->op_type) { case OP_GPWNAM: p0 = va_arg(ap, void *); @@ -817,18 +909,23 @@ Perl_reentrant_retry(const char *f, ...) break; } } + SETERRNO(ERANGE, LIB_INVARG); } break; #endif -#ifdef USE_GETPROTOENT_BUFFER +#ifdef USE_PROTOENT_BUFFER case OP_GPBYNAME: case OP_GPBYNUMBER: case OP_GPROTOENT: { - if (PL_reentrant_buffer->_getprotoent_size <= REENTRANTHALFMAXSIZE) { - PL_reentrant_buffer->_getprotoent_size *= 2; - Renew(PL_reentrant_buffer->_getprotoent_buffer, - PL_reentrant_buffer->_getprotoent_size, char); +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_protoent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { + PL_reentrant_buffer->_protoent_size *= 2; + Renew(PL_reentrant_buffer->_protoent_buffer, + PL_reentrant_buffer->_protoent_size, char); switch (PL_op->op_type) { case OP_GPBYNAME: p0 = va_arg(ap, void *); @@ -842,18 +939,23 @@ Perl_reentrant_retry(const char *f, ...) break; } } + SETERRNO(ERANGE, LIB_INVARG); } break; #endif -#ifdef USE_GETSERVENT_BUFFER +#ifdef USE_SERVENT_BUFFER case OP_GSBYNAME: case OP_GSBYPORT: case OP_GSERVENT: { - if (PL_reentrant_buffer->_getservent_size <= REENTRANTHALFMAXSIZE) { - PL_reentrant_buffer->_getservent_size *= 2; - Renew(PL_reentrant_buffer->_getservent_buffer, - PL_reentrant_buffer->_getservent_size, char); +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_servent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { + PL_reentrant_buffer->_servent_size *= 2; + Renew(PL_reentrant_buffer->_servent_buffer, + PL_reentrant_buffer->_servent_size, char); switch (PL_op->op_type) { case OP_GSBYNAME: p0 = va_arg(ap, void *); @@ -869,6 +971,7 @@ Perl_reentrant_retry(const char *f, ...) break; } } + SETERRNO(ERANGE, LIB_INVARG); } break; #endif @@ -891,11 +994,11 @@ 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 |struct hostent_data |I_S|V_S -endnetent |netdb |struct netent_data |I_S|V_S -endprotoent |netdb |struct protoent_data |I_S|V_S +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 |struct servent_data |I_S|V_S +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