X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=reentr.pl;h=ea327a09febfe02a96dc627a30d7305bc2f18ca2;hb=206957a79d0bac91e0b2fccc7ef76f95e8df245e;hp=cd6998990cfbf7a9d90d4552eae428d045fe7a5a;hpb=23e2b7a9cd174dbd4e526e1069d671e42c30d954;p=p5sagit%2Fp5-mst-13.2.git diff --git a/reentr.pl b/reentr.pl index cd69989..ea327a0 100644 --- a/reentr.pl +++ b/reentr.pl @@ -5,10 +5,15 @@ # and optionally also the relevant metaconfig units (-U option). # +BEGIN { + # Get function prototypes + require 'regen_lib.pl'; +} + use strict; use Getopt::Std; my %opts; -getopts('U', \%opts); +getopts('Uv', \%opts); my %map = ( V => "void", @@ -35,13 +40,15 @@ my %map = ( # Example #3: S_CBI means type func_r(const char*, char*, int) -die "reentr.h: $!" unless open(H, ">reentr.h"); -select H; +# safer_unlink 'reentr.h'; +my $h = safer_open("reentr.h-new"); +select $h; print <. + */ + +#ifndef PERL_REENTR_API +# if defined(PERL_CORE) || defined(PERL_EXT) +# define PERL_REENTR_API 1 +# else +# define PERL_REENTR_API 0 +# endif +#endif #ifdef USE_REENTRANT_API @@ -59,7 +81,8 @@ print <) { # 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")) { + binmode U; select U; } @@ -307,7 +331,7 @@ close DATA; # Prepare to continue writing the reentr.h. -select H; +select $h; { # Write out all the known prototype signatures. @@ -340,7 +364,7 @@ sub pushssif { sub pushinitfree { my $func = shift; push @init, <_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); + Newx(PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); EOF push @free, <_${func}_buffer); @@ -538,7 +562,7 @@ EOF push @size, <$sz = sysconf($sc); - if (PL_reentrant_buffer->$sz == -1) + if (PL_reentrant_buffer->$sz == (size_t) -1) PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # else # if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) @@ -588,7 +612,7 @@ EOF EOF push @init, <_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); + Newx(PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); #endif EOF push @free, <_' . $genfunc . '_data))'; + $memzero = 'REENTR_MEMZERO(&PL_reentrant_buffer->_' . $genfunc . '_data, sizeof(PL_reentrant_buffer->_' . $genfunc . '_data)),'; } push @wrap, <reentr.c"); -select C; +# safer_unlink 'reentr.c'; +my $c = safer_open("reentr.c-new"); +select $c; print <op_type) { #ifdef USE_HOSTENT_BUFFER @@ -1036,14 +1078,20 @@ Perl_reentrant_retry(const char *f, ...) /* Not known how to retry, so just fail. */ break; } - - va_end(ap); +#else + PERL_UNUSED_ARG(f); #endif + } + va_end(ap); return retptr; } +/* ex: set ro: */ EOF +safer_close($c); +rename_if_different('reentr.c-new', 'reentr.c'); + __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*