|
|
What this is
This file is included in the DevDaily.com
"Perl Source Code
Warehouse" project. The intent of this project is to help you "Learn
Perl by Example" TM.
Other links
The source code
#!/usr/bin/perl -w
#
# Generate the reentr.c and reentr.h,
# and optionally also the relevant metaconfig units (-U option).
#
use strict;
use Getopt::Std;
my %opts;
getopts('U', \%opts);
my %map = (
V => "void",
A => "char*", # as an input argument
B => "char*", # as an output argument
C => "const char*", # as a read-only input argument
I => "int",
L => "long",
W => "size_t",
H => "FILE**",
E => "int*",
);
# (See the definitions after __DATA__.)
# In func|inc|type|... a "S" means "type*", and a "R" means "type**".
# (The "types" are often structs, such as "struct passwd".)
#
# After the prototypes one can have |X=...|Y=... to define more types.
# A commonly used extra type is to define D to be equal to "type_data",
# for example "struct_hostent_data to" go with "struct hostent".
#
# Example #1: I_XSBWR means int func_r(X, type, char*, size_t, type**)
# Example #2: S_SBIE means type func_r(type, char*, int, int*)
# Example #3: S_CBI means type func_r(const char*, char*, int)
die "reentr.h: $!" unless open(H, ">reentr.h");
select H;
print <
#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
EOF
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 %seenm; # all the types
my %seenu; # the length of the argument list of this function
my %seenr; # the return type of this function
while () { # Read in the protypes.
next if /^\s+$/;
chomp;
my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1);
my ($r,$u);
# Split off the real function name and the argument list.
($func, $u) = split(' ', $func);
$u = "V_V" unless $u;
($r, $u) = ($u =~ /^(.)_(.+)/);
$seenu{$func} = $u eq 'V' ? 0 : length $u;
$seenr{$func} = $r;
my $FUNC = uc $func; # for output.
push @seenf, $func;
my %m = %map;
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*(.*)/);
$m{$k} = $v;
pop @p;
}
}
# If given the -U option open up the metaconfig unit for this function.
if ($opts{U} && open(U, ">d_${func}_r.U")) {
select U;
}
if ($opts{U}) {
# The metaconfig units needs prerequisite dependencies.
my $prereqs = '';
my $prereqh = '';
my $prereqsh = '';
if ($hdr ne 'stdio') { # There's no i_stdio.
$prereqs = "i_$hdr";
$prereqh = "$hdr.h";
$prereqsh = "\$$prereqs $prereqh";
}
my @prereq = qw(Inlibc Protochk Hasproto i_systypes usethreads);
push @prereq, $prereqs;
my $hdrs = "\$i_systypes sys/types.h define stdio.h $prereqsh";
if ($hdr eq 'time') {
$hdrs .= " \$i_systime sys/time.h";
push @prereq, 'i_systime';
}
# Output the metaconfig unit header.
print <{$p}++;
push @{$seena{$func}}, $p;
$seenp{$p}++;
$seent{$func} = $type;
$seens{$func} = $m{S};
$seend{$func} = $m{D};
$seenm{$func} = \%m;
}
if ($opts{U}) {
print <&4 ;;
* ) case "\$${func}_r_proto" in
REENTRANT_PROTO*) ;;
*) ${func}_r_proto="REENTRANT_PROTO_\$${func}_r_proto" ;;
esac
echo "Prototype: \$try" ;;
esac
;;
*) case "\$usethreads" in
define) echo "${func}_r has no prototype, not using it." >&4 ;;
esac
d_${func}_r=undef
${func}_r_proto=0
;;
esac
;;
*) ${func}_r_proto=0
;;
esac
EOF
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";
$i++;
}
}
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 $FUNC = shift;
join " || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @_;
}
sub pushssif {
push @struct, @_;
push @size, @_;
push @init, @_;
push @free, @_;
}
sub pushinitfree {
my $func = shift;
push @init, <_${func}_buffer, PL_reentrant_buffer->_${func}_size, char);
EOF
push @free, <_${func}_buffer);
EOF
}
sub define {
my ($n, $p, @F) = @_;
my @H;
my $H = uc $F[0];
push @define, <_${func}_size = REENTRANTSMALLSIZE;
EOF
pushinitfree $func;
pushssif $endif;
}
elsif ($func =~ /^(crypt)$/) {
pushssif $ifdef;
push @struct, <_${func}_struct_buffer = 0;
#endif
EOF
push @free, <_${func}_struct_buffer);
#endif
EOF
pushssif $endif;
}
elsif ($func =~ /^(drand48|gmtime|localtime)$/) {
pushssif $ifdef;
push @struct, <_${genfunc}_fptr = NULL;
# endif
EOF
my $sc = $genfunc eq 'grent' ?
'_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX';
my $sz = "_${genfunc}_size";
push @size, <$sz = sysconf($sc);
if (PL_reentrant_buffer->$sz == -1)
PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
# else
# if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
PL_reentrant_buffer->$sz = SIABUFSIZ;
# else
# ifdef __sgi
PL_reentrant_buffer->$sz = BUFSIZ;
# else
PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
# endif
# endif
# endif
EOF
pushinitfree $genfunc;
pushssif $endif;
}
elsif ($func =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) {
pushssif $ifdef;
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, <_${genfunc}_size = REENTRANTUSUALSIZE;
#endif
EOF
push @init, <_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char);
#endif
EOF
push @free, <_${genfunc}_buffer);
#endif
EOF
pushssif $endif;
}
elsif ($func =~ /^(readdir|readdir64)$/) {
pushssif $ifdef;
my $R = ifprotomatch($FUNC, grep {/R/} @p);
push @struct, <_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1;
EOF
push @init, <_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size);
EOF
push @free, <_${func}_struct);
EOF
pushssif $endif;
}
push @wrap, $ifdef;
push @wrap, <_${genfunc}_ptr" :
$_ eq 'E' ?
"&PL_reentrant_buffer->_${genfunc}_errno" :
$_ eq 'B' ?
"PL_reentrant_buffer->_${genfunc}_buffer" :
$_ =~ /^[WI]$/ ?
"PL_reentrant_buffer->_${genfunc}_size" :
$_ eq 'H' ?
"&PL_reentrant_buffer->_${genfunc}_fptr" :
$_ eq 'D' ?
"&PL_reentrant_buffer->_${genfunc}_data" :
$_ eq 'S' ?
($func =~ /^readdir\d*$/ ?
"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;
}
my $call = "${func}_r($v$w)";
push @wrap, <reentr.inc");
select H;
local $" = '';
print <reentr.c");
select C;
print <op_type) {
#ifdef USE_HOSTENT_BUFFER
case OP_GHBYADDR:
case OP_GHBYNAME:
case OP_GHOSTENT:
{
#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 *);
asize = va_arg(ap, size_t);
anint = va_arg(ap, int);
retptr = gethostbyaddr(p0, asize, anint); break;
case OP_GHBYNAME:
p0 = va_arg(ap, void *);
retptr = gethostbyname(p0); break;
case OP_GHOSTENT:
retptr = gethostent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_GRENT_BUFFER
case OP_GGRNAM:
case OP_GGRGID:
case OP_GGRENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_grent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#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) {
case OP_GGRNAM:
p0 = va_arg(ap, void *);
retptr = getgrnam(p0); break;
case OP_GGRGID:
#if Gid_t_size < INTSIZE
gid = (Gid_t)va_arg(ap, int);
#else
gid = va_arg(ap, Gid_t);
#endif
retptr = getgrgid(gid); break;
case OP_GGRENT:
retptr = getgrent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_NETENT_BUFFER
case OP_GNBYADDR:
case OP_GNBYNAME:
case OP_GNETENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_netent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#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) {
case OP_GNBYADDR:
net = va_arg(ap, Netdb_net_t);
anint = va_arg(ap, int);
retptr = getnetbyaddr(net, anint); break;
case OP_GNBYNAME:
p0 = va_arg(ap, void *);
retptr = getnetbyname(p0); break;
case OP_GNETENT:
retptr = getnetent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_PWENT_BUFFER
case OP_GPWNAM:
case OP_GPWUID:
case OP_GPWENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_pwent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#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) {
case OP_GPWNAM:
p0 = va_arg(ap, void *);
retptr = getpwnam(p0); break;
case OP_GPWUID:
#if Uid_t_size < INTSIZE
uid = (Uid_t)va_arg(ap, int);
#else
uid = va_arg(ap, Uid_t);
#endif
retptr = getpwuid(uid); break;
case OP_GPWENT:
retptr = getpwent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_PROTOENT_BUFFER
case OP_GPBYNAME:
case OP_GPBYNUMBER:
case OP_GPROTOENT:
{
#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 *);
retptr = getprotobyname(p0); break;
case OP_GPBYNUMBER:
anint = va_arg(ap, int);
retptr = getprotobynumber(anint); break;
case OP_GPROTOENT:
retptr = getprotoent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_SERVENT_BUFFER
case OP_GSBYNAME:
case OP_GSBYPORT:
case OP_GSERVENT:
{
#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 *);
p1 = va_arg(ap, void *);
retptr = getservbyname(p0, p1); break;
case OP_GSBYPORT:
anint = va_arg(ap, int);
p0 = va_arg(ap, void *);
retptr = getservbyport(anint, p0); break;
case OP_GSERVENT:
retptr = getservent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
default:
/* Not known how to retry, so just fail. */
break;
}
va_end(ap);
#endif
return retptr;
}
EOF
__DATA__
asctime B_S |time |const struct tm|B_SB|B_SBI|I_SB|I_SBI
crypt B_CC |crypt |struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
ctermid B_B |stdio | |B_B
ctime B_S |time |const time_t |B_SB|B_SBI|I_SB|I_SBI
drand48 d_V |stdlib |struct drand48_data |I_ST|T=double*|d=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*
endprotoent |netdb | |I_D|V_D|D=struct protoent_data*
endpwent |pwd | |I_H|V_H
endservent |netdb | |I_D|V_D|D=struct servent_data*
getgrent S_V |grp |struct group |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
getgrgid S_T |grp |struct group |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=gid_t
getgrnam S_C |grp |struct group |I_CSBWR|I_CSBIR|S_CBI|I_CSBI|S_CSBI
gethostbyaddr S_CWI |netdb |struct hostent |I_CWISBWRE|S_CWISBWIE|S_CWISBIE|S_TWISBIE|S_CIISBIE|S_CSBIE|S_TSBIE|I_CWISD|I_CIISD|I_CII|I_TsISBWRE|D=struct hostent_data*|T=const void*|s=socklen_t
gethostbyname S_C |netdb |struct hostent |I_CSBWRE|S_CSBIE|I_CSD|D=struct hostent_data*
gethostent S_V |netdb |struct hostent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct hostent_data*
getlogin B_V |unistd | |I_BW|I_BI|B_BW|B_BI
getnetbyaddr S_LI |netdb |struct netent |I_UISBWRE|I_LISBI|S_TISBI|S_LISBI|I_TISD|I_LISD|I_IISD|I_uISBWRE|D=struct netent_data*|T=in_addr_t|U=unsigned long|u=uint32_t
getnetbyname S_C |netdb |struct netent |I_CSBWRE|I_CSBI|S_CSBI|I_CSD|D=struct netent_data*
getnetent S_V |netdb |struct netent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct netent_data*
getprotobyname S_C |netdb |struct protoent|I_CSBWR|S_CSBI|I_CSD|D=struct protoent_data*
getprotobynumber S_I |netdb |struct protoent|I_ISBWR|S_ISBI|I_ISD|D=struct protoent_data*
getprotoent S_V |netdb |struct protoent|I_SBWR|I_SBI|S_SBI|I_SD|D=struct protoent_data*
getpwent S_V |pwd |struct passwd |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
getpwnam S_C |pwd |struct passwd |I_CSBWR|I_CSBIR|S_CSBI|I_CSBI
getpwuid S_T |pwd |struct passwd |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=uid_t
getservbyname S_CC |netdb |struct servent |I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent_data*
getservbyport S_IC |netdb |struct servent |I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
getservent S_V |netdb |struct servent |I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
getspnam S_C |shadow |struct spwd |I_CSBWR|S_CSBI
gmtime S_T |time |struct tm |S_TS|I_TS|T=const time_t*
localtime S_T |time |struct tm |S_TS|I_TS|T=const time_t*
random L_V |stdlib |struct random_data|I_iS|I_lS|I_St|i=int*|l=long*|t=int32_t*
readdir S_T |dirent |struct dirent |I_TSR|I_TS|T=DIR*
readdir64 S_T |dirent |struct dirent64|I_TSR|I_TS|T=DIR*
setgrent |grp | |I_H|V_H
sethostent V_I |netdb | |I_ID|V_ID|D=struct hostent_data*
setlocale B_IC |locale | |I_ICBI
setnetent V_I |netdb | |I_ID|V_ID|D=struct netent_data*
setprotoent V_I |netdb | |I_ID|V_ID|D=struct protoent_data*
setpwent |pwd | |I_H|V_H
setservent V_I |netdb | |I_ID|V_ID|D=struct servent_data*
srand48 V_L |stdlib |struct drand48_data |I_LS
srandom V_T |stdlib |struct random_data|I_TS|T=unsigned int
strerror B_I |string | |I_IBW|I_IBI|B_IBW
tmpnam B_B |stdio | |B_B
ttyname B_I |unistd | |I_IBW|I_IBI|B_IBI
|
The search page
Other source code files at this package level
Click here to learn more about this project