# 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 = open_new('reentr.h', '>',
- { by => 'regen/reentr.pl',
- from => 'data in regen/reentr.pl',
- file => 'reentr.h', style => '*',
- copyright => [2002, 2003, 2005 .. 2007]});
-
+my $h = open_print_header('reentr.h');
print $h <<EOF;
#ifndef REENTR_H
#define REENTR_H
#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
#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>
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);
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',
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
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";
$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;
# Prepare to write the reentr.c.
-my $c = open_new('reentr.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]);
-
-$top =~ s! \*/\n! *
+my $c = open_print_header('reentr.c', <<'EOQ');
+ *
* "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!"
*
* This file contains a collection of automatically created wrappers
* (created by running reentr.pl) for reentrant (thread-safe) versions of
* care about the differences between various platforms' idiosyncrasies
* regarding these reentrant interfaces.
*/
-!s;
+EOQ
-print $c $top, <<"EOF";
+print $c <<"EOF";
#include "EXTERN.h"
#define PERL_IN_REENTR_C
#include "perl.h"
void
Perl_reentrant_size(pTHX) {
+ PERL_UNUSED_CONTEXT;
#ifdef USE_REENTRANT_API
#define REENTRANTSMALLSIZE 256 /* Make something up. */
#define REENTRANTUSUALSIZE 4096 /* Make something up. */
void
Perl_reentrant_init(pTHX) {
+ PERL_UNUSED_CONTEXT;
#ifdef USE_REENTRANT_API
Newx(PL_reentrant_buffer, 1, REENTR);
Perl_reentrant_size(aTHX);
void
Perl_reentrant_free(pTHX) {
+ PERL_UNUSED_CONTEXT;
#ifdef USE_REENTRANT_API
@free
Safefree(PL_reentrant_buffer);
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;
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;
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*
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
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
https://perl5.git.perl.org / perl5.git / blobdiff