diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2002-05-14 13:21:54 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-05-14 13:21:54 +0000 |
commit | aa418cf14f5423600e2de800942ca69bd80882ac (patch) | |
tree | 485a611e1c584df8162edf09ef01dc33a459536a /reentr.pl | |
parent | e363f5665f8ba41ade728473b6604fb4ca4598fc (diff) | |
download | perl-aa418cf14f5423600e2de800942ca69bd80882ac.tar.gz |
Document reentr.pl a bit better. Still rather
convoluted code, but it ain't broken, so...
p4raw-id: //depot/perl@16590
Diffstat (limited to 'reentr.pl')
-rw-r--r-- | reentr.pl | 418 |
1 files changed, 222 insertions, 196 deletions
@@ -128,29 +128,32 @@ print <<EOF; EOF -my %seenh; -my %seena; -my @seenf; -my %seenp; -my %seent; -my %seens; -my %seend; -my %seenu; - -while (<DATA>) { +my %seenh; # the different prototypes signatures for this function +my %seena; # the different prototypes signatures for this function in order +my @seenf; # all the seen functions +my %seenp; # the different prototype signatures for all functions +my %seent; # the return type of this function +my %seens; # the type of this function's "S" +my %seend; # the type of this function's "D" +my %seenu; # the length of the argument list of this function + +while (<DATA>) { # Read in the protypes. next if /^\s+$/; chomp; - my ($f, $h, $t, @p) = split(/\s*\|\s*/, $_, -1); + my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1); my $u; - ($f, $u) = split(' ', $f); - $seenu{$f} = defined $u ? length $u : 0; - my $F = uc $f; - push @seenf, $f; + # Split off the real function name and the argument list. + ($func, $u) = split(' ', $func); + $seenu{$func} = defined $u ? length $u : 0; + my $FUNC = uc $func; # for output. + push @seenf, $func; my %m = %map; - if ($t) { - $m{S} = "$t*"; - $m{R} = "$t**"; + if ($type) { + $m{S} = "$type*"; + $m{R} = "$type**"; } + + # Set any special mapping variables (like X=x_t) if (@p) { while ($p[-1] =~ /=/) { my ($k, $v) = ($p[-1] =~ /^([A-Za-z])\s*=\s*(.*)/); @@ -158,27 +161,32 @@ while (<DATA>) { pop @p; } } - if ($opts{U} && open(U, ">d_${f}_r.U")) { + + # If given the -U option open up the metaconfig unit for this function. + if ($opts{U} && open(U, ">d_${func}_r.U")) { select U; } - my $prereqs = ''; - my $prereqh = ''; - my $prereqsh = ''; - if ($h ne 'stdio') { # There's no i_stdio. - $prereqs = "i_$h"; - $prereqh = "$h.h"; - $prereqsh = "\$$prereqs $prereqh"; - } + if ($opts{U}) { + # The metaconfig units needs prerequisite dependencies. + my $prereqs = ''; + my $prereqh = ''; + my $prereqsh = ''; + if ($hdr ne 'stdio') { # There's no i_stdio. + $prereqs = "i_$hdr"; + $prereqh = "$hdr.h"; + $prereqsh = "\$$prereqs $prereqh"; + } my @prereq = qw(Inlibc Protochk Hasproto i_systypes usethreads); push @prereq, $prereqs; my $hdrs = "\$i_systypes sys/types.h define stdio.h $prereqsh"; - if ($h eq 'time') { + if ($hdr eq 'time') { $hdrs .= " \$i_systime sys/time.h"; push @prereq, 'i_systime'; } + # Output the metaconfig unit header. print <<EOF; -?RCS: \$Id: d_${f}_r.U,v $ +?RCS: \$Id: d_${func}_r.U,v $ ?RCS: ?RCS: Copyright (c) 2002 Jarkko Hietaniemi ?RCS: @@ -187,44 +195,44 @@ while (<DATA>) { ?RCS: ?RCS: Generated by the reentr.pl from the Perl 5.8 distribution. ?RCS: -?MAKE:d_${f}_r ${f}_r_proto: @prereq +?MAKE:d_${func}_r ${func}_r_proto: @prereq ?MAKE: -pick add \$@ %< -?S:d_${f}_r: -?S: This variable conditionally defines the HAS_${F}_R symbol, -?S: which indicates to the C program that the ${f}_r() +?S:d_${func}_r: +?S: This variable conditionally defines the HAS_${FUNC}_R symbol, +?S: which indicates to the C program that the ${func}_r() ?S: routine is available. ?S:. -?S:${f}_r_proto: -?S: This variable encodes the prototype of ${f}_r. +?S:${func}_r_proto: +?S: This variable encodes the prototype of ${func}_r. ?S:. -?C:HAS_${F}_R: -?C: This symbol, if defined, indicates that the ${f}_r routine -?C: is available to ${f} re-entrantly. +?C:HAS_${FUNC}_R: +?C: This symbol, if defined, indicates that the ${func}_r routine +?C: is available to ${func} re-entrantly. ?C:. -?C:${F}_R_PROTO: -?C: This symbol encodes the prototype of ${f}_r. +?C:${FUNC}_R_PROTO: +?C: This symbol encodes the prototype of ${func}_r. ?C:. -?H:#\$d_${f}_r HAS_${F}_R /**/ -?H:#define ${F}_R_PROTO \$${f}_r_proto /**/ +?H:#\$d_${func}_r HAS_${FUNC}_R /**/ +?H:#define ${FUNC}_R_PROTO \$${func}_r_proto /**/ ?H:. -?T:try hdrs d_${f}_r_proto -?LINT:set d_${f}_r -?LINT:set ${f}_r_proto -: see if ${f}_r exists -set ${f}_r d_${f}_r +?T:try hdrs d_${func}_r_proto +?LINT:set d_${func}_r +?LINT:set ${func}_r_proto +: see if ${func}_r exists +set ${func}_r d_${func}_r eval \$inlibc -case "\$d_${f}_r" in +case "\$d_${func}_r" in "\$define") EOF print <<EOF; hdrs="$hdrs" - case "\$d_${f}_r_proto:\$usethreads" in - ":define") d_${f}_r_proto=define - set d_${f}_r_proto ${f}_r \$hdrs + case "\$d_${func}_r_proto:\$usethreads" in + ":define") d_${func}_r_proto=define + set d_${func}_r_proto ${func}_r \$hdrs eval \$hasproto ;; *) ;; esac - case "\$d_${f}_r_proto" in + case "\$d_${func}_r_proto" in define) EOF } @@ -233,41 +241,41 @@ EOF my $v = join(", ", map { $m{$_} } split '', $a); if ($opts{U}) { print <<EOF ; - case "\$${f}_r_proto" in - ''|0) try='$m{$r} ${f}_r($v);' - ./protochk "extern \$try" \$hdrs && ${f}_r_proto=$p ;; + case "\$${func}_r_proto" in + ''|0) try='$m{$r} ${func}_r($v);' + ./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;; esac EOF } - $seenh{$f}->{$p}++; - push @{$seena{$f}}, $p; + $seenh{$func}->{$p}++; + push @{$seena{$func}}, $p; $seenp{$p}++; - $seent{$f} = $t; - $seens{$f} = $m{S}; - $seend{$f} = $m{D}; + $seent{$func} = $type; + $seens{$func} = $m{S}; + $seend{$func} = $m{D}; } if ($opts{U}) { print <<EOF; - case "\$${f}_r_proto" in - ''|0) d_${f}_r=undef - ${f}_r_proto=0 - echo "Disabling ${f}_r, cannot determine prototype." >&4 ;; - * ) case "\$${f}_r_proto" in + case "\$${func}_r_proto" in + ''|0) d_${func}_r=undef + ${func}_r_proto=0 + echo "Disabling ${func}_r, cannot determine prototype." >&4 ;; + * ) case "\$${func}_r_proto" in REENTRANT_PROTO*) ;; - *) ${f}_r_proto="REENTRANT_PROTO_\$${f}_r_proto" ;; + *) ${func}_r_proto="REENTRANT_PROTO_\$${func}_r_proto" ;; esac echo "Prototype: \$try" ;; esac ;; *) case "\$usethreads" in - define) echo "${f}_r has no prototype, not using it." >&4 ;; + define) echo "${func}_r has no prototype, not using it." >&4 ;; esac - d_${f}_r=undef - ${f}_r_proto=0 + d_${func}_r=undef + ${func}_r_proto=0 ;; esac ;; -*) ${f}_r_proto=0 +*) ${func}_r_proto=0 ;; esac @@ -278,9 +286,12 @@ EOF close DATA; +# Prepare to continue writing the reentr.h. + select H; { + # Write out all the known prototype signatures. my $i = 1; for my $p (sort keys %seenp) { print "#define REENTRANT_PROTO_${p} ${i}\n"; @@ -288,18 +299,18 @@ select H; } } +my @struct; # REENTR struct members +my @size; # struct member buffer size initialization code +my @init; # struct member buffer initialization (malloc) code +my @free; # struct member buffer release (free) code +my @wrap; # the wrapper (foo(a) -> foo_r(a,...)) cpp code +my @define; # defines for optional features + sub ifprotomatch { - my $F = shift; - join " || ", map { "${F}_R_PROTO == REENTRANT_PROTO_$_" } @_; + my $FUNC = shift; + join " || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @_; } -my @struct; -my @size; -my @init; -my @free; -my @wrap; -my @define; - sub pushssif { push @struct, @_; push @size, @_; @@ -308,12 +319,12 @@ sub pushssif { } sub pushinitfree { - my $f = shift; + my $func = shift; push @init, <<EOF; - New(31338, PL_reentrant_buffer->_${f}_buffer, PL_reentrant_buffer->_${f}_size, char); + New(31338, PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); EOF push @free, <<EOF; - Safefree(PL_reentrant_buffer->_${f}_buffer); + Safefree(PL_reentrant_buffer->_${func}_buffer); EOF } @@ -325,23 +336,23 @@ sub define { /* The @F using \L$n? */ EOF - my $G; - for my $f (@F) { - my $F = uc $f; - my $h = "${F}_R_HAS_$n"; - push @H, $h; - my @h = grep { /$p/ } @{$seena{$f}}; - unless (defined $G) { - $G = $F; - $G =~ s/^GET//; + my $GENFUNC; + for my $func (@F) { + my $FUNC = uc $func; + my $HAS = "${FUNC}_R_HAS_$n"; + push @H, $HAS; + my @h = grep { /$p/ } @{$seena{$func}}; + unless (defined $GENFUNC) { + $GENFUNC = $FUNC; + $GENFUNC =~ s/^GET//; } if (@h) { - push @define, "#if defined(HAS_${F}_R) && (" . join(" || ", map { "${F}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n"; + push @define, "#if defined(HAS_${FUNC}_R) && (" . join(" || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n"; push @define, <<EOF; -# define $h +# define $HAS #else -# undef $h +# undef $HAS #endif EOF } @@ -353,9 +364,9 @@ EOF EOF push @define, "#if (" . join(" || ", map { "defined($_)" } @H) . ")\n"; push @define, <<EOF; -# define USE_${G}_$n +# define USE_${GENFUNC}_$n #else -# undef USE_${G}_$n +# undef USE_${GENFUNC}_$n #endif EOF @@ -402,171 +413,181 @@ define('ERRNO', 'E', define('ERRNO', 'E', qw(getnetent getnetbyaddr getnetbyname)); -for my $f (@seenf) { - my $F = uc $f; - my $ifdef = "#ifdef HAS_${F}_R\n"; - my $endif = "#endif /* HAS_${F}_R */\n"; - if (exists $seena{$f}) { - my @p = @{$seena{$f}}; - if ($f =~ /^(asctime|ctime|getlogin|setlocale|strerror|ttyname)$/) { +# The following loop accumulates the "ssif" (struct, size, init, free) +# sections that declare the struct members (in reentr.h), and the buffer +# size initialization, buffer initialization (malloc), and buffer +# release (free) code (in reentr.c). +# +# The loop also contains a lot of intrinsic logic about groups of +# functions (since functions of certain kind operate the same way). + +for my $func (@seenf) { + my $FUNC = uc $func; + my $ifdef = "#ifdef HAS_${FUNC}_R\n"; + my $endif = "#endif /* HAS_${FUNC}_R */\n"; + if (exists $seena{$func}) { + my @p = @{$seena{$func}}; + if ($func =~ /^(asctime|ctime|getlogin|setlocale|strerror|ttyname)$/) { pushssif $ifdef; push @struct, <<EOF; - char* _${f}_buffer; - size_t _${f}_size; + char* _${func}_buffer; + size_t _${func}_size; EOF push @size, <<EOF; - PL_reentrant_buffer->_${f}_size = REENTRANTSMALLSIZE; + PL_reentrant_buffer->_${func}_size = REENTRANTSMALLSIZE; EOF - pushinitfree $f; + pushinitfree $func; pushssif $endif; } - elsif ($f =~ /^(crypt)$/) { + elsif ($func =~ /^(crypt)$/) { pushssif $ifdef; push @struct, <<EOF; #if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD - $seend{$f} _${f}_data; + $seend{$func} _${func}_data; #else - $seent{$f} _${f}_struct; + $seent{$func} _${func}_struct; #endif EOF push @init, <<EOF; #ifdef __GLIBC__ - PL_reentrant_buffer->_${f}_struct.initialized = 0; + PL_reentrant_buffer->_${func}_struct.initialized = 0; #endif EOF pushssif $endif; } - elsif ($f =~ /^(drand48|gmtime|localtime|random)$/) { + elsif ($func =~ /^(drand48|gmtime|localtime|random)$/) { pushssif $ifdef; push @struct, <<EOF; - $seent{$f} _${f}_struct; + $seent{$func} _${func}_struct; EOF if ($1 eq 'drand48') { push @struct, <<EOF; - double _${f}_double; + double _${func}_double; EOF } pushssif $endif; } - elsif ($f =~ /^(getgrnam|getpwnam|getspnam)$/) { + elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) { pushssif $ifdef; - my $g = $f; - $g =~ s/nam/ent/g; - $g =~ s/^get//; - my $G = uc $g; + # 'genfunc' can be read either as 'generic' or 'genre', + # it represents a group of functions. + my $genfunc = $func; + $genfunc =~ s/nam/ent/g; + $genfunc =~ s/^get//; + my $GENFUNC = uc $genfunc; push @struct, <<EOF; - $seent{$f} _${g}_struct; - char* _${g}_buffer; - size_t _${g}_size; + $seent{$func} _${genfunc}_struct; + char* _${genfunc}_buffer; + size_t _${genfunc}_size; EOF push @struct, <<EOF; -# ifdef USE_${G}_PTR - $seent{$f}* _${g}_ptr; +# ifdef USE_${GENFUNC}_PTR + $seent{$func}* _${genfunc}_ptr; # endif EOF - if ($g eq 'getspent') { + if ($genfunc eq 'getspent') { push @size, <<EOF; - PL_reentrant_buffer->_${g}_size = 1024; + PL_reentrant_buffer->_${genfunc}_size = 1024; EOF } else { push @struct, <<EOF; -# ifdef USE_${G}_FPTR - FILE* _${g}_fptr; +# ifdef USE_${GENFUNC}_FPTR + FILE* _${genfunc}_fptr; # endif EOF push @init, <<EOF; -# ifdef USE_${G}_FPTR - PL_reentrant_buffer->_${g}_fptr = NULL; +# ifdef USE_${GENFUNC}_FPTR + PL_reentrant_buffer->_${genfunc}_fptr = NULL; # endif EOF - my $sc = $g eq 'getgrent' ? + my $sc = $genfunc eq 'getgrent' ? '_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX'; - my $sz = $g eq 'getgrent' ? + my $sz = $genfunc eq 'getgrent' ? '_grent_size' : '_pwent_size'; push @size, <<EOF; # if defined(HAS_SYSCONF) && defined($sc) && !defined(__GLIBC__) - PL_reentrant_buffer->_${g}_size = sysconf($sc); + PL_reentrant_buffer->_${genfunc}_size = sysconf($sc); if (PL_reentrant_buffer->$sz == -1) PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # else # if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) - PL_reentrant_buffer->_${g}_size = SIABUFSIZ; + PL_reentrant_buffer->_${genfunc}_size = SIABUFSIZ; # else # ifdef __sgi - PL_reentrant_buffer->_${g}_size = BUFSIZ; + PL_reentrant_buffer->_${genfunc}_size = BUFSIZ; # else - PL_reentrant_buffer->_${g}_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE; # endif # endif # endif EOF } - pushinitfree $g; + pushinitfree $genfunc; pushssif $endif; } - elsif ($f =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) { + elsif ($func =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) { pushssif $ifdef; - my $g = $f; - $g =~ s/byname/ent/; - $g =~ s/^get//; - my $G = uc $g; - my $D = ifprotomatch($F, grep {/D/} @p); - my $d = $seend{$f}; + my $genfunc = $func; + $genfunc =~ s/byname/ent/; + $genfunc =~ s/^get//; + my $GENFUNC = uc $genfunc; + my $D = ifprotomatch($FUNC, grep {/D/} @p); + my $d = $seend{$func}; $d =~ s/\*$//; # snip: we need need the base type. push @struct, <<EOF; - $seent{$f} _${g}_struct; + $seent{$func} _${genfunc}_struct; # if $D - $d _${g}_data; + $d _${genfunc}_data; # else - char* _${g}_buffer; - size_t _${g}_size; + char* _${genfunc}_buffer; + size_t _${genfunc}_size; # endif -# ifdef USE_${G}_PTR - $seent{$f}* _${g}_ptr; +# ifdef USE_${GENFUNC}_PTR + $seent{$func}* _${genfunc}_ptr; # endif EOF push @struct, <<EOF; -# ifdef USE_${G}_ERRNO - int _${g}_errno; +# ifdef USE_${GENFUNC}_ERRNO + int _${genfunc}_errno; # endif EOF push @size, <<EOF; #if !($D) - PL_reentrant_buffer->_${g}_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE; #endif EOF push @init, <<EOF; #if !($D) - New(31338, PL_reentrant_buffer->_${g}_buffer, PL_reentrant_buffer->_${g}_size, char); + New(31338, PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); #endif EOF push @free, <<EOF; #if !($D) - Safefree(PL_reentrant_buffer->_${g}_buffer); + Safefree(PL_reentrant_buffer->_${genfunc}_buffer); #endif EOF pushssif $endif; } - elsif ($f =~ /^(readdir|readdir64)$/) { + elsif ($func =~ /^(readdir|readdir64)$/) { pushssif $ifdef; - my $R = ifprotomatch($F, grep {/R/} @p); + my $R = ifprotomatch($FUNC, grep {/R/} @p); push @struct, <<EOF; - $seent{$f}* _${f}_struct; - size_t _${f}_size; + $seent{$func}* _${func}_struct; + size_t _${func}_size; # if $R - $seent{$f}* _${f}_ptr; + $seent{$func}* _${func}_ptr; # endif EOF push @size, <<EOF; /* This is the size Solaris recommends. * (though we go static, should use pathconf() instead) */ - PL_reentrant_buffer->_${f}_size = sizeof($seent{$f}) + MAXPATHLEN + 1; + PL_reentrant_buffer->_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1; EOF push @init, <<EOF; - PL_reentrant_buffer->_${f}_struct = ($seent{$f}*)safemalloc(PL_reentrant_buffer->_${f}_size); + PL_reentrant_buffer->_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size); EOF push @free, <<EOF; - Safefree(PL_reentrant_buffer->_${f}_struct); + Safefree(PL_reentrant_buffer->_${func}_struct); EOF pushssif $endif; } @@ -574,79 +595,82 @@ EOF push @wrap, $ifdef; push @wrap, <<EOF; -# undef $f +# undef $func EOF + + # Write out what we have learned. + my @v = 'a'..'z'; - my $v = join(", ", @v[0..$seenu{$f}-1]); + my $v = join(", ", @v[0..$seenu{$func}-1]); for my $p (@p) { my ($r, $a) = split '_', $p; my $test = $r eq 'I' ? ' == 0' : ''; my $true = 1; - my $g = $f; - if ($g =~ /^(?:get|set|end)(pw|gr|host|net|proto|serv|sp)/) { - $g = "$1ent"; - } elsif ($g eq 'srand48') { - $g = "drand48"; + my $genfunc = $func; + if ($genfunc =~ /^(?:get|set|end)(pw|gr|host|net|proto|serv|sp)/) { + $genfunc = "${1}ent"; + } elsif ($genfunc eq 'srand48') { + $genfunc = "drand48"; } my $b = $a; my $w = ''; - substr($b, 0, $seenu{$f}) = ''; + substr($b, 0, $seenu{$func}) = ''; if ($b =~ /R/) { - $true = "PL_reentrant_buffer->_${g}_ptr"; - } elsif ($b =~ /T/ && $f eq 'drand48') { - $true = "PL_reentrant_buffer->_${g}_double"; + $true = "PL_reentrant_buffer->_${genfunc}_ptr"; + } elsif ($b =~ /T/ && $func eq 'drand48') { + $true = "PL_reentrant_buffer->_${genfunc}_double"; } elsif ($b =~ /S/) { - if ($f =~ /^readdir/) { - $true = "PL_reentrant_buffer->_${g}_struct"; + if ($func =~ /^readdir/) { + $true = "PL_reentrant_buffer->_${genfunc}_struct"; } else { - $true = "&PL_reentrant_buffer->_${g}_struct"; + $true = "&PL_reentrant_buffer->_${genfunc}_struct"; } } elsif ($b =~ /B/) { - $true = "PL_reentrant_buffer->_${g}_buffer"; + $true = "PL_reentrant_buffer->_${genfunc}_buffer"; } if (length $b) { $w = join ", ", map { $_ eq 'R' ? - "&PL_reentrant_buffer->_${g}_ptr" : + "&PL_reentrant_buffer->_${genfunc}_ptr" : $_ eq 'E' ? - "&PL_reentrant_buffer->_${g}_errno" : + "&PL_reentrant_buffer->_${genfunc}_errno" : $_ eq 'B' ? - "PL_reentrant_buffer->_${g}_buffer" : + "PL_reentrant_buffer->_${genfunc}_buffer" : $_ =~ /^[WI]$/ ? - "PL_reentrant_buffer->_${g}_size" : + "PL_reentrant_buffer->_${genfunc}_size" : $_ eq 'H' ? - "&PL_reentrant_buffer->_${g}_fptr" : + "&PL_reentrant_buffer->_${genfunc}_fptr" : $_ eq 'D' ? - "&PL_reentrant_buffer->_${g}_data" : + "&PL_reentrant_buffer->_${genfunc}_data" : $_ eq 'S' ? - ($f =~ /^readdir/ ? - "PL_reentrant_buffer->_${g}_struct" : - "&PL_reentrant_buffer->_${g}_struct" ) : - $_ eq 'T' && $f eq 'drand48' ? - "&PL_reentrant_buffer->_${g}_double" : + ($func =~ /^readdir/ ? + "PL_reentrant_buffer->_${genfunc}_struct" : + "&PL_reentrant_buffer->_${genfunc}_struct" ) : + $_ eq 'T' && $func eq 'drand48' ? + "&PL_reentrant_buffer->_${genfunc}_double" : $_ } split '', $b; $w = ", $w" if length $v; } - my $call = "${f}_r($v$w)"; + my $call = "${func}_r($v$w)"; $call = "((errno = $call))" if $r eq 'I'; push @wrap, <<EOF; -# if !defined($f) && ${F}_R_PROTO == REENTRANT_PROTO_$p +# if !defined($func) && ${FUNC}_R_PROTO == REENTRANT_PROTO_$p EOF if ($r eq 'V' || $r eq 'B') { push @wrap, <<EOF; -# define $f($v) $call +# define $func($v) $call EOF } else { - if ($f =~ /^get/) { + if ($func =~ /^get/) { my $rv = $v ? ", $v" : ""; push @wrap, <<EOF; -# define $f($v) ($call$test ? $true : (errno == ERANGE ? Perl_reentrant_retry("$f"$rv) : 0)) +# define $func($v) ($call$test ? $true : (errno == ERANGE ? Perl_reentrant_retry("$func"$rv) : 0)) EOF } else { push @wrap, <<EOF; -# define $f($v) ($call$test ? $true : 0) +# define $func($v) ($call$test ? $true : 0) EOF } } @@ -668,7 +692,7 @@ print <<EOF; @define typedef struct { @struct - int dummy; /* just in case */ + int dummy; /* cannot have empty structs */ } REENTR; /* The wrappers. */ @@ -682,6 +706,8 @@ EOF close(H); +# Prepare to write the reentr.c. + die "reentr.c: $!" unless open(C, ">reentr.c"); select C; print <<EOF; |