X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f038801aea0ff24cf86511fa6679d7dcb859cd8d..7c1815b7942f8c7e3651d98060ca7a0760e6483c:/regen/reentr.pl diff --git a/regen/reentr.pl b/regen/reentr.pl index 0045b18..d3ed8ca 100644 --- a/regen/reentr.pl +++ b/regen/reentr.pl @@ -1,5 +1,5 @@ #!/usr/bin/perl -w -# +# # Regenerate (overwriting only if changed): # # reentr.h @@ -18,7 +18,7 @@ BEGIN { # Get function prototypes - require 'regen/regen_lib.pl'; + require './regen/regen_lib.pl'; } use strict; @@ -29,7 +29,7 @@ getopts('Uv', \%opts); my %map = ( V => "void", A => "char*", # as an input argument - B => "char*", # as an output argument + B => "char*", # as an output argument C => "const char*", # as a read-only input argument I => "int", L => "long", @@ -50,17 +50,20 @@ 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 < 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 * memzero out certain structures before calling the functions. */ -#if defined(__OpenBSD__) +# if defined(__OpenBSD__) # define REENTR_MEMZERO(a,b) memzero(a,b) -#else +# else # define REENTR_MEMZERO(a,b) 0 -#endif - -#ifdef NETDB_R_OBSOLETE -# undef HAS_ENDHOSTENT_R -# undef HAS_ENDNETENT_R -# undef HAS_ENDPROTOENT_R -# undef HAS_ENDSERVENT_R -# undef HAS_GETHOSTBYADDR_R -# undef HAS_GETHOSTBYNAME_R -# undef HAS_GETHOSTENT_R -# undef HAS_GETNETBYADDR_R -# undef HAS_GETNETBYNAME_R -# undef HAS_GETNETENT_R -# undef HAS_GETPROTOBYNAME_R -# undef HAS_GETPROTOBYNUMBER_R -# undef HAS_GETPROTOENT_R -# undef HAS_GETSERVBYNAME_R -# undef HAS_GETSERVBYPORT_R -# undef HAS_GETSERVENT_R -# undef HAS_SETHOSTENT_R -# undef HAS_SETNETENT_R -# undef HAS_SETPROTOENT_R -# undef HAS_SETSERVENT_R -#endif +# endif -#ifdef I_PWD -# include -#endif -#ifdef I_GRP -# include -#endif -#ifdef I_NETDB -# include -#endif -#ifdef I_STDLIB -# include /* drand48_data */ -#endif -#ifdef I_CRYPT -# ifdef I_CRYPT -# include -# endif -#endif -#ifdef HAS_GETSPNAM_R -# ifdef I_SHADOW -# include -# endif -#endif +# ifdef NETDB_R_OBSOLETE +# undef HAS_ENDHOSTENT_R +# undef HAS_ENDNETENT_R +# undef HAS_ENDPROTOENT_R +# undef HAS_ENDSERVENT_R +# undef HAS_GETHOSTBYADDR_R +# undef HAS_GETHOSTBYNAME_R +# undef HAS_GETHOSTENT_R +# undef HAS_GETNETBYADDR_R +# undef HAS_GETNETBYNAME_R +# undef HAS_GETNETENT_R +# undef HAS_GETPROTOBYNAME_R +# undef HAS_GETPROTOBYNUMBER_R +# undef HAS_GETPROTOENT_R +# undef HAS_GETSERVBYNAME_R +# undef HAS_GETSERVBYPORT_R +# undef HAS_GETSERVENT_R +# undef HAS_SETHOSTENT_R +# undef HAS_SETNETENT_R +# undef HAS_SETPROTOENT_R +# undef HAS_SETSERVENT_R +# endif + +# ifdef I_PWD +# include +# endif +# ifdef I_GRP +# include +# endif +# ifdef I_NETDB +# include +# endif +# ifdef I_CRYPT +# ifdef I_CRYPT +# include +# endif +# endif +# ifdef HAS_GETSPNAM_R +# ifdef I_SHADOW +# include +# endif +# endif EOF @@ -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 () { # Read in the protypes. +while () { # Read in the protoypes. next if /^\s+$/; chomp; my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1); @@ -200,9 +203,8 @@ while () { # 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; + if ($opts{U} && open(U, ">", "d_${func}_r.U")) { + binmode U; } if ($opts{U}) { @@ -223,7 +225,7 @@ while () { # Read in the protypes. push @prereq, 'i_systime'; } # Output the metaconfig unit header. - print <&4 ;; * ) case "\$${func}_r_proto" in REENTRANT_PROTO*) ;; @@ -325,21 +327,17 @@ EOF esac EOF - close(U); + close(U); } } 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++; } } @@ -392,13 +390,13 @@ EOF $GENFUNC =~ s/^GET//; } if (@h) { - push @define, "#if defined(HAS_${FUNC}_R) && (" . join(" || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n"; + push @define, "# if defined(HAS_${FUNC}_R) && (" . join(" || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n"; push @define, <_${func}_struct_buffer = 0; -#endif +# endif EOF - push @free, <_${func}_struct_buffer); -#endif -EOF - pushssif $endif; - } - elsif ($func =~ /^(drand48|random|srandom)$/) { - pushssif $ifdef; - push @struct, <$sz = sysconf($sc); if (PL_reentrant_buffer->$sz == (size_t) -1) PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; -# else -# if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) +# elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) PL_reentrant_buffer->$sz = SIABUFSIZ; -# else -# ifdef __sgi +# elif defined(__sgi) PL_reentrant_buffer->$sz = BUFSIZ; -# else +# else PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; -# endif -# endif -# endif +# endif EOF pushinitfree $genfunc; pushssif $endif; @@ -589,7 +559,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, <_${genfunc}_size = REENTRANTUSUALSIZE; -#endif +# endif EOF push @init, <_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); -#endif +# endif EOF push @free, <_${genfunc}_buffer); -#endif +# endif EOF pushssif $endif; } @@ -639,7 +609,7 @@ EOF * (though we go static, should use pathconf() instead) */ PL_reentrant_buffer->_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1; EOF - push @init, <_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size); EOF push @free, <_${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,12 +725,13 @@ EOF local $" = ''; -print < '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 * that other files like pp_sys.c calling those library functions need not * care about the differences between various platforms' idiosyncrasies - * regarding these reentrant interfaces. + * regarding these reentrant interfaces. */ -!s; +EOQ -print $top, <op_type) { -#ifdef USE_HOSTENT_BUFFER + +# ifdef USE_HOSTENT_BUFFER + case OP_GHBYADDR: case OP_GHBYNAME: case OP_GHOSTENT: { -#ifdef PERL_REENTRANT_MAXSIZE + +# ifdef PERL_REENTRANT_MAXSIZE if (PL_reentrant_buffer->_hostent_size <= PERL_REENTRANT_MAXSIZE / 2) -#endif +# endif { - PL_reentrant_buffer->_hostent_size *= 2; - Renew(PL_reentrant_buffer->_hostent_buffer, - PL_reentrant_buffer->_hostent_size, char); - switch (PL_op->op_type) { + 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 *); asize = va_arg(ap, size_t); anint = va_arg(ap, int); - retptr = gethostbyaddr(p0, asize, anint); break; + retptr = gethostbyaddr((Netdb_host_t) p0, (Netdb_hlen_t) asize, anint); break; case OP_GHBYNAME: p0 = va_arg(ap, void *); - retptr = gethostbyname((char *)p0); break; + retptr = gethostbyname((Netdb_name_t) p0); break; case OP_GHOSTENT: retptr = gethostent(); break; default: SETERRNO(ERANGE, LIB_INVARG); break; - } + } } } break; -#endif -#ifdef USE_GRENT_BUFFER + +# endif +# ifdef USE_GRENT_BUFFER + case OP_GGRNAM: case OP_GGRGID: case OP_GGRENT: { -#ifdef PERL_REENTRANT_MAXSIZE + +# ifdef PERL_REENTRANT_MAXSIZE if (PL_reentrant_buffer->_grent_size <= PERL_REENTRANT_MAXSIZE / 2) -#endif +# endif { Gid_t gid; - PL_reentrant_buffer->_grent_size *= 2; - Renew(PL_reentrant_buffer->_grent_buffer, - PL_reentrant_buffer->_grent_size, char); - switch (PL_op->op_type) { + 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 *); retptr = getgrnam((char *)p0); break; - case OP_GGRGID: -#if Gid_t_size < INTSIZE - gid = (Gid_t)va_arg(ap, int); -#else + case OP_GGRGID: + +# if Gid_t_size < INTSIZE + gid = (Gid_t)va_arg(ap, int); +# else gid = va_arg(ap, Gid_t); -#endif +# endif retptr = getgrgid(gid); break; case OP_GGRENT: retptr = getgrent(); break; default: SETERRNO(ERANGE, LIB_INVARG); break; - } + } } } break; -#endif -#ifdef USE_NETENT_BUFFER + +# endif +# ifdef USE_NETENT_BUFFER + case OP_GNBYADDR: case OP_GNBYNAME: case OP_GNETENT: { -#ifdef PERL_REENTRANT_MAXSIZE + +# ifdef PERL_REENTRANT_MAXSIZE if (PL_reentrant_buffer->_netent_size <= PERL_REENTRANT_MAXSIZE / 2) -#endif +# endif { Netdb_net_t net; - PL_reentrant_buffer->_netent_size *= 2; - Renew(PL_reentrant_buffer->_netent_buffer, - PL_reentrant_buffer->_netent_size, char); - switch (PL_op->op_type) { + 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); anint = va_arg(ap, int); @@ -964,60 +973,69 @@ Perl_reentrant_retry(const char *f, ...) default: SETERRNO(ERANGE, LIB_INVARG); break; - } - } + } + } } break; -#endif -#ifdef USE_PWENT_BUFFER + +# endif +# ifdef USE_PWENT_BUFFER + case OP_GPWNAM: case OP_GPWUID: case OP_GPWENT: { -#ifdef PERL_REENTRANT_MAXSIZE + +# ifdef PERL_REENTRANT_MAXSIZE if (PL_reentrant_buffer->_pwent_size <= PERL_REENTRANT_MAXSIZE / 2) -#endif + +# endif { Uid_t uid; - PL_reentrant_buffer->_pwent_size *= 2; - Renew(PL_reentrant_buffer->_pwent_buffer, - PL_reentrant_buffer->_pwent_size, char); - switch (PL_op->op_type) { + 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 *); retptr = getpwnam((char *)p0); break; case OP_GPWUID: -#if Uid_t_size < INTSIZE + +# if Uid_t_size < INTSIZE uid = (Uid_t)va_arg(ap, int); -#else +# else uid = va_arg(ap, Uid_t); -#endif +# 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; - } + } } } break; -#endif -#ifdef USE_PROTOENT_BUFFER + +# endif +# ifdef USE_PROTOENT_BUFFER + case OP_GPBYNAME: case OP_GPBYNUMBER: case OP_GPROTOENT: { -#ifdef PERL_REENTRANT_MAXSIZE + +# ifdef PERL_REENTRANT_MAXSIZE if (PL_reentrant_buffer->_protoent_size <= PERL_REENTRANT_MAXSIZE / 2) -#endif +# endif { - PL_reentrant_buffer->_protoent_size *= 2; - Renew(PL_reentrant_buffer->_protoent_buffer, - PL_reentrant_buffer->_protoent_size, char); - switch (PL_op->op_type) { + 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 *); retptr = getprotobyname((char *)p0); break; @@ -1029,25 +1047,27 @@ Perl_reentrant_retry(const char *f, ...) default: SETERRNO(ERANGE, LIB_INVARG); break; - } + } } } break; -#endif -#ifdef USE_SERVENT_BUFFER + +# endif +# ifdef USE_SERVENT_BUFFER + case OP_GSBYNAME: case OP_GSBYPORT: case OP_GSERVENT: { -#ifdef PERL_REENTRANT_MAXSIZE + +# ifdef PERL_REENTRANT_MAXSIZE if (PL_reentrant_buffer->_servent_size <= PERL_REENTRANT_MAXSIZE / 2) -#endif +# endif { - PL_reentrant_buffer->_servent_size *= 2; - Renew(PL_reentrant_buffer->_servent_buffer, - PL_reentrant_buffer->_servent_size, char); - switch (PL_op->op_type) { + 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 *); p1 = va_arg(ap, void *); @@ -1061,34 +1081,39 @@ Perl_reentrant_retry(const char *f, ...) default: SETERRNO(ERANGE, LIB_INVARG); break; - } + } } } break; -#endif + +# endif + default: /* Not known how to retry, so just fail. */ break; } + #else + PERL_UNUSED_ARG(f); + #endif + } va_end(ap); return retptr; } - -/* ex: set ro: */ EOF -close_and_rename($c); +read_only_bottom_close_and_rename($c); +# The meanings of the flags are derivable from %map above +# Fnc, arg flags| hdr | ? struct type | prototypes... __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* 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* @@ -1115,7 +1140,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 @@ -1125,8 +1149,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