This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ptrsize should depend on use64bitall, not the other
[perl5.git] / reentr.pl
CommitLineData
10bc17b6
JH
1#!/usr/bin/perl -w
2
3#
4# Generate the reentr.c and reentr.h,
5# and optionally also the relevant metaconfig units (-U option).
6#
7
8use strict;
9use Getopt::Std;
10my %opts;
11getopts('U', \%opts);
12
13my %map = (
14 V => "void",
15 A => "char*", # as an input argument
16 B => "char*", # as an output argument
17 C => "const char*", # as a read-only input argument
18 I => "int",
19 L => "long",
20 W => "size_t",
21 H => "FILE**",
22 E => "int*",
23 );
24
25# (See the definitions after __DATA__.)
26# In func|inc|type|... a "S" means "type*", and a "R" means "type**".
27# (The "types" are often structs, such as "struct passwd".)
28#
29# After the prototypes one can have |X=...|Y=... to define more types.
30# A commonly used extra type is to define D to be equal to "type_data",
31# for example "struct_hostent_data to" go with "struct hostent".
32#
33# Example #1: I_XSBWR means int func_r(X, type, char*, size_t, type**)
34# Example #2: S_SBIE means type func_r(type, char*, int, int*)
35# Example #3: S_CBI means type func_r(const char*, char*, int)
36
37
38die "reentr.h: $!" unless open(H, ">reentr.h");
39select H;
40print <<EOF;
41/*
42 * reentr.h
43 *
44 * Copyright (c) 1997-2002, Larry Wall
45 *
46 * You may distribute under the terms of either the GNU General Public
47 * License or the Artistic License, as specified in the README file.
48 *
49 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
50 * This file is built by reentrl.pl from data in reentr.pl.
51 */
52
53#ifndef REENTR_H
54#define REENTR_H
55
56#ifdef USE_REENTRANT_API
57
58/* Deprecations: some platforms have the said reentrant interfaces
59 * but they are declared obsolete and are not to be used. Often this
60 * means that the platform has threadsafed the interfaces (hopefully).
61 * All this is OS version dependent, so we are of course fooling ourselves.
62 * If you know of more deprecations on some platforms, please add your own. */
63
64#ifdef __hpux
65# undef HAS_CRYPT_R
66# undef HAS_DRAND48_R
efa45b01
JH
67# undef HAS_ENDGRENT_R
68# undef HAS_ENDPWENT_R
10bc17b6
JH
69# undef HAS_GETGRENT_R
70# undef HAS_GETPWENT_R
71# undef HAS_SETLOCALE_R
72# undef HAS_SRAND48_R
73# undef HAS_STRERROR_R
74# define NETDB_R_OBSOLETE
75#endif
76
77#if defined(__osf__) && defined(__alpha) /* Tru64 aka Digital UNIX */
78# undef HAS_CRYPT_R
79# undef HAS_STRERROR_R
80# define NETDB_R_OBSOLETE
81#endif
82
83#ifdef NETDB_R_OBSOLETE
84# undef HAS_ENDHOSTENT_R
85# undef HAS_ENDNETENT_R
86# undef HAS_ENDPROTOENT_R
87# undef HAS_ENDSERVENT_R
88# undef HAS_GETHOSTBYADDR_R
89# undef HAS_GETHOSTBYNAME_R
90# undef HAS_GETHOSTENT_R
91# undef HAS_GETNETBYADDR_R
92# undef HAS_GETNETBYNAME_R
93# undef HAS_GETNETENT_R
94# undef HAS_GETPROTOBYNAME_R
95# undef HAS_GETPROTOBYNUMBER_R
96# undef HAS_GETPROTOENT_R
97# undef HAS_GETSERVBYNAME_R
98# undef HAS_GETSERVBYPORT_R
99# undef HAS_GETSERVENT_R
100# undef HAS_SETHOSTENT_R
101# undef HAS_SETNETENT_R
102# undef HAS_SETPROTOENT_R
103# undef HAS_SETSERVENT_R
104#endif
105
106#ifdef I_PWD
107# include <pwd.h>
108#endif
109#ifdef I_GRP
110# include <grp.h>
111#endif
112#ifdef I_NETDB
113# include <netdb.h>
114#endif
115#ifdef I_STDLIB
116# include <stdlib.h> /* drand48_data */
117#endif
118#ifdef I_CRYPT
119# ifdef I_CRYPT
120# include <crypt.h>
121# endif
122#endif
123#ifdef HAS_GETSPNAM_R
124# ifdef I_SHADOW
125# include <shadow.h>
126# endif
127#endif
128
129EOF
130
131my %seenh;
132my %seena;
133my @seenf;
134my %seenp;
135my %seent;
136my %seens;
137my %seend;
138my %seenu;
139
140while (<DATA>) {
141 next if /^\s+$/;
142 chomp;
143 my ($f, $h, $t, @p) = split(/\s*\|\s*/, $_, -1);
144 my $u;
145 ($f, $u) = split(' ', $f);
146 $seenu{$f} = defined $u ? length $u : 0;
147 my $F = uc $f;
148 push @seenf, $f;
149 my %m = %map;
150 if ($t) {
151 $m{S} = "$t*";
152 $m{R} = "$t**";
153 }
154 if (@p) {
155 while ($p[-1] =~ /=/) {
156 my ($k, $v) = ($p[-1] =~ /^([A-Za-z])\s*=\s*(.*)/);
157 $m{$k} = $v;
158 pop @p;
159 }
160 }
161 if ($opts{U} && open(U, ">d_${f}_r.U")) {
162 select U;
163 }
31ee0cb7
JH
164 my $prereqs = '';
165 my $prereqh = '';
166 my $prereqsh = '';
167 if ($h ne 'stdio') { # There's no i_stdio.
168 $prereqs = "i_$h";
169 $prereqh = "$h.h";
170 $prereqsh = "\$$prereqs $prereqh";
171 }
d63eadf0
JH
172 if ($opts{U}) {
173 print <<EOF;
10bc17b6
JH
174?RCS: \$Id: d_${f}_r.U,v $
175?RCS:
176?RCS: Copyright (c) 2002 Jarkko Hietaniemi
177?RCS:
178?RCS: You may distribute under the terms of either the GNU General Public
179?RCS: License or the Artistic License, as specified in the README file.
180?RCS:
181?RCS: Generated by the reentr.pl from the Perl 5.8 distribution.
182?RCS:
cce6a207 183?MAKE:d_${f}_r ${f}_r_proto: Inlibc Protochk Hasproto i_systypes i_systime $prereqs usethreads i_pthread
10bc17b6
JH
184?MAKE: -pick add \$@ %<
185?S:d_${f}_r:
186?S: This variable conditionally defines the HAS_${F}_R symbol,
187?S: which indicates to the C program that the ${f}_r()
188?S: routine is available.
189?S:.
190?S:${f}_r_proto:
191?S: This variable encodes the prototype of ${f}_r.
192?S:.
193?C:HAS_${F}_R:
194?C: This symbol, if defined, indicates that the ${f}_r routine
195?C: is available to ${f} re-entrantly.
196?C:.
197?C:${F}_R_PROTO:
198?C: This symbol encodes the prototype of ${f}_r.
199?C:.
200?H:#\$d_${f}_r HAS_${F}_R /**/
201?H:#define ${F}_R_PROTO \$${f}_r_proto /**/
202?H:.
a48ec845 203?T:try hdrs d_${f}_r_proto
10bc17b6
JH
204?LINT:set d_${f}_r
205?LINT:set ${f}_r_proto
206: see if ${f}_r exists
207set ${f}_r d_${f}_r
208eval \$inlibc
209case "\$d_${f}_r" in
210"\$define")
d63eadf0
JH
211EOF
212 my $hdrs = "\$i_systypes sys/types.h define stdio.h $prereqsh";
213 if ($h eq 'time') {
214 $hdrs .= " \$i_systime sys/time.h";
215 }
216 print <<EOF;
217 hdrs="$hdrs"
c18e646a
JH
218 case "\$d_${f}_r_proto:\$usethreads" in
219 ":define") d_${f}_r_proto=define
a48ec845
JH
220 set d_${f}_r_proto ${f}_r \$hdrs
221 eval \$hasproto ;;
222 *) ;;
223 esac
224 case "\$d_${f}_r_proto" in
225 define)
10bc17b6 226EOF
d63eadf0
JH
227 }
228 for my $p (@p) {
229 my ($r, $a) = ($p =~ /^(.)_(.+)/);
230 my $v = join(", ", map { $m{$_} } split '', $a);
231 if ($opts{U}) {
232 print <<EOF ;
10bc17b6
JH
233 case "\$${f}_r_proto" in
234 ''|0) try='$m{$r} ${f}_r($v);'
235 ./protochk "extern \$try" \$hdrs && ${f}_r_proto=$p ;;
236 esac
237EOF
d63eadf0
JH
238 }
239 $seenh{$f}->{$p}++;
240 push @{$seena{$f}}, $p;
241 $seenp{$p}++;
242 $seent{$f} = $t;
243 $seens{$f} = $m{S};
244 $seend{$f} = $m{D};
245 }
246 if ($opts{U}) {
247 print <<EOF;
10bc17b6 248 case "\$${f}_r_proto" in
90e831dc 249 ''|0) d_${f}_r=undef
10bc17b6 250 ${f}_r_proto=0
a48ec845 251 echo "Disabling ${f}_r, cannot determine prototype." >&4 ;;
10bc17b6
JH
252 * ) case "\$${f}_r_proto" in
253 REENTRANT_PROTO*) ;;
254 *) ${f}_r_proto="REENTRANT_PROTO_\$${f}_r_proto" ;;
255 esac
256 echo "Prototype: \$try" ;;
257 esac
258 ;;
c18e646a
JH
259 *) case "\$usethreads" in
260 define) echo "${f}_r has no prototype, not using it." >&4 ;;
261 esac
90e831dc
SB
262 d_${f}_r=undef
263 ${f}_r_proto=0
c18e646a 264 ;;
a48ec845
JH
265 esac
266 ;;
10bc17b6
JH
267*) ${f}_r_proto=0
268 ;;
269esac
270
271EOF
272 close(U);
273 }
274}
275
276close DATA;
277
278select H;
279
280{
281 my $i = 1;
282 for my $p (sort keys %seenp) {
283 print "#define REENTRANT_PROTO_${p} ${i}\n";
284 $i++;
285 }
286}
287
288sub ifprotomatch {
289 my $F = shift;
290 join " || ", map { "${F}_R_PROTO == REENTRANT_PROTO_$_" } @_;
291}
292
293my @struct;
294my @size;
295my @init;
296my @free;
297my @wrap;
298my @define;
299
300sub pushssif {
301 push @struct, @_;
302 push @size, @_;
303 push @init, @_;
304 push @free, @_;
305}
306
307sub pushinitfree {
308 my $f = shift;
309 push @init, <<EOF;
310 New(31338, PL_reentrant_buffer->_${f}_buffer, PL_reentrant_buffer->_${f}_size, char);
311EOF
312 push @free, <<EOF;
313 Safefree(PL_reentrant_buffer->_${f}_buffer);
314EOF
315}
316
317sub define {
318 my ($n, $p, @F) = @_;
319 my @H;
320 my $H = uc $F[0];
321 push @define, <<EOF;
322/* The @F using \L$n? */
323
324EOF
f7937171 325 my $G;
10bc17b6
JH
326 for my $f (@F) {
327 my $F = uc $f;
328 my $h = "${F}_R_HAS_$n";
329 push @H, $h;
330 my @h = grep { /$p/ } @{$seena{$f}};
f7937171
JH
331 unless (defined $G) {
332 $G = $F;
333 $G =~ s/^GET//;
334 }
10bc17b6 335 if (@h) {
09310450 336 push @define, "#if defined(HAS_${F}_R) && (" . join(" || ", map { "${F}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n";
10bc17b6
JH
337
338 push @define, <<EOF;
339# define $h
340#else
341# undef $h
342#endif
343EOF
344 }
345 }
346 push @define, <<EOF;
347
348/* Any of the @F using \L$n? */
349
350EOF
351 push @define, "#if (" . join(" || ", map { "defined($_)" } @H) . ")\n";
352 push @define, <<EOF;
f7937171 353# define USE_${G}_$n
10bc17b6 354#else
f7937171 355# undef USE_${G}_$n
10bc17b6
JH
356#endif
357
358EOF
359}
360
edd309b7
JH
361define('BUFFER', 'B',
362 qw(getgrent getgrgid getgrnam));
363
10bc17b6
JH
364define('PTR', 'R',
365 qw(getgrent getgrgid getgrnam));
366define('PTR', 'R',
367 qw(getpwent getpwnam getpwuid));
368define('PTR', 'R',
369 qw(getspent getspnam));
370
371define('FPTR', 'H',
f7937171 372 qw(getgrent getgrgid getgrnam setgrent endgrent));
10bc17b6 373define('FPTR', 'H',
f7937171 374 qw(getpwent getpwnam getpwuid setpwent endpwent));
10bc17b6 375
edd309b7
JH
376define('BUFFER', 'B',
377 qw(getpwent getpwgid getpwnam));
378
10bc17b6
JH
379define('PTR', 'R',
380 qw(gethostent gethostbyaddr gethostbyname));
381define('PTR', 'R',
382 qw(getnetent getnetbyaddr getnetbyname));
383define('PTR', 'R',
384 qw(getprotoent getprotobyname getprotobynumber));
385define('PTR', 'R',
386 qw(getservent getservbyname getservbyport));
387
edd309b7
JH
388define('BUFFER', 'B',
389 qw(gethostent gethostbyaddr gethostbyname));
390define('BUFFER', 'B',
391 qw(getnetent getnetbyaddr getnetbyname));
392define('BUFFER', 'B',
393 qw(getprotoent getprotobyname getprotobynumber));
394define('BUFFER', 'B',
395 qw(getservent getservbyname getservbyport));
396
10bc17b6
JH
397define('ERRNO', 'E',
398 qw(gethostent gethostbyaddr gethostbyname));
399define('ERRNO', 'E',
400 qw(getnetent getnetbyaddr getnetbyname));
401
402for my $f (@seenf) {
403 my $F = uc $f;
404 my $ifdef = "#ifdef HAS_${F}_R\n";
405 my $endif = "#endif /* HAS_${F}_R */\n";
406 if (exists $seena{$f}) {
407 my @p = @{$seena{$f}};
408 if ($f =~ /^(asctime|ctime|getlogin|setlocale|strerror|ttyname)$/) {
409 pushssif $ifdef;
410 push @struct, <<EOF;
411 char* _${f}_buffer;
412 size_t _${f}_size;
413EOF
414 push @size, <<EOF;
8695fa85 415 PL_reentrant_buffer->_${f}_size = REENTRANTSMALLSIZE;
10bc17b6
JH
416EOF
417 pushinitfree $f;
418 pushssif $endif;
419 }
b430fd04 420 elsif ($f =~ /^(crypt)$/) {
10bc17b6
JH
421 pushssif $ifdef;
422 push @struct, <<EOF;
b430fd04
JH
423#if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
424 $seend{$f} _${f}_data;
425#else
10bc17b6 426 $seent{$f} _${f}_struct;
b430fd04 427#endif
10bc17b6 428EOF
b430fd04 429 push @init, <<EOF;
10bc17b6
JH
430#ifdef __GLIBC__
431 PL_reentrant_buffer->_${f}_struct.initialized = 0;
432#endif
433EOF
b430fd04
JH
434 pushssif $endif;
435 }
436 elsif ($f =~ /^(drand48|gmtime|localtime|random)$/) {
437 pushssif $ifdef;
438 push @struct, <<EOF;
439 $seent{$f} _${f}_struct;
440EOF
10bc17b6
JH
441 if ($1 eq 'drand48') {
442 push @struct, <<EOF;
443 double _${f}_double;
444EOF
445 }
446 pushssif $endif;
447 }
448 elsif ($f =~ /^(getgrnam|getpwnam|getspnam)$/) {
449 pushssif $ifdef;
450 my $g = $f;
451 $g =~ s/nam/ent/g;
f7937171 452 $g =~ s/^get//;
10bc17b6
JH
453 my $G = uc $g;
454 push @struct, <<EOF;
455 $seent{$f} _${g}_struct;
456 char* _${g}_buffer;
457 size_t _${g}_size;
458EOF
459 push @struct, <<EOF;
460# ifdef USE_${G}_PTR
461 $seent{$f}* _${g}_ptr;
462# endif
463EOF
464 if ($g eq 'getspent') {
465 push @size, <<EOF;
466 PL_reentrant_buffer->_${g}_size = 1024;
467EOF
468 } else {
469 push @struct, <<EOF;
470# ifdef USE_${G}_FPTR
471 FILE* _${g}_fptr;
472# endif
473EOF
474 push @init, <<EOF;
475# ifdef USE_${G}_FPTR
476 PL_reentrant_buffer->_${g}_fptr = NULL;
477# endif
478EOF
479 my $sc = $g eq 'getgrent' ?
480 '_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX';
e3410746 481 my $sz = $g eq 'getgrent' ?
f7937171 482 '_grent_size' : '_pwent_size';
10bc17b6
JH
483 push @size, <<EOF;
484# if defined(HAS_SYSCONF) && defined($sc) && !defined(__GLIBC__)
485 PL_reentrant_buffer->_${g}_size = sysconf($sc);
e3410746
SR
486 if (PL_reentrant_buffer->$sz == -1)
487 PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
10bc17b6
JH
488# else
489# if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
490 PL_reentrant_buffer->_${g}_size = SIABUFSIZ;
491# else
492# ifdef __sgi
493 PL_reentrant_buffer->_${g}_size = BUFSIZ;
494# else
8695fa85 495 PL_reentrant_buffer->_${g}_size = REENTRANTUSUALSIZE;
10bc17b6
JH
496# endif
497# endif
498# endif
499EOF
500 }
501 pushinitfree $g;
502 pushssif $endif;
503 }
504 elsif ($f =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) {
505 pushssif $ifdef;
506 my $g = $f;
507 $g =~ s/byname/ent/;
f7937171 508 $g =~ s/^get//;
10bc17b6
JH
509 my $G = uc $g;
510 my $D = ifprotomatch($F, grep {/D/} @p);
511 my $d = $seend{$f};
31ee0cb7 512 $d =~ s/\*$//; # snip: we need need the base type.
10bc17b6
JH
513 push @struct, <<EOF;
514 $seent{$f} _${g}_struct;
515# if $D
516 $d _${g}_data;
517# else
518 char* _${g}_buffer;
519 size_t _${g}_size;
520# endif
521# ifdef USE_${G}_PTR
522 $seent{$f}* _${g}_ptr;
523# endif
524EOF
525 push @struct, <<EOF;
526# ifdef USE_${G}_ERRNO
527 int _${g}_errno;
528# endif
529EOF
530 push @size, <<EOF;
531#if !($D)
8695fa85 532 PL_reentrant_buffer->_${g}_size = REENTRANTUSUALSIZE;
10bc17b6
JH
533#endif
534EOF
535 push @init, <<EOF;
536#if !($D)
537 New(31338, PL_reentrant_buffer->_${g}_buffer, PL_reentrant_buffer->_${g}_size, char);
538#endif
539EOF
540 push @free, <<EOF;
541#if !($D)
542 Safefree(PL_reentrant_buffer->_${g}_buffer);
543#endif
544EOF
545 pushssif $endif;
546 }
547 elsif ($f =~ /^(readdir|readdir64)$/) {
548 pushssif $ifdef;
549 my $R = ifprotomatch($F, grep {/R/} @p);
550 push @struct, <<EOF;
551 $seent{$f}* _${f}_struct;
552 size_t _${f}_size;
553# if $R
554 $seent{$f}* _${f}_ptr;
555# endif
556EOF
557 push @size, <<EOF;
558 /* This is the size Solaris recommends.
559 * (though we go static, should use pathconf() instead) */
560 PL_reentrant_buffer->_${f}_size = sizeof($seent{$f}) + MAXPATHLEN + 1;
561EOF
562 push @init, <<EOF;
563 PL_reentrant_buffer->_${f}_struct = ($seent{$f}*)safemalloc(PL_reentrant_buffer->_${f}_size);
564EOF
565 push @free, <<EOF;
566 Safefree(PL_reentrant_buffer->_${f}_struct);
567EOF
568 pushssif $endif;
569 }
570
571 push @wrap, $ifdef;
572
10bc17b6
JH
573 push @wrap, <<EOF;
574# undef $f
575EOF
576 my @v = 'a'..'z';
577 my $v = join(", ", @v[0..$seenu{$f}-1]);
578 for my $p (@p) {
579 my ($r, $a) = split '_', $p;
580 my $test = $r eq 'I' ? ' == 0' : '';
581 my $true = 1;
10bc17b6
JH
582 my $g = $f;
583 if ($g =~ /^(?:get|set|end)(pw|gr|host|net|proto|serv|sp)/) {
f7937171 584 $g = "$1ent";
10bc17b6
JH
585 } elsif ($g eq 'srand48') {
586 $g = "drand48";
587 }
588 my $b = $a;
589 my $w = '';
590 substr($b, 0, $seenu{$f}) = '';
591 if ($b =~ /R/) {
592 $true = "PL_reentrant_buffer->_${g}_ptr";
593 } elsif ($b =~ /T/ && $f eq 'drand48') {
594 $true = "PL_reentrant_buffer->_${g}_double";
595 } elsif ($b =~ /S/) {
596 if ($f =~ /^readdir/) {
597 $true = "PL_reentrant_buffer->_${g}_struct";
598 } else {
599 $true = "&PL_reentrant_buffer->_${g}_struct";
600 }
601 } elsif ($b =~ /B/) {
602 $true = "PL_reentrant_buffer->_${g}_buffer";
603 }
604 if (length $b) {
605 $w = join ", ",
606 map {
607 $_ eq 'R' ?
608 "&PL_reentrant_buffer->_${g}_ptr" :
609 $_ eq 'E' ?
610 "&PL_reentrant_buffer->_${g}_errno" :
611 $_ eq 'B' ?
612 "PL_reentrant_buffer->_${g}_buffer" :
613 $_ =~ /^[WI]$/ ?
614 "PL_reentrant_buffer->_${g}_size" :
615 $_ eq 'H' ?
616 "&PL_reentrant_buffer->_${g}_fptr" :
617 $_ eq 'D' ?
618 "&PL_reentrant_buffer->_${g}_data" :
619 $_ eq 'S' ?
620 ($f =~ /^readdir/ ?
621 "PL_reentrant_buffer->_${g}_struct" :
622 "&PL_reentrant_buffer->_${g}_struct" ) :
623 $_ eq 'T' && $f eq 'drand48' ?
624 "&PL_reentrant_buffer->_${g}_double" :
625 $_
626 } split '', $b;
627 $w = ", $w" if length $v;
628 }
629 my $call = "${f}_r($v$w)";
630 $call = "((errno = $call))" if $r eq 'I';
631 push @wrap, <<EOF;
632# if !defined($f) && ${F}_R_PROTO == REENTRANT_PROTO_$p
633EOF
634 if ($r eq 'V' || $r eq 'B') {
635 push @wrap, <<EOF;
636# define $f($v) $call
637EOF
638 } else {
edd309b7
JH
639 if ($f =~ /^get/) {
640 my $rv = $v ? ", $v" : "";
641 push @wrap, <<EOF;
642# define $f($v) ($call$test ? $true : (errno == ERANGE ? Perl_reentrant_retry("$f"$rv) : 0))
10bc17b6 643EOF
edd309b7
JH
644 } else {
645 push @wrap, <<EOF;
646# define $f($v) ($call$test ? $true : 0)
647EOF
648 }
10bc17b6
JH
649 }
650 push @wrap, <<EOF;
651# endif
652EOF
653 }
654
655 push @wrap, $endif, "\n";
656 }
657}
658
659local $" = '';
660
661print <<EOF;
662
663/* Defines for indicating which special features are supported. */
664
665@define
666typedef struct {
667@struct
668} REENTR;
669
670/* The wrappers. */
671
672@wrap
673#endif /* USE_REENTRANT_API */
674
675#endif
676
677EOF
678
679close(H);
680
681die "reentr.c: $!" unless open(C, ">reentr.c");
682select C;
683print <<EOF;
684/*
685 * reentr.c
686 *
687 * Copyright (c) 1997-2002, Larry Wall
688 *
689 * You may distribute under the terms of either the GNU General Public
690 * License or the Artistic License, as specified in the README file.
691 *
692 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
693 * This file is built by reentrl.pl from data in reentr.pl.
694 *
695 * "Saruman," I said, standing away from him, "only one hand at a time can
696 * wield the One, and you know that well, so do not trouble to say we!"
697 *
698 */
699
700#include "EXTERN.h"
701#define PERL_IN_REENTR_C
702#include "perl.h"
703#include "reentr.h"
704
705void
706Perl_reentrant_size(pTHX) {
707#ifdef USE_REENTRANT_API
8695fa85
SR
708#define REENTRANTSMALLSIZE 256 /* Make something up. */
709#define REENTRANTUSUALSIZE 4096 /* Make something up. */
10bc17b6
JH
710@size
711#endif /* USE_REENTRANT_API */
712}
713
714void
715Perl_reentrant_init(pTHX) {
716#ifdef USE_REENTRANT_API
717 New(31337, PL_reentrant_buffer, 1, REENTR);
718 Perl_reentrant_size(aTHX);
719@init
720#endif /* USE_REENTRANT_API */
721}
722
723void
724Perl_reentrant_free(pTHX) {
725#ifdef USE_REENTRANT_API
726@free
727 Safefree(PL_reentrant_buffer);
728#endif /* USE_REENTRANT_API */
729}
730
edd309b7
JH
731void*
732Perl_reentrant_retry(const char *f, ...)
733{
734 dTHX;
735 void *retptr = NULL;
736#ifdef USE_REENTRANT_API
f7937171 737# if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SRVENT_BUFFER)
e3410746
SR
738 void *p0;
739# endif
f7937171 740# if defined(USE_SERVENT_BUFFER)
e3410746
SR
741 void *p1;
742# endif
f7937171 743# if defined(USE_HOSTENT_BUFFER)
edd309b7 744 size_t asize;
e3410746 745# endif
f7937171 746# if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
edd309b7 747 int anint;
e3410746 748# endif
edd309b7
JH
749 va_list ap;
750
751 va_start(ap, f);
752
753#define REENTRANTHALFMAXSIZE 32768 /* The maximum may end up twice this. */
754
755 switch (PL_op->op_type) {
f7937171 756#ifdef USE_HOSTENT_BUFFER
edd309b7
JH
757 case OP_GHBYADDR:
758 case OP_GHBYNAME:
759 case OP_GHOSTENT:
760 {
f7937171
JH
761 if (PL_reentrant_buffer->_hostent_size <= REENTRANTHALFMAXSIZE) {
762 PL_reentrant_buffer->_hostent_size *= 2;
763 Renew(PL_reentrant_buffer->_hostent_buffer,
764 PL_reentrant_buffer->_hostent_size, char);
edd309b7
JH
765 switch (PL_op->op_type) {
766 case OP_GHBYADDR:
767 p0 = va_arg(ap, void *);
768 asize = va_arg(ap, size_t);
769 anint = va_arg(ap, int);
770 retptr = gethostbyaddr(p0, asize, anint); break;
771 case OP_GHBYNAME:
772 p0 = va_arg(ap, void *);
773 retptr = gethostbyname(p0); break;
774 case OP_GHOSTENT:
775 retptr = gethostent(); break;
776 default:
777 break;
778 }
779 }
780 }
781 break;
782#endif
f7937171 783#ifdef USE_GRENT_BUFFER
edd309b7
JH
784 case OP_GGRNAM:
785 case OP_GGRGID:
786 case OP_GGRENT:
787 {
f7937171 788 if (PL_reentrant_buffer->_grent_size <= REENTRANTHALFMAXSIZE) {
edd309b7 789 Gid_t gid;
f7937171
JH
790 PL_reentrant_buffer->_grent_size *= 2;
791 Renew(PL_reentrant_buffer->_grent_buffer,
792 PL_reentrant_buffer->_grent_size, char);
edd309b7
JH
793 switch (PL_op->op_type) {
794 case OP_GGRNAM:
795 p0 = va_arg(ap, void *);
796 retptr = getgrnam(p0); break;
797 case OP_GGRGID:
798 gid = va_arg(ap, Gid_t);
799 retptr = getgrgid(gid); break;
800 case OP_GGRENT:
801 retptr = getgrent(); break;
802 default:
803 break;
804 }
805 }
806 }
807 break;
808#endif
f7937171 809#ifdef USE_NETENT_BUFFER
edd309b7
JH
810 case OP_GNBYADDR:
811 case OP_GNBYNAME:
812 case OP_GNETENT:
813 {
f7937171 814 if (PL_reentrant_buffer->_netent_size <= REENTRANTHALFMAXSIZE) {
edd309b7 815 Netdb_net_t net;
f7937171
JH
816 PL_reentrant_buffer->_netent_size *= 2;
817 Renew(PL_reentrant_buffer->_netent_buffer,
818 PL_reentrant_buffer->_netent_size, char);
edd309b7
JH
819 switch (PL_op->op_type) {
820 case OP_GNBYADDR:
821 net = va_arg(ap, Netdb_net_t);
822 anint = va_arg(ap, int);
823 retptr = getnetbyaddr(net, anint); break;
824 case OP_GNBYNAME:
825 p0 = va_arg(ap, void *);
826 retptr = getnetbyname(p0); break;
827 case OP_GNETENT:
828 retptr = getnetent(); break;
829 default:
830 break;
831 }
832 }
833 }
834 break;
835#endif
f7937171 836#ifdef USE_PWENT_BUFFER
edd309b7
JH
837 case OP_GPWNAM:
838 case OP_GPWUID:
839 case OP_GPWENT:
840 {
f7937171 841 if (PL_reentrant_buffer->_pwent_size <= REENTRANTHALFMAXSIZE) {
edd309b7 842 Uid_t uid;
f7937171
JH
843 PL_reentrant_buffer->_pwent_size *= 2;
844 Renew(PL_reentrant_buffer->_pwent_buffer,
845 PL_reentrant_buffer->_pwent_size, char);
edd309b7
JH
846 switch (PL_op->op_type) {
847 case OP_GPWNAM:
848 p0 = va_arg(ap, void *);
849 retptr = getpwnam(p0); break;
850 case OP_GPWUID:
851 uid = va_arg(ap, Uid_t);
852 retptr = getpwuid(uid); break;
853 case OP_GPWENT:
854 retptr = getpwent(); break;
855 default:
856 break;
857 }
858 }
859 }
860 break;
861#endif
f7937171 862#ifdef USE_PROTOENT_BUFFER
edd309b7
JH
863 case OP_GPBYNAME:
864 case OP_GPBYNUMBER:
865 case OP_GPROTOENT:
866 {
f7937171
JH
867 if (PL_reentrant_buffer->_protoent_size <= REENTRANTHALFMAXSIZE) {
868 PL_reentrant_buffer->_protoent_size *= 2;
869 Renew(PL_reentrant_buffer->_protoent_buffer,
870 PL_reentrant_buffer->_protoent_size, char);
edd309b7
JH
871 switch (PL_op->op_type) {
872 case OP_GPBYNAME:
873 p0 = va_arg(ap, void *);
874 retptr = getprotobyname(p0); break;
875 case OP_GPBYNUMBER:
876 anint = va_arg(ap, int);
877 retptr = getprotobynumber(anint); break;
878 case OP_GPROTOENT:
879 retptr = getprotoent(); break;
880 default:
881 break;
882 }
883 }
884 }
885 break;
886#endif
f7937171 887#ifdef USE_SERVENT_BUFFER
edd309b7
JH
888 case OP_GSBYNAME:
889 case OP_GSBYPORT:
890 case OP_GSERVENT:
891 {
f7937171
JH
892 if (PL_reentrant_buffer->_servent_size <= REENTRANTHALFMAXSIZE) {
893 PL_reentrant_buffer->_servent_size *= 2;
894 Renew(PL_reentrant_buffer->_servent_buffer,
895 PL_reentrant_buffer->_servent_size, char);
edd309b7
JH
896 switch (PL_op->op_type) {
897 case OP_GSBYNAME:
898 p0 = va_arg(ap, void *);
899 p1 = va_arg(ap, void *);
900 retptr = getservbyname(p0, p1); break;
901 case OP_GSBYPORT:
902 anint = va_arg(ap, int);
903 p0 = va_arg(ap, void *);
904 retptr = getservbyport(anint, p0); break;
905 case OP_GSERVENT:
906 retptr = getservent(); break;
907 default:
908 break;
909 }
910 }
911 }
912 break;
913#endif
914 default:
915 /* Not known how to retry, so just fail. */
916 break;
917 }
918
919 va_end(ap);
920#endif
921 return retptr;
922}
923
10bc17b6
JH
924EOF
925
926__DATA__
927asctime S |time |const struct tm|B_SB|B_SBI|I_SB|I_SBI
b430fd04 928crypt CC |crypt |struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
10bc17b6
JH
929ctermid B |stdio | |B_B
930ctime S |time |const time_t |B_SB|B_SBI|I_SB|I_SBI
931drand48 |stdlib |struct drand48_data |I_ST|T=double*
932endgrent |grp | |I_H|V_H
31ee0cb7
JH
933endhostent |netdb | |I_D|V_D|D=struct hostent_data*
934endnetent |netdb | |I_D|V_D|D=struct netent_data*
935endprotoent |netdb | |I_D|V_D|D=struct protoent_data*
10bc17b6 936endpwent |pwd | |I_H|V_H
31ee0cb7 937endservent |netdb | |I_D|V_D|D=struct servent_data*
10bc17b6
JH
938getgrent |grp |struct group |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
939getgrgid T |grp |struct group |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=gid_t
940getgrnam C |grp |struct group |I_CSBWR|I_CSBIR|S_CBI|I_CSBI|S_CSBI
941gethostbyaddr CWI |netdb |struct hostent |I_CWISBWRE|S_CWISBWIE|S_CWISBIE|S_TWISBIE|S_CIISBIE|S_CSBIE|S_TSBIE|I_CWISD|I_CIISD|I_CII|D=struct hostent_data*|T=const void*
942gethostbyname C |netdb |struct hostent |I_CSBWRE|S_CSBIE|I_CSD|D=struct hostent_data*
943gethostent |netdb |struct hostent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct hostent_data*
944getlogin |unistd | |I_BW|I_BI|B_BW|B_BI
945getnetbyaddr LI |netdb |struct netent |I_UISBWRE|I_LISBI|S_TISBI|S_LISBI|I_TISD|I_LISD|I_IISD|D=struct netent_data*|T=in_addr_t|U=unsigned long
946getnetbyname C |netdb |struct netent |I_CSBWRE|I_CSBI|S_CSBI|I_CSD|D=struct netent_data*
947getnetent |netdb |struct netent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct netent_data*
948getprotobyname C|netdb |struct protoent|I_CSBWR|S_CSBI|I_CSD|D=struct protoent_data*
949getprotobynumber I |netdb |struct protoent|I_ISBWR|S_ISBI|I_ISD|D=struct protoent_data*
950getprotoent |netdb |struct protoent|I_SBWR|I_SBI|S_SBI|I_SD|D=struct protoent_data*
951getpwent |pwd |struct passwd |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
952getpwnam C |pwd |struct passwd |I_CSBWR|I_CSBIR|S_CSBI|I_CSBI
953getpwuid T |pwd |struct passwd |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=uid_t
954getservbyname CC|netdb |struct servent |I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent_data*
955getservbyport IC|netdb |struct servent |I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
956getservent |netdb |struct servent |I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
957getspnam C |shadow |struct spwd |I_CSBWR|S_CSBI
958gmtime T |time |struct tm |S_TS|I_TS|T=const time_t*
959localtime T |time |struct tm |S_TS|I_TS|T=const time_t*
960random |stdlib |struct random_data|I_TS|T=int*
961readdir T |dirent |struct dirent |I_TSR|I_TS|T=DIR*
962readdir64 T |dirent |struct dirent64|I_TSR|I_TS|T=DIR*
963setgrent |grp | |I_H|V_H
964sethostent I |netdb | |I_ID|V_ID|D=struct hostent_data*
965setlocale IC |locale | |I_ICBI
966setnetent I |netdb | |I_ID|V_ID|D=struct netent_data*
967setprotoent I |netdb | |I_ID|V_ID|D=struct protoent_data*
968setpwent |pwd | |I_H|V_H
969setservent I |netdb | |I_ID|V_ID|D=struct servent_data*
970srand48 L |stdlib |struct drand48_data |I_LS
971srandom T |stdlib |struct random_data|I_TS|T=unsigned int
972strerror I |string | |I_IBW|I_IBI|B_IBW
973tmpnam B |stdio | |B_B
974ttyname I |unistd | |I_IBW|I_IBI|B_IBI