This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
No need to use locale_r with thread-safe locales
[perl5.git] / regen / reentr.pl
CommitLineData
10bc17b6 1#!/usr/bin/perl -w
7c1815b7 2#
6294c161
DM
3# Regenerate (overwriting only if changed):
4#
5# reentr.h
6# reentr.c
7#
8# from information stored in the DATA section of this file.
9#
10# With the -U option, it also unconditionally regenerates the relevant
11# metaconfig units:
12#
13# d_${func}_r.U
14#
15# Also accepts the standard regen_lib -q and -v args.
16#
17# This script is normally invoked from regen.pl.
10bc17b6 18
e06c4d37
NC
19BEGIN {
20 # Get function prototypes
3d7c117d 21 require './regen/regen_lib.pl';
e06c4d37
NC
22}
23
10bc17b6
JH
24use strict;
25use Getopt::Std;
26my %opts;
b6b9a099 27getopts('Uv', \%opts);
10bc17b6
JH
28
29my %map = (
30 V => "void",
31 A => "char*", # as an input argument
7c1815b7 32 B => "char*", # as an output argument
10bc17b6
JH
33 C => "const char*", # as a read-only input argument
34 I => "int",
35 L => "long",
36 W => "size_t",
37 H => "FILE**",
38 E => "int*",
39 );
40
41# (See the definitions after __DATA__.)
42# In func|inc|type|... a "S" means "type*", and a "R" means "type**".
43# (The "types" are often structs, such as "struct passwd".)
44#
45# After the prototypes one can have |X=...|Y=... to define more types.
46# A commonly used extra type is to define D to be equal to "type_data",
47# for example "struct_hostent_data to" go with "struct hostent".
48#
49# Example #1: I_XSBWR means int func_r(X, type, char*, size_t, type**)
50# Example #2: S_SBIE means type func_r(type, char*, int, int*)
51# Example #3: S_CBI means type func_r(const char*, char*, int)
52
d91994bb
NC
53sub open_print_header {
54 my ($file, $quote) = @_;
55 return open_new($file, '>',
56 { by => 'regen/reentr.pl',
57 from => 'data in regen/reentr.pl',
58 file => $file, style => '*',
59 copyright => [2002, 2003, 2005 .. 2007],
60 quote => $quote });
61}
10bc17b6 62
d91994bb 63my $h = open_print_header('reentr.h');
2d6469fe 64print $h <<EOF;
6a5bc5ac
KW
65#ifndef PERL_REENTR_H_
66#define PERL_REENTR_H_
10bc17b6 67
832a833b
JH
68/* If compiling for a threaded perl, we will macro-wrap the system/library
69 * interfaces (e.g. getpwent()) which have threaded versions
70 * (e.g. getpwent_r()), which will handle things correctly for
6f16cbe7
KW
71 * the Perl interpreter. This is done automatically for the perl core and
72 * extensions, but not generally for XS modules unless they
73 * #define PERL_REENTRANT
74 * See L<perlxs/Thread-aware system interfaces>.
7dc0f1bb
KW
75 *
76 * For a function 'foo', use the compile-time directive
77 * #ifdef PERL_REENTR_USING_FOO_R
78 * to test if the function actually did get replaced by the reentrant version.
79 * (If it isn't getting replaced, it might mean it uses a different prototype
80 * on the given platform than any we are expecting. To fix that, add the
81 * prototype to the __DATA__ section of regen/reentr.pl.)
832a833b
JH
82 */
83
84#ifndef PERL_REENTR_API
7c1815b7
KW
85# if defined(PERL_CORE) || defined(PERL_EXT) || defined(PERL_REENTRANT)
86# define PERL_REENTR_API 1
87# else
88# define PERL_REENTR_API 0
89# endif
832a833b
JH
90#endif
91
10bc17b6 92#ifdef USE_REENTRANT_API
7c1815b7 93
95fb10e3
KW
94/* For thread-safe builds, alternative methods are used to make calls to this
95 * safe. */
96#ifdef USE_THREAD_SAFE_LOCALE
97# undef HAS_SETLOCALE_R
98#endif
99
10bc17b6
JH
100/* Deprecations: some platforms have the said reentrant interfaces
101 * but they are declared obsolete and are not to be used. Often this
102 * means that the platform has threadsafed the interfaces (hopefully).
103 * All this is OS version dependent, so we are of course fooling ourselves.
832a833b
JH
104 * If you know of more deprecations on some platforms, please add your own
105 * (by editing reentr.pl, mind!) */
10bc17b6 106
7c1815b7
KW
107# ifdef __hpux
108# undef HAS_CRYPT_R
109# undef HAS_ENDGRENT_R
110# undef HAS_ENDPWENT_R
111# undef HAS_GETGRENT_R
112# undef HAS_GETPWENT_R
113# undef HAS_SETLOCALE_R
114# undef HAS_STRERROR_R
115# define NETDB_R_OBSOLETE
116# endif
10bc17b6 117
7c1815b7
KW
118# if defined(__osf__) && defined(__alpha) /* Tru64 aka Digital UNIX */
119# undef HAS_CRYPT_R
120# undef HAS_STRERROR_R
121# define NETDB_R_OBSOLETE
122# endif
10bc17b6 123
7c1815b7
KW
124# if defined(__GLIBC__) && (__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 24))
125# undef HAS_READDIR_R
126# undef HAS_READDIR64_R
127# endif
c6709bf9 128
23e2b7a9
SP
129/*
130 * As of OpenBSD 3.7, reentrant functions are now working, they just are
131 * incompatible with everyone else. To make OpenBSD happy, we have to
132 * memzero out certain structures before calling the functions.
133 */
7c1815b7 134# if defined(__OpenBSD__)
3fb2f3ac 135# define REENTR_MEMZERO(a,b) memzero(a,b)
7c1815b7 136# else
3fb2f3ac 137# define REENTR_MEMZERO(a,b) 0
7c1815b7 138# endif
10bc17b6 139
7c1815b7
KW
140# ifdef NETDB_R_OBSOLETE
141# undef HAS_ENDHOSTENT_R
142# undef HAS_ENDNETENT_R
143# undef HAS_ENDPROTOENT_R
144# undef HAS_ENDSERVENT_R
145# undef HAS_GETHOSTBYADDR_R
146# undef HAS_GETHOSTBYNAME_R
147# undef HAS_GETHOSTENT_R
148# undef HAS_GETNETBYADDR_R
149# undef HAS_GETNETBYNAME_R
150# undef HAS_GETNETENT_R
151# undef HAS_GETPROTOBYNAME_R
152# undef HAS_GETPROTOBYNUMBER_R
153# undef HAS_GETPROTOENT_R
154# undef HAS_GETSERVBYNAME_R
155# undef HAS_GETSERVBYPORT_R
156# undef HAS_GETSERVENT_R
157# undef HAS_SETHOSTENT_R
158# undef HAS_SETNETENT_R
159# undef HAS_SETPROTOENT_R
160# undef HAS_SETSERVENT_R
161# endif
162
163# ifdef I_PWD
164# include <pwd.h>
165# endif
166# ifdef I_GRP
167# include <grp.h>
168# endif
169# ifdef I_NETDB
170# include <netdb.h>
171# endif
172# ifdef I_CRYPT
173# ifdef I_CRYPT
174# include <crypt.h>
175# endif
176# endif
177# ifdef HAS_GETSPNAM_R
178# ifdef I_SHADOW
179# include <shadow.h>
180# endif
181# endif
10bc17b6
JH
182
183EOF
184
aa418cf1
JH
185my %seenh; # the different prototypes signatures for this function
186my %seena; # the different prototypes signatures for this function in order
187my @seenf; # all the seen functions
188my %seenp; # the different prototype signatures for all functions
189my %seent; # the return type of this function
190my %seens; # the type of this function's "S"
191my %seend; # the type of this function's "D"
a845a0d4 192my %seenm; # all the types
aa418cf1
JH
193my %seenu; # the length of the argument list of this function
194
b6a6e956 195while (<DATA>) { # Read in the protoypes.
10bc17b6
JH
196 next if /^\s+$/;
197 chomp;
aa418cf1 198 my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1);
10bc17b6 199 my $u;
aa418cf1
JH
200 # Split off the real function name and the argument list.
201 ($func, $u) = split(' ', $func);
202 $seenu{$func} = defined $u ? length $u : 0;
203 my $FUNC = uc $func; # for output.
204 push @seenf, $func;
10bc17b6 205 my %m = %map;
aa418cf1
JH
206 if ($type) {
207 $m{S} = "$type*";
208 $m{R} = "$type**";
10bc17b6 209 }
aa418cf1
JH
210
211 # Set any special mapping variables (like X=x_t)
10bc17b6
JH
212 if (@p) {
213 while ($p[-1] =~ /=/) {
214 my ($k, $v) = ($p[-1] =~ /^([A-Za-z])\s*=\s*(.*)/);
215 $m{$k} = $v;
216 pop @p;
217 }
218 }
aa418cf1
JH
219
220 # If given the -U option open up the metaconfig unit for this function.
1ae6ead9 221 if ($opts{U} && open(U, ">", "d_${func}_r.U")) {
7c1815b7 222 binmode U;
10bc17b6 223 }
aa418cf1 224
d63eadf0 225 if ($opts{U}) {
aa418cf1
JH
226 # The metaconfig units needs prerequisite dependencies.
227 my $prereqs = '';
228 my $prereqh = '';
229 my $prereqsh = '';
230 if ($hdr ne 'stdio') { # There's no i_stdio.
231 $prereqs = "i_$hdr";
232 $prereqh = "$hdr.h";
233 $prereqsh = "\$$prereqs $prereqh";
234 }
1fdb6f84
JH
235 my @prereq = qw(Inlibc Protochk Hasproto i_systypes usethreads);
236 push @prereq, $prereqs;
237 my $hdrs = "\$i_systypes sys/types.h define stdio.h $prereqsh";
aa418cf1 238 if ($hdr eq 'time') {
1fdb6f84
JH
239 $hdrs .= " \$i_systime sys/time.h";
240 push @prereq, 'i_systime';
241 }
aa418cf1 242 # Output the metaconfig unit header.
2d6469fe 243 print U <<"EOF";
aa418cf1 244?RCS: \$Id: d_${func}_r.U,v $
10bc17b6 245?RCS:
a845a0d4 246?RCS: Copyright (c) 2002,2003 Jarkko Hietaniemi
10bc17b6
JH
247?RCS:
248?RCS: You may distribute under the terms of either the GNU General Public
249?RCS: License or the Artistic License, as specified in the README file.
250?RCS:
251?RCS: Generated by the reentr.pl from the Perl 5.8 distribution.
252?RCS:
aa418cf1 253?MAKE:d_${func}_r ${func}_r_proto: @prereq
10bc17b6 254?MAKE: -pick add \$@ %<
aa418cf1
JH
255?S:d_${func}_r:
256?S: This variable conditionally defines the HAS_${FUNC}_R symbol,
257?S: which indicates to the C program that the ${func}_r()
10bc17b6
JH
258?S: routine is available.
259?S:.
aa418cf1
JH
260?S:${func}_r_proto:
261?S: This variable encodes the prototype of ${func}_r.
39183afa
JH
262?S: It is zero if d_${func}_r is undef, and one of the
263?S: REENTRANT_PROTO_T_ABC macros of reentr.h if d_${func}_r
264?S: is defined.
10bc17b6 265?S:.
aa418cf1
JH
266?C:HAS_${FUNC}_R:
267?C: This symbol, if defined, indicates that the ${func}_r routine
268?C: is available to ${func} re-entrantly.
10bc17b6 269?C:.
aa418cf1
JH
270?C:${FUNC}_R_PROTO:
271?C: This symbol encodes the prototype of ${func}_r.
39183afa
JH
272?C: It is zero if d_${func}_r is undef, and one of the
273?C: REENTRANT_PROTO_T_ABC macros of reentr.h if d_${func}_r
274?C: is defined.
10bc17b6 275?C:.
aa418cf1
JH
276?H:#\$d_${func}_r HAS_${FUNC}_R /**/
277?H:#define ${FUNC}_R_PROTO \$${func}_r_proto /**/
10bc17b6 278?H:.
aa418cf1
JH
279?T:try hdrs d_${func}_r_proto
280?LINT:set d_${func}_r
281?LINT:set ${func}_r_proto
282: see if ${func}_r exists
283set ${func}_r d_${func}_r
10bc17b6 284eval \$inlibc
aa418cf1 285case "\$d_${func}_r" in
10bc17b6 286"\$define")
d63eadf0 287EOF
2d6469fe 288 print U <<"EOF";
d63eadf0 289 hdrs="$hdrs"
aa418cf1
JH
290 case "\$d_${func}_r_proto:\$usethreads" in
291 ":define") d_${func}_r_proto=define
292 set d_${func}_r_proto ${func}_r \$hdrs
a48ec845
JH
293 eval \$hasproto ;;
294 *) ;;
295 esac
aa418cf1 296 case "\$d_${func}_r_proto" in
a48ec845 297 define)
10bc17b6 298EOF
d63eadf0
JH
299 }
300 for my $p (@p) {
301 my ($r, $a) = ($p =~ /^(.)_(.+)/);
302 my $v = join(", ", map { $m{$_} } split '', $a);
303 if ($opts{U}) {
2d6469fe 304 print U <<"EOF";
aa418cf1
JH
305 case "\$${func}_r_proto" in
306 ''|0) try='$m{$r} ${func}_r($v);'
307 ./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;;
10bc17b6
JH
308 esac
309EOF
d63eadf0 310 }
aa418cf1
JH
311 $seenh{$func}->{$p}++;
312 push @{$seena{$func}}, $p;
d63eadf0 313 $seenp{$p}++;
aa418cf1
JH
314 $seent{$func} = $type;
315 $seens{$func} = $m{S};
316 $seend{$func} = $m{D};
a845a0d4 317 $seenm{$func} = \%m;
d63eadf0
JH
318 }
319 if ($opts{U}) {
2d6469fe 320 print U <<"EOF";
aa418cf1
JH
321 case "\$${func}_r_proto" in
322 ''|0) d_${func}_r=undef
7c1815b7 323 ${func}_r_proto=0
aa418cf1
JH
324 echo "Disabling ${func}_r, cannot determine prototype." >&4 ;;
325 * ) case "\$${func}_r_proto" in
10bc17b6 326 REENTRANT_PROTO*) ;;
aa418cf1 327 *) ${func}_r_proto="REENTRANT_PROTO_\$${func}_r_proto" ;;
10bc17b6
JH
328 esac
329 echo "Prototype: \$try" ;;
330 esac
331 ;;
c18e646a 332 *) case "\$usethreads" in
aa418cf1 333 define) echo "${func}_r has no prototype, not using it." >&4 ;;
c18e646a 334 esac
aa418cf1
JH
335 d_${func}_r=undef
336 ${func}_r_proto=0
c18e646a 337 ;;
a48ec845
JH
338 esac
339 ;;
aa418cf1 340*) ${func}_r_proto=0
10bc17b6
JH
341 ;;
342esac
343
344EOF
7c1815b7 345 close(U);
10bc17b6
JH
346 }
347}
348
349close DATA;
350
10bc17b6 351{
aa418cf1 352 # Write out all the known prototype signatures.
10bc17b6
JH
353 my $i = 1;
354 for my $p (sort keys %seenp) {
7c1815b7 355 print $h "# define REENTRANT_PROTO_${p} ${i}\n";
10bc17b6
JH
356 $i++;
357 }
358}
359
aa418cf1
JH
360my @struct; # REENTR struct members
361my @size; # struct member buffer size initialization code
362my @init; # struct member buffer initialization (malloc) code
363my @free; # struct member buffer release (free) code
364my @wrap; # the wrapper (foo(a) -> foo_r(a,...)) cpp code
365my @define; # defines for optional features
366
10bc17b6 367sub ifprotomatch {
aa418cf1
JH
368 my $FUNC = shift;
369 join " || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @_;
10bc17b6
JH
370}
371
10bc17b6
JH
372sub pushssif {
373 push @struct, @_;
374 push @size, @_;
375 push @init, @_;
376 push @free, @_;
377}
378
379sub pushinitfree {
aa418cf1 380 my $func = shift;
10bc17b6 381 push @init, <<EOF;
a02a5408 382 Newx(PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char);
10bc17b6
JH
383EOF
384 push @free, <<EOF;
aa418cf1 385 Safefree(PL_reentrant_buffer->_${func}_buffer);
10bc17b6
JH
386EOF
387}
388
389sub define {
390 my ($n, $p, @F) = @_;
391 my @H;
392 my $H = uc $F[0];
393 push @define, <<EOF;
394/* The @F using \L$n? */
395
396EOF
aa418cf1
JH
397 my $GENFUNC;
398 for my $func (@F) {
399 my $FUNC = uc $func;
400 my $HAS = "${FUNC}_R_HAS_$n";
401 push @H, $HAS;
402 my @h = grep { /$p/ } @{$seena{$func}};
403 unless (defined $GENFUNC) {
404 $GENFUNC = $FUNC;
405 $GENFUNC =~ s/^GET//;
f7937171 406 }
10bc17b6 407 if (@h) {
7c1815b7 408 push @define, "# if defined(HAS_${FUNC}_R) && (" . join(" || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n";
10bc17b6
JH
409
410 push @define, <<EOF;
7c1815b7
KW
411# define $HAS
412# else
413# undef $HAS
414# endif
10bc17b6
JH
415EOF
416 }
417 }
0891a229 418 return if @F == 1;
10bc17b6
JH
419 push @define, <<EOF;
420
421/* Any of the @F using \L$n? */
422
423EOF
7c1815b7 424 push @define, "# if (" . join(" || ", map { "defined($_)" } @H) . ")\n";
10bc17b6 425 push @define, <<EOF;
7c1815b7
KW
426# define USE_${GENFUNC}_$n
427# else
428# undef USE_${GENFUNC}_$n
429# endif
10bc17b6
JH
430
431EOF
432}
433
edd309b7
JH
434define('BUFFER', 'B',
435 qw(getgrent getgrgid getgrnam));
436
10bc17b6
JH
437define('PTR', 'R',
438 qw(getgrent getgrgid getgrnam));
439define('PTR', 'R',
440 qw(getpwent getpwnam getpwuid));
441define('PTR', 'R',
442 qw(getspent getspnam));
443
444define('FPTR', 'H',
f7937171 445 qw(getgrent getgrgid getgrnam setgrent endgrent));
10bc17b6 446define('FPTR', 'H',
f7937171 447 qw(getpwent getpwnam getpwuid setpwent endpwent));
10bc17b6 448
edd309b7
JH
449define('BUFFER', 'B',
450 qw(getpwent getpwgid getpwnam));
451
5baa389e
KW
452define('BUFFER', 'B',
453 qw(getspent getspnam));
454
10bc17b6
JH
455define('PTR', 'R',
456 qw(gethostent gethostbyaddr gethostbyname));
457define('PTR', 'R',
458 qw(getnetent getnetbyaddr getnetbyname));
459define('PTR', 'R',
460 qw(getprotoent getprotobyname getprotobynumber));
461define('PTR', 'R',
462 qw(getservent getservbyname getservbyport));
463
edd309b7
JH
464define('BUFFER', 'B',
465 qw(gethostent gethostbyaddr gethostbyname));
466define('BUFFER', 'B',
467 qw(getnetent getnetbyaddr getnetbyname));
468define('BUFFER', 'B',
469 qw(getprotoent getprotobyname getprotobynumber));
470define('BUFFER', 'B',
471 qw(getservent getservbyname getservbyport));
472
10bc17b6
JH
473define('ERRNO', 'E',
474 qw(gethostent gethostbyaddr gethostbyname));
475define('ERRNO', 'E',
476 qw(getnetent getnetbyaddr getnetbyname));
477
aa418cf1
JH
478# The following loop accumulates the "ssif" (struct, size, init, free)
479# sections that declare the struct members (in reentr.h), and the buffer
480# size initialization, buffer initialization (malloc), and buffer
481# release (free) code (in reentr.c).
482#
483# The loop also contains a lot of intrinsic logic about groups of
484# functions (since functions of certain kind operate the same way).
485
486for my $func (@seenf) {
487 my $FUNC = uc $func;
7c1815b7
KW
488 my $ifdef = "# ifdef HAS_${FUNC}_R\n";
489 my $endif = "# endif /* HAS_${FUNC}_R */\n\n";
aa418cf1
JH
490 if (exists $seena{$func}) {
491 my @p = @{$seena{$func}};
492 if ($func =~ /^(asctime|ctime|getlogin|setlocale|strerror|ttyname)$/) {
10bc17b6
JH
493 pushssif $ifdef;
494 push @struct, <<EOF;
aa418cf1
JH
495 char* _${func}_buffer;
496 size_t _${func}_size;
10bc17b6
JH
497EOF
498 push @size, <<EOF;
aa418cf1 499 PL_reentrant_buffer->_${func}_size = REENTRANTSMALLSIZE;
10bc17b6 500EOF
aa418cf1 501 pushinitfree $func;
10bc17b6
JH
502 pushssif $endif;
503 }
e63f5cd5
KW
504 elsif ($func =~ /^(gm|local)time$/) {
505 pushssif $ifdef;
506 push @struct, <<EOF; # Fixed size
507 $seent{$func} _${func}_struct;
508EOF
509 pushssif $endif;
510 }
aa418cf1 511 elsif ($func =~ /^(crypt)$/) {
10bc17b6
JH
512 pushssif $ifdef;
513 push @struct, <<EOF;
7c1815b7 514# if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
aa418cf1 515 $seend{$func} _${func}_data;
7c1815b7 516# else
05404ffe 517 $seent{$func} *_${func}_struct_buffer;
7c1815b7 518# endif
10bc17b6 519EOF
7c1815b7
KW
520 push @init, <<EOF;
521# if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
05404ffe 522 PL_reentrant_buffer->_${func}_struct_buffer = 0;
7c1815b7 523# endif
05404ffe 524EOF
7c1815b7
KW
525 push @free, <<EOF;
526# if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
05404ffe 527 Safefree(PL_reentrant_buffer->_${func}_struct_buffer);
7c1815b7 528# endif
10bc17b6 529EOF
b430fd04
JH
530 pushssif $endif;
531 }
aa418cf1 532 elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) {
10bc17b6 533 pushssif $ifdef;
aa418cf1
JH
534 # 'genfunc' can be read either as 'generic' or 'genre',
535 # it represents a group of functions.
536 my $genfunc = $func;
537 $genfunc =~ s/nam/ent/g;
538 $genfunc =~ s/^get//;
539 my $GENFUNC = uc $genfunc;
10bc17b6 540 push @struct, <<EOF;
aa418cf1
JH
541 $seent{$func} _${genfunc}_struct;
542 char* _${genfunc}_buffer;
543 size_t _${genfunc}_size;
10bc17b6
JH
544EOF
545 push @struct, <<EOF;
aa418cf1
JH
546# ifdef USE_${GENFUNC}_PTR
547 $seent{$func}* _${genfunc}_ptr;
10bc17b6
JH
548# endif
549EOF
0de8cad8 550 push @struct, <<EOF;
aa418cf1
JH
551# ifdef USE_${GENFUNC}_FPTR
552 FILE* _${genfunc}_fptr;
10bc17b6
JH
553# endif
554EOF
0de8cad8 555 push @init, <<EOF;
aa418cf1
JH
556# ifdef USE_${GENFUNC}_FPTR
557 PL_reentrant_buffer->_${genfunc}_fptr = NULL;
10bc17b6
JH
558# endif
559EOF
0de8cad8 560 my $sc = $genfunc eq 'grent' ?
10bc17b6 561 '_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX';
0de8cad8
RGS
562 my $sz = "_${genfunc}_size";
563 push @size, <<EOF;
7c1815b7 564# if defined(HAS_SYSCONF) && defined($sc) && !defined(__GLIBC__)
0de8cad8 565 PL_reentrant_buffer->$sz = sysconf($sc);
832a833b 566 if (PL_reentrant_buffer->$sz == (size_t) -1)
e3410746 567 PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
7c1815b7 568# elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
0de8cad8 569 PL_reentrant_buffer->$sz = SIABUFSIZ;
7c1815b7 570# elif defined(__sgi)
0de8cad8 571 PL_reentrant_buffer->$sz = BUFSIZ;
7c1815b7 572# else
0de8cad8 573 PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
7c1815b7 574# endif
10bc17b6 575EOF
aa418cf1 576 pushinitfree $genfunc;
10bc17b6
JH
577 pushssif $endif;
578 }
aa418cf1 579 elsif ($func =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) {
10bc17b6 580 pushssif $ifdef;
aa418cf1
JH
581 my $genfunc = $func;
582 $genfunc =~ s/byname/ent/;
583 $genfunc =~ s/^get//;
584 my $GENFUNC = uc $genfunc;
585 my $D = ifprotomatch($FUNC, grep {/D/} @p);
586 my $d = $seend{$func};
b6a6e956 587 $d =~ s/\*$//; # snip: we need the base type.
10bc17b6 588 push @struct, <<EOF;
aa418cf1 589 $seent{$func} _${genfunc}_struct;
10bc17b6 590# if $D
aa418cf1 591 $d _${genfunc}_data;
10bc17b6 592# else
aa418cf1
JH
593 char* _${genfunc}_buffer;
594 size_t _${genfunc}_size;
10bc17b6 595# endif
aa418cf1
JH
596# ifdef USE_${GENFUNC}_PTR
597 $seent{$func}* _${genfunc}_ptr;
10bc17b6
JH
598# endif
599EOF
7c1815b7 600 push @struct, <<EOF;
aa418cf1
JH
601# ifdef USE_${GENFUNC}_ERRNO
602 int _${genfunc}_errno;
7c1815b7 603# endif
10bc17b6
JH
604EOF
605 push @size, <<EOF;
7c1815b7 606# if !($D)
aa418cf1 607 PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE;
7c1815b7 608# endif
10bc17b6
JH
609EOF
610 push @init, <<EOF;
7c1815b7 611# if !($D)
a02a5408 612 Newx(PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char);
7c1815b7 613# endif
10bc17b6
JH
614EOF
615 push @free, <<EOF;
7c1815b7 616# if !($D)
aa418cf1 617 Safefree(PL_reentrant_buffer->_${genfunc}_buffer);
7c1815b7 618# endif
10bc17b6
JH
619EOF
620 pushssif $endif;
621 }
aa418cf1 622 elsif ($func =~ /^(readdir|readdir64)$/) {
10bc17b6 623 pushssif $ifdef;
aa418cf1 624 my $R = ifprotomatch($FUNC, grep {/R/} @p);
10bc17b6 625 push @struct, <<EOF;
aa418cf1
JH
626 $seent{$func}* _${func}_struct;
627 size_t _${func}_size;
10bc17b6 628# if $R
aa418cf1 629 $seent{$func}* _${func}_ptr;
10bc17b6
JH
630# endif
631EOF
632 push @size, <<EOF;
633 /* This is the size Solaris recommends.
634 * (though we go static, should use pathconf() instead) */
aa418cf1 635 PL_reentrant_buffer->_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1;
10bc17b6 636EOF
7c1815b7 637 push @init, <<EOF;
aa418cf1 638 PL_reentrant_buffer->_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size);
10bc17b6
JH
639EOF
640 push @free, <<EOF;
aa418cf1 641 Safefree(PL_reentrant_buffer->_${func}_struct);
10bc17b6
JH
642EOF
643 pushssif $endif;
644 }
645
646 push @wrap, $ifdef;
647
10bc17b6 648 push @wrap, <<EOF;
02af4629
KW
649# if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
650# undef $func
10bc17b6 651EOF
aa418cf1
JH
652
653 # Write out what we have learned.
654
10bc17b6 655 my @v = 'a'..'z';
aa418cf1 656 my $v = join(", ", @v[0..$seenu{$func}-1]);
10bc17b6
JH
657 for my $p (@p) {
658 my ($r, $a) = split '_', $p;
659 my $test = $r eq 'I' ? ' == 0' : '';
660 my $true = 1;
aa418cf1
JH
661 my $genfunc = $func;
662 if ($genfunc =~ /^(?:get|set|end)(pw|gr|host|net|proto|serv|sp)/) {
663 $genfunc = "${1}ent";
10bc17b6
JH
664 }
665 my $b = $a;
666 my $w = '';
aa418cf1 667 substr($b, 0, $seenu{$func}) = '';
a7f3e46a 668 if ($b =~ /R/) {
aa418cf1 669 $true = "PL_reentrant_buffer->_${genfunc}_ptr";
10bc17b6 670 } elsif ($b =~ /S/) {
aa418cf1
JH
671 if ($func =~ /^readdir/) {
672 $true = "PL_reentrant_buffer->_${genfunc}_struct";
10bc17b6 673 } else {
aa418cf1 674 $true = "&PL_reentrant_buffer->_${genfunc}_struct";
10bc17b6
JH
675 }
676 } elsif ($b =~ /B/) {
aa418cf1 677 $true = "PL_reentrant_buffer->_${genfunc}_buffer";
10bc17b6
JH
678 }
679 if (length $b) {
680 $w = join ", ",
76baed8e
KW
681 map { $_ eq 'R'
682 ? "&PL_reentrant_buffer->_${genfunc}_ptr"
683 : $_ eq 'E'
684 ? "&PL_reentrant_buffer->_${genfunc}_errno"
685 : $_ eq 'B'
686 ? "PL_reentrant_buffer->_${genfunc}_buffer"
687 : $_ =~ /^[WI]$/
688 ? "PL_reentrant_buffer->_${genfunc}_size"
689 : $_ eq 'H'
690 ? "&PL_reentrant_buffer->_${genfunc}_fptr"
691 : $_ eq 'D'
692 ? "&PL_reentrant_buffer->_${genfunc}_data"
693 : $_ eq 'S'
694 ? ($func =~ /^readdir\d*$/
695 ? "PL_reentrant_buffer->_${genfunc}_struct"
696 : $func =~ /^crypt$/
697 ? "PL_reentrant_buffer->_${genfunc}_struct_buffer"
698 : "&PL_reentrant_buffer->_${genfunc}_struct")
699 : $_
700 } split '', $b;
10bc17b6
JH
701 $w = ", $w" if length $v;
702 }
832a833b 703
e63f5cd5
KW
704 # This needs a special case, see its definition in config.h
705 my $setup = ($func eq 'localtime') ? "L_R_TZSET " : "";
706
707 my $call = "$setup${func}_r($v$w)";
23e2b7a9
SP
708
709 # Must make OpenBSD happy
710 my $memzero = '';
711 if($p =~ /D$/ &&
712 ($genfunc eq 'protoent' || $genfunc eq 'servent')) {
3fb2f3ac 713 $memzero = 'REENTR_MEMZERO(&PL_reentrant_buffer->_' . $genfunc . '_data, sizeof(PL_reentrant_buffer->_' . $genfunc . '_data)),';
23e2b7a9 714 }
10bc17b6 715 push @wrap, <<EOF;
02af4629 716# if !defined($func) && ${FUNC}_R_PROTO == REENTRANT_PROTO_$p
10bc17b6
JH
717EOF
718 if ($r eq 'V' || $r eq 'B') {
719 push @wrap, <<EOF;
02af4629 720# define $func($v) $call
10bc17b6
JH
721EOF
722 } else {
aa418cf1 723 if ($func =~ /^get/) {
edd309b7 724 my $rv = $v ? ", $v" : "";
0891a229
JH
725 if ($r eq 'I') {
726 push @wrap, <<EOF;
02af4629 727# define $func($v) ($memzero(PL_reentrant_retint = $call)$test ? $true : ((PL_reentrant_retint == ERANGE) ? ($seent{$func} *) Perl_reentrant_retry("$func"$rv) : 0))
0891a229
JH
728EOF
729 } else {
730 push @wrap, <<EOF;
02af4629 731# define $func($v) ($call$test ? $true : ((errno == ERANGE) ? ($seent{$func} *) Perl_reentrant_retry("$func"$rv) : 0))
10bc17b6 732EOF
0891a229 733 }
edd309b7
JH
734 } else {
735 push @wrap, <<EOF;
02af4629 736# define $func($v) ($call$test ? $true : 0)
edd309b7
JH
737EOF
738 }
10bc17b6 739 }
02af4629
KW
740 push @wrap, <<EOF; # !defined(xxx) && XXX_R_PROTO == REENTRANT_PROTO_Y_TS
741# endif
10bc17b6
JH
742EOF
743 }
7dc0f1bb
KW
744 push @wrap, <<EOF;
745# if defined($func)
746# define PERL_REENTR_USING_${FUNC}_R
747# endif
748EOF
10bc17b6 749
02af4629
KW
750 push @wrap, <<EOF; # defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
751# endif
832a833b
JH
752EOF
753
10bc17b6
JH
754 push @wrap, $endif, "\n";
755 }
756}
757
758local $" = '';
759
2d6469fe 760print $h <<EOF;
10bc17b6
JH
761
762/* Defines for indicating which special features are supported. */
763
764@define
765typedef struct {
7c1815b7 766
10bc17b6 767@struct
aa418cf1 768 int dummy; /* cannot have empty structs */
10bc17b6
JH
769} REENTR;
770
771/* The wrappers. */
772
773@wrap
5baa389e
KW
774
775/* Special case this; if others came along, could automate it */
776# ifdef HAS_GETSPNAM_R
777# define KEY_getspnam -1
778# endif
779
10bc17b6 780#endif /* USE_REENTRANT_API */
7c1815b7 781
10bc17b6 782#endif
10bc17b6
JH
783EOF
784
ce716c52 785read_only_bottom_close_and_rename($h);
10bc17b6 786
aa418cf1
JH
787# Prepare to write the reentr.c.
788
d91994bb 789my $c = open_print_header('reentr.c', <<'EOQ');
23ce015e
JH
790 */
791
792/*
10bc17b6 793 * "Saruman," I said, standing away from him, "only one hand at a time can
56fd1190 794 * wield the One, and you know that well, so do not trouble to say we!"
10bc17b6 795 *
23ce015e
JH
796 * [p.260 of _The Lord of the Rings_, II/ii: "The Council of Elrond"]
797 */
798
799/*
61296642
DM
800 * This file contains a collection of automatically created wrappers
801 * (created by running reentr.pl) for reentrant (thread-safe) versions of
802 * various library calls, such as getpwent_r. The wrapping is done so
803 * that other files like pp_sys.c calling those library functions need not
804 * care about the differences between various platforms' idiosyncrasies
7c1815b7 805 * regarding these reentrant interfaces.
10bc17b6 806 */
56fd1190 807EOQ
10bc17b6 808
56fd1190 809print $c <<"EOF";
10bc17b6
JH
810#include "EXTERN.h"
811#define PERL_IN_REENTR_C
812#include "perl.h"
813#include "reentr.h"
5f478816 814#include "keywords.h"
10bc17b6 815
acfc2cc3
HS
816#define RenewDouble(data_pointer, size_pointer, type) \\
817 STMT_START { \\
818 const size_t size = *(size_pointer) * 2; \\
819 Renew((data_pointer), (size), type); \\
820 *(size_pointer) = size; \\
821 } STMT_END
822
10bc17b6
JH
823void
824Perl_reentrant_size(pTHX) {
23491f1d 825 PERL_UNUSED_CONTEXT;
0917d9b3
KW
826
827 /* Set the sizes of the reentrant buffers */
828
10bc17b6 829#ifdef USE_REENTRANT_API
7c1815b7
KW
830# define REENTRANTSMALLSIZE 256 /* Make something up. */
831# define REENTRANTUSUALSIZE 4096 /* Make something up. */
832
10bc17b6
JH
833@size
834#endif /* USE_REENTRANT_API */
7c1815b7 835
10bc17b6
JH
836}
837
838void
839Perl_reentrant_init(pTHX) {
23491f1d 840 PERL_UNUSED_CONTEXT;
0917d9b3
KW
841
842 /* Initialize the whole thing */
843
10bc17b6 844#ifdef USE_REENTRANT_API
7c1815b7 845
a02a5408 846 Newx(PL_reentrant_buffer, 1, REENTR);
10bc17b6 847 Perl_reentrant_size(aTHX);
7c1815b7 848
10bc17b6
JH
849@init
850#endif /* USE_REENTRANT_API */
7c1815b7 851
10bc17b6
JH
852}
853
854void
855Perl_reentrant_free(pTHX) {
23491f1d 856 PERL_UNUSED_CONTEXT;
0917d9b3
KW
857
858 /* Tear down */
859
10bc17b6 860#ifdef USE_REENTRANT_API
7c1815b7 861
10bc17b6
JH
862@free
863 Safefree(PL_reentrant_buffer);
7c1815b7 864
10bc17b6
JH
865#endif /* USE_REENTRANT_API */
866}
867
edd309b7
JH
868void*
869Perl_reentrant_retry(const char *f, ...)
870{
0917d9b3
KW
871 /* This function is set up to be called if the normal function returns
872 * failure with errno ERANGE, which indicates the buffer is too small.
873 * This function calls the failing one again with a larger buffer.
874 *
875 * What has happened is that, due to the magic of C preprocessor macro
876 * expansion, when the original code called function 'foo(args)', it was
877 * instead compiled into something like a call of 'foo_r(args, buffer)'
878 * Below we retry with 'foo', but the preprocessor has changed that into
879 * 'foo_r', so this function will end up calling itself recursively, each
880 * time with a larger buffer. If PERL_REENTRANT_MAXSIZE is defined, it
881 * won't increase beyond that, instead failing. */
882
edd309b7 883 void *retptr = NULL;
fe5bfecd 884 va_list ap;
7c1815b7 885
5f478816
KW
886 I32 key = 0;
887
7918f24d 888#ifdef USE_REENTRANT_API
7c1815b7 889
dbf7dff6 890 dTHX;
7c1815b7 891
5f478816
KW
892 key = Perl_keyword (aTHX_ f, strlen(f), FALSE /* not feature enabled */);
893
7918f24d
NC
894 /* Easier to special case this here than in embed.pl. (Look at what it
895 generates for proto.h) */
896 PERL_ARGS_ASSERT_REENTRANT_RETRY;
7c1815b7 897
7918f24d 898#endif
7c1815b7 899
5f478816 900 if (key == 0) {
5baa389e
KW
901
902#ifdef HAS_GETSPNAM_R
903
904 /* This is a #define as has no corresponding keyword */
905 if (strEQ(f, "getspnam")) {
906 key = KEY_getspnam;
907 }
908
909#endif
910
5f478816
KW
911 }
912 else if (key < 0) {
913 key = -key;
914 }
915
fe5bfecd 916 va_start(ap, f);
7c1815b7 917
edd309b7 918#ifdef USE_REENTRANT_API
edd309b7 919
5f478816 920 switch (key) {
7c1815b7
KW
921
922# ifdef USE_HOSTENT_BUFFER
923
5f478816
KW
924 case KEY_gethostbyaddr:
925 case KEY_gethostbyname:
926 case KEY_endhostent:
edd309b7 927 {
72761345
KW
928 char * host_addr;
929 Size_t asize;
930 char * host_name;
931 int anint;
7c1815b7
KW
932
933# ifdef PERL_REENTRANT_MAXSIZE
af685957
JH
934 if (PL_reentrant_buffer->_hostent_size <=
935 PERL_REENTRANT_MAXSIZE / 2)
7c1815b7 936# endif
72761345
KW
937 RenewDouble(PL_reentrant_buffer->_hostent_buffer,
938 &PL_reentrant_buffer->_hostent_size, char);
5f478816 939 switch (key) {
72761345
KW
940 case KEY_gethostbyaddr:
941 host_addr = va_arg(ap, char *);
942 asize = va_arg(ap, Size_t);
edd309b7 943 anint = va_arg(ap, int);
72761345
KW
944 /* socklen_t is what Posix 2001 says this should be */
945 retptr = gethostbyaddr(host_addr, (socklen_t) asize, anint); break;
5f478816 946 case KEY_gethostbyname:
72761345
KW
947 host_name = va_arg(ap, char *);
948 retptr = gethostbyname(host_name); break;
5f478816 949 case KEY_endhostent:
edd309b7
JH
950 retptr = gethostent(); break;
951 default:
0de8cad8 952 SETERRNO(ERANGE, LIB_INVARG);
edd309b7 953 break;
edd309b7
JH
954 }
955 }
956 break;
7c1815b7
KW
957
958# endif
959# ifdef USE_GRENT_BUFFER
960
5f478816
KW
961 case KEY_getgrent:
962 case KEY_getgrgid:
963 case KEY_getgrnam:
edd309b7 964 {
72761345
KW
965 char * name;
966 Gid_t gid;
7c1815b7
KW
967
968# ifdef PERL_REENTRANT_MAXSIZE
af685957
JH
969 if (PL_reentrant_buffer->_grent_size <=
970 PERL_REENTRANT_MAXSIZE / 2)
7c1815b7 971# endif
7c1815b7
KW
972 RenewDouble(PL_reentrant_buffer->_grent_buffer,
973 &PL_reentrant_buffer->_grent_size, char);
5f478816 974 switch (key) {
72761345
KW
975 case KEY_getgrnam:
976 name = va_arg(ap, char *);
977 retptr = getgrnam(name); break;
5f478816 978 case KEY_getgrgid:
7c1815b7
KW
979# if Gid_t_size < INTSIZE
980 gid = (Gid_t)va_arg(ap, int);
981# else
edd309b7 982 gid = va_arg(ap, Gid_t);
7c1815b7 983# endif
edd309b7 984 retptr = getgrgid(gid); break;
5f478816 985 case KEY_getgrent:
edd309b7
JH
986 retptr = getgrent(); break;
987 default:
0de8cad8 988 SETERRNO(ERANGE, LIB_INVARG);
edd309b7 989 break;
edd309b7
JH
990 }
991 }
992 break;
7c1815b7
KW
993
994# endif
995# ifdef USE_NETENT_BUFFER
996
5f478816
KW
997 case KEY_getnetbyaddr:
998 case KEY_getnetbyname:
999 case KEY_getnetent:
edd309b7 1000 {
72761345
KW
1001 char * name;
1002 Netdb_net_t net;
1003 int anint;
7c1815b7
KW
1004
1005# ifdef PERL_REENTRANT_MAXSIZE
af685957
JH
1006 if (PL_reentrant_buffer->_netent_size <=
1007 PERL_REENTRANT_MAXSIZE / 2)
7c1815b7 1008# endif
7c1815b7
KW
1009 RenewDouble(PL_reentrant_buffer->_netent_buffer,
1010 &PL_reentrant_buffer->_netent_size, char);
5f478816 1011 switch (key) {
72761345
KW
1012 case KEY_getnetbyaddr:
1013 net = va_arg(ap, Netdb_net_t);
1014 anint = va_arg(ap, int);
1015 retptr = getnetbyaddr(net, anint); break;
1016 case KEY_getnetbyname:
1017 name = va_arg(ap, char *);
1018 retptr = getnetbyname(name); break;
1019 case KEY_getnetent:
1020 retptr = getnetent(); break;
1021 default:
1022 SETERRNO(ERANGE, LIB_INVARG);
1023 break;
1024 }
edd309b7
JH
1025 }
1026 break;
7c1815b7
KW
1027
1028# endif
1029# ifdef USE_PWENT_BUFFER
1030
5baa389e
KW
1031 case KEY_getpwnam:
1032 case KEY_getpwuid:
1033 case KEY_getpwent:
edd309b7 1034 {
72761345
KW
1035 Uid_t uid;
1036 char * name;
7c1815b7
KW
1037
1038# ifdef PERL_REENTRANT_MAXSIZE
af685957
JH
1039 if (PL_reentrant_buffer->_pwent_size <=
1040 PERL_REENTRANT_MAXSIZE / 2)
7c1815b7
KW
1041
1042# endif
7c1815b7
KW
1043 RenewDouble(PL_reentrant_buffer->_pwent_buffer,
1044 &PL_reentrant_buffer->_pwent_size, char);
5f478816
KW
1045 switch (key) {
1046 case KEY_getpwnam:
72761345
KW
1047 name = va_arg(ap, char *);
1048 retptr = getpwnam(name); break;
5f478816 1049 case KEY_getpwuid:
7c1815b7
KW
1050
1051# if Uid_t_size < INTSIZE
ab2b559b 1052 uid = (Uid_t)va_arg(ap, int);
7c1815b7 1053# else
edd309b7 1054 uid = va_arg(ap, Uid_t);
7c1815b7 1055# endif
edd309b7 1056 retptr = getpwuid(uid); break;
7c1815b7
KW
1057
1058# if defined(HAS_GETPWENT) || defined(HAS_GETPWENT_R)
5f478816
KW
1059
1060 case KEY_getpwent:
edd309b7 1061 retptr = getpwent(); break;
7c1815b7 1062# endif
edd309b7 1063 default:
0de8cad8 1064 SETERRNO(ERANGE, LIB_INVARG);
edd309b7 1065 break;
7c1815b7 1066 }
edd309b7
JH
1067 }
1068 break;
7c1815b7
KW
1069
1070# endif
5baa389e
KW
1071# ifdef USE_SPENT_BUFFER
1072
1073 case KEY_getspnam:
1074 {
1075 char * name;
1076
1077# ifdef PERL_REENTRANT_MAXSIZE
1078 if (PL_reentrant_buffer->_spent_size <=
1079 PERL_REENTRANT_MAXSIZE / 2)
1080
1081# endif
1082 RenewDouble(PL_reentrant_buffer->_spent_buffer,
1083 &PL_reentrant_buffer->_spent_size, char);
1084 switch (key) {
1085 case KEY_getspnam:
1086 name = va_arg(ap, char *);
1087 retptr = getspnam(name); break;
1088 default:
1089 SETERRNO(ERANGE, LIB_INVARG);
1090 break;
1091 }
1092 }
1093 break;
1094
1095# endif
7c1815b7
KW
1096# ifdef USE_PROTOENT_BUFFER
1097
5f478816
KW
1098 case KEY_getprotobyname:
1099 case KEY_getprotobynumber:
1100 case KEY_getprotoent:
edd309b7 1101 {
72761345
KW
1102 char * name;
1103 int anint;
7c1815b7
KW
1104
1105# ifdef PERL_REENTRANT_MAXSIZE
af685957
JH
1106 if (PL_reentrant_buffer->_protoent_size <=
1107 PERL_REENTRANT_MAXSIZE / 2)
7c1815b7 1108# endif
7c1815b7
KW
1109 RenewDouble(PL_reentrant_buffer->_protoent_buffer,
1110 &PL_reentrant_buffer->_protoent_size, char);
5f478816
KW
1111 switch (key) {
1112 case KEY_getprotobyname:
72761345
KW
1113 name = va_arg(ap, char *);
1114 retptr = getprotobyname(name); break;
5f478816 1115 case KEY_getprotobynumber:
edd309b7
JH
1116 anint = va_arg(ap, int);
1117 retptr = getprotobynumber(anint); break;
5f478816 1118 case KEY_getprotoent:
edd309b7
JH
1119 retptr = getprotoent(); break;
1120 default:
0de8cad8 1121 SETERRNO(ERANGE, LIB_INVARG);
edd309b7 1122 break;
7c1815b7 1123 }
edd309b7
JH
1124 }
1125 break;
7c1815b7
KW
1126
1127# endif
1128# ifdef USE_SERVENT_BUFFER
1129
5f478816
KW
1130 case KEY_getservbyname:
1131 case KEY_getservbyport:
1132 case KEY_getservent:
edd309b7 1133 {
72761345
KW
1134 char * name;
1135 char * proto;
1136 int anint;
7c1815b7
KW
1137
1138# ifdef PERL_REENTRANT_MAXSIZE
af685957
JH
1139 if (PL_reentrant_buffer->_servent_size <=
1140 PERL_REENTRANT_MAXSIZE / 2)
7c1815b7 1141# endif
7c1815b7
KW
1142 RenewDouble(PL_reentrant_buffer->_servent_buffer,
1143 &PL_reentrant_buffer->_servent_size, char);
5f478816
KW
1144 switch (key) {
1145 case KEY_getservbyname:
72761345
KW
1146 name = va_arg(ap, char *);
1147 proto = va_arg(ap, char *);
1148 retptr = getservbyname(name, proto); break;
5f478816 1149 case KEY_getservbyport:
edd309b7 1150 anint = va_arg(ap, int);
72761345
KW
1151 name = va_arg(ap, char *);
1152 retptr = getservbyport(anint, name); break;
5f478816 1153 case KEY_getservent:
edd309b7
JH
1154 retptr = getservent(); break;
1155 default:
0de8cad8 1156 SETERRNO(ERANGE, LIB_INVARG);
edd309b7 1157 break;
edd309b7
JH
1158 }
1159 }
1160 break;
7c1815b7
KW
1161
1162# endif
1163
edd309b7
JH
1164 default:
1165 /* Not known how to retry, so just fail. */
1166 break;
1167 }
7c1815b7 1168
6148ee25 1169#else
7c1815b7 1170
6148ee25 1171 PERL_UNUSED_ARG(f);
7c1815b7 1172
edd309b7 1173#endif
7c1815b7 1174
fe5bfecd 1175 va_end(ap);
edd309b7
JH
1176 return retptr;
1177}
10bc17b6
JH
1178EOF
1179
ce716c52 1180read_only_bottom_close_and_rename($c);
b6b9a099 1181
3d7d42a3
KW
1182# As of March 2020, the config.h entries that have reentrant prototypes that
1183# aren't in this file are:
1184# drand48
1185# random
1186# srand48
1187# srandom
1188
0917d9b3
KW
1189# The meanings of the flags are derivable from %map above
1190# Fnc, arg flags| hdr | ? struct type | prototypes...
10bc17b6
JH
1191__DATA__
1192asctime S |time |const struct tm|B_SB|B_SBI|I_SB|I_SBI
b430fd04 1193crypt CC |crypt |struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
10bc17b6
JH
1194ctermid B |stdio | |B_B
1195ctime S |time |const time_t |B_SB|B_SBI|I_SB|I_SBI
10bc17b6 1196endgrent |grp | |I_H|V_H
31ee0cb7
JH
1197endhostent |netdb | |I_D|V_D|D=struct hostent_data*
1198endnetent |netdb | |I_D|V_D|D=struct netent_data*
1199endprotoent |netdb | |I_D|V_D|D=struct protoent_data*
10bc17b6 1200endpwent |pwd | |I_H|V_H
31ee0cb7 1201endservent |netdb | |I_D|V_D|D=struct servent_data*
10bc17b6
JH
1202getgrent |grp |struct group |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
1203getgrgid T |grp |struct group |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=gid_t
1204getgrnam C |grp |struct group |I_CSBWR|I_CSBIR|S_CBI|I_CSBI|S_CSBI
a845a0d4 1205gethostbyaddr 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
10bc17b6
JH
1206gethostbyname C |netdb |struct hostent |I_CSBWRE|S_CSBIE|I_CSD|D=struct hostent_data*
1207gethostent |netdb |struct hostent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct hostent_data*
f6f0b69b 1208getlogin |unistd |char |I_BW|I_BI|B_BW|B_BI
a845a0d4 1209getnetbyaddr 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
10bc17b6
JH
1210getnetbyname C |netdb |struct netent |I_CSBWRE|I_CSBI|S_CSBI|I_CSD|D=struct netent_data*
1211getnetent |netdb |struct netent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct netent_data*
1212getprotobyname C|netdb |struct protoent|I_CSBWR|S_CSBI|I_CSD|D=struct protoent_data*
1213getprotobynumber I |netdb |struct protoent|I_ISBWR|S_ISBI|I_ISD|D=struct protoent_data*
1214getprotoent |netdb |struct protoent|I_SBWR|I_SBI|S_SBI|I_SD|D=struct protoent_data*
1215getpwent |pwd |struct passwd |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
1216getpwnam C |pwd |struct passwd |I_CSBWR|I_CSBIR|S_CSBI|I_CSBI
1217getpwuid T |pwd |struct passwd |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=uid_t
1218getservbyname CC|netdb |struct servent |I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent_data*
1219getservbyport IC|netdb |struct servent |I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
1220getservent |netdb |struct servent |I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
1221getspnam C |shadow |struct spwd |I_CSBWR|S_CSBI
e63f5cd5
KW
1222gmtime T |time |struct tm |S_TS|T=time_t*
1223localtime T |time |struct tm |S_TS|T=time_t*
10bc17b6
JH
1224readdir T |dirent |struct dirent |I_TSR|I_TS|T=DIR*
1225readdir64 T |dirent |struct dirent64|I_TSR|I_TS|T=DIR*
1226setgrent |grp | |I_H|V_H
1227sethostent I |netdb | |I_ID|V_ID|D=struct hostent_data*
1228setlocale IC |locale | |I_ICBI
1229setnetent I |netdb | |I_ID|V_ID|D=struct netent_data*
1230setprotoent I |netdb | |I_ID|V_ID|D=struct protoent_data*
1231setpwent |pwd | |I_H|V_H
1232setservent I |netdb | |I_ID|V_ID|D=struct servent_data*
10bc17b6
JH
1233strerror I |string | |I_IBW|I_IBI|B_IBW
1234tmpnam B |stdio | |B_B
1235ttyname I |unistd | |I_IBW|I_IBI|B_IBI