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