#!/usr/bin/perl -w
-#
+#
# Regenerate (overwriting only if changed):
#
# reentr.h
BEGIN {
# Get function prototypes
- require 'regen/regen_lib.pl';
+ require './regen/regen_lib.pl';
}
use strict;
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",
# 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 <<EOF;
-#ifndef REENTR_H
-#define REENTR_H
+my $h = open_print_header('reentr.h');
+print $h <<EOF;
+#ifndef PERL_REENTR_H_
+#define PERL_REENTR_H_
/* If compiling for a threaded perl, we will macro-wrap the system/library
* interfaces (e.g. getpwent()) which have threaded versions
*/
#ifndef PERL_REENTR_API
-# if defined(PERL_CORE) || defined(PERL_EXT)
-# define PERL_REENTR_API 1
-# else
-# define PERL_REENTR_API 0
-# endif
+# if defined(PERL_CORE) || defined(PERL_EXT) || defined(PERL_REENTRANT)
+# define PERL_REENTR_API 1
+# else
+# define PERL_REENTR_API 0
+# endif
#endif
#ifdef USE_REENTRANT_API
-
+
/* Deprecations: some platforms have the said reentrant interfaces
* but they are declared obsolete and are not to be used. Often this
* means that the platform has threadsafed the interfaces (hopefully).
* If you know of more deprecations on some platforms, please add your own
* (by editing reentr.pl, mind!) */
-#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 __hpux
+# undef HAS_CRYPT_R
+# undef HAS_ENDGRENT_R
+# undef HAS_ENDPWENT_R
+# undef HAS_GETGRENT_R
+# undef HAS_GETPWENT_R
+# undef HAS_SETLOCALE_R
+# undef HAS_STRERROR_R
+# define NETDB_R_OBSOLETE
+# endif
-#if defined(__osf__) && defined(__alpha) /* Tru64 aka Digital UNIX */
-# undef HAS_CRYPT_R
-# undef HAS_STRERROR_R
-# define NETDB_R_OBSOLETE
-#endif
+# if defined(__osf__) && defined(__alpha) /* Tru64 aka Digital UNIX */
+# undef HAS_CRYPT_R
+# undef HAS_STRERROR_R
+# define NETDB_R_OBSOLETE
+# endif
+
+# if defined(__GLIBC__) && (__GLIBC__ > 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 <pwd.h>
-#endif
-#ifdef I_GRP
-# include <grp.h>
-#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>
-# endif
-#endif
-#ifdef HAS_GETSPNAM_R
-# ifdef I_SHADOW
-# include <shadow.h>
-# 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 <pwd.h>
+# endif
+# ifdef I_GRP
+# include <grp.h>
+# endif
+# ifdef I_NETDB
+# include <netdb.h>
+# endif
+# ifdef I_CRYPT
+# ifdef I_CRYPT
+# include <crypt.h>
+# endif
+# endif
+# ifdef HAS_GETSPNAM_R
+# ifdef I_SHADOW
+# include <shadow.h>
+# endif
+# endif
EOF
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);
}
# 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}) {
push @prereq, 'i_systime';
}
# Output the metaconfig unit header.
- print <<EOF;
+ print U <<"EOF";
?RCS: \$Id: d_${func}_r.U,v $
?RCS:
?RCS: Copyright (c) 2002,2003 Jarkko Hietaniemi
case "\$d_${func}_r" in
"\$define")
EOF
- print <<EOF;
+ print U <<"EOF";
hdrs="$hdrs"
case "\$d_${func}_r_proto:\$usethreads" in
":define") d_${func}_r_proto=define
my ($r, $a) = ($p =~ /^(.)_(.+)/);
my $v = join(", ", map { $m{$_} } split '', $a);
if ($opts{U}) {
- print <<EOF ;
+ print U <<"EOF";
case "\$${func}_r_proto" in
''|0) try='$m{$r} ${func}_r($v);'
./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;;
$seenm{$func} = \%m;
}
if ($opts{U}) {
- print <<EOF;
+ print U <<"EOF";
case "\$${func}_r_proto" in
''|0) d_${func}_r=undef
- ${func}_r_proto=0
+ ${func}_r_proto=0
echo "Disabling ${func}_r, cannot determine prototype." >&4 ;;
* ) case "\$${func}_r_proto" in
REENTRANT_PROTO*) ;;
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++;
}
}
$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, <<EOF;
-# define $HAS
-#else
-# undef $HAS
-#endif
+# define $HAS
+# else
+# undef $HAS
+# endif
EOF
}
}
/* Any of the @F using \L$n? */
EOF
- push @define, "#if (" . join(" || ", map { "defined($_)" } @H) . ")\n";
+ push @define, "# if (" . join(" || ", map { "defined($_)" } @H) . ")\n";
push @define, <<EOF;
-# define USE_${GENFUNC}_$n
-#else
-# undef USE_${GENFUNC}_$n
-#endif
+# define USE_${GENFUNC}_$n
+# else
+# undef USE_${GENFUNC}_$n
+# endif
EOF
}
for my $func (@seenf) {
my $FUNC = uc $func;
- my $ifdef = "#ifdef HAS_${FUNC}_R\n";
- my $endif = "#endif /* HAS_${FUNC}_R */\n";
+ my $ifdef = "# ifdef HAS_${FUNC}_R\n";
+ my $endif = "# endif /* HAS_${FUNC}_R */\n\n";
if (exists $seena{$func}) {
my @p = @{$seena{$func}};
if ($func =~ /^(asctime|ctime|getlogin|setlocale|strerror|ttyname)$/) {
elsif ($func =~ /^(crypt)$/) {
pushssif $ifdef;
push @struct, <<EOF;
-#if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
+# if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
$seend{$func} _${func}_data;
-#else
+# else
$seent{$func} *_${func}_struct_buffer;
-#endif
+# endif
EOF
- push @init, <<EOF;
-#if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
+ push @init, <<EOF;
+# if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
PL_reentrant_buffer->_${func}_struct_buffer = 0;
-#endif
+# endif
EOF
- push @free, <<EOF;
-#if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
+ push @free, <<EOF;
+# if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
Safefree(PL_reentrant_buffer->_${func}_struct_buffer);
-#endif
-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
+# endif
EOF
- }
pushssif $endif;
}
elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) {
'_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX';
my $sz = "_${genfunc}_size";
push @size, <<EOF;
-# if defined(HAS_SYSCONF) && defined($sc) && !defined(__GLIBC__)
+# if defined(HAS_SYSCONF) && defined($sc) && !defined(__GLIBC__)
PL_reentrant_buffer->$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;
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
$seent{$func}* _${genfunc}_ptr;
# endif
EOF
- push @struct, <<EOF;
+ push @struct, <<EOF;
# ifdef USE_${GENFUNC}_ERRNO
int _${genfunc}_errno;
-# endif
+# endif
EOF
push @size, <<EOF;
-#if !($D)
+# if !($D)
PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE;
-#endif
+# endif
EOF
push @init, <<EOF;
-#if !($D)
+# if !($D)
Newx(PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char);
-#endif
+# endif
EOF
push @free, <<EOF;
-#if !($D)
+# if !($D)
Safefree(PL_reentrant_buffer->_${genfunc}_buffer);
-#endif
+# endif
EOF
pushssif $endif;
}
* (though we go static, should use pathconf() instead) */
PL_reentrant_buffer->_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1;
EOF
- push @init, <<EOF;
+ push @init, <<EOF;
PL_reentrant_buffer->_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size);
EOF
push @free, <<EOF;
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;
local $" = '';
-print <<EOF;
+print $h <<EOF;
/* Defines for indicating which special features are supported. */
@define
typedef struct {
+
@struct
int dummy; /* cannot have empty structs */
} REENTR;
/* The wrappers. */
@wrap
-
#endif /* USE_REENTRANT_API */
-
-#endif
-/* ex: set ro: */
+#endif
EOF
-close_and_rename($h);
+read_only_bottom_close_and_rename($h);
# Prepare to write the reentr.c.
-my $c = safer_open('reentr.c-new', 'reentr.c');
-select $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]);
+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, <<EOF;
+print $c <<"EOF";
#include "EXTERN.h"
#define PERL_IN_REENTR_C
#include "perl.h"
#include "reentr.h"
+#define RenewDouble(data_pointer, size_pointer, type) \\
+ STMT_START { \\
+ const size_t size = *(size_pointer) * 2; \\
+ Renew((data_pointer), (size), type); \\
+ *(size_pointer) = size; \\
+ } STMT_END
+
void
Perl_reentrant_size(pTHX) {
+ PERL_UNUSED_CONTEXT;
+
+ /* Set the sizes of the reentrant buffers */
+
#ifdef USE_REENTRANT_API
-#define REENTRANTSMALLSIZE 256 /* Make something up. */
-#define REENTRANTUSUALSIZE 4096 /* Make something up. */
+# define REENTRANTSMALLSIZE 256 /* Make something up. */
+# define REENTRANTUSUALSIZE 4096 /* Make something up. */
+
@size
#endif /* USE_REENTRANT_API */
+
}
void
Perl_reentrant_init(pTHX) {
+ PERL_UNUSED_CONTEXT;
+
+ /* Initialize the whole thing */
+
#ifdef USE_REENTRANT_API
+
Newx(PL_reentrant_buffer, 1, REENTR);
Perl_reentrant_size(aTHX);
+
@init
#endif /* USE_REENTRANT_API */
+
}
void
Perl_reentrant_free(pTHX) {
+ PERL_UNUSED_CONTEXT;
+
+ /* Tear down */
+
#ifdef USE_REENTRANT_API
+
@free
Safefree(PL_reentrant_buffer);
+
#endif /* USE_REENTRANT_API */
}
void*
Perl_reentrant_retry(const char *f, ...)
{
- dTHX;
+ /* This function is set up to be called if the normal function returns
+ * failure with errno ERANGE, which indicates the buffer is too small.
+ * This function calls the failing one again with a larger buffer.
+ *
+ * What has happened is that, due to the magic of C preprocessor macro
+ * expansion, when the original code called function 'foo(args)', it was
+ * instead compiled into something like a call of 'foo_r(args, buffer)'
+ * Below we retry with 'foo', but the preprocessor has changed that into
+ * 'foo_r', so this function will end up calling itself recursively, each
+ * time with a larger buffer. If PERL_REENTRANT_MAXSIZE is defined, it
+ * won't increase beyond that, instead failing. */
+
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;
+
#endif
+
va_start(ap, f);
{
+
#ifdef USE_REENTRANT_API
# if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
void *p0;
# endif
switch (PL_op->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);
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;
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 *);
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*
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