From: Jarkko Hietaniemi Date: Tue, 14 May 2002 13:21:54 +0000 (+0000) Subject: Document reentr.pl a bit better. Still rather X-Git-Tag: perl-5.8.0~889 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/aa418cf14f5423600e2de800942ca69bd80882ac Document reentr.pl a bit better. Still rather convoluted code, but it ain't broken, so... p4raw-id: //depot/perl@16590 --- diff --git a/reentr.h b/reentr.h index d72647b..4c80588 100644 --- a/reentr.h +++ b/reentr.h @@ -743,7 +743,7 @@ typedef struct { size_t _ttyname_size; #endif /* HAS_TTYNAME_R */ - int dummy; /* just in case */ + int dummy; /* cannot have empty structs */ } REENTR; /* The wrappers. */ diff --git a/reentr.pl b/reentr.pl index e8f2544..19b9852 100644 --- a/reentr.pl +++ b/reentr.pl @@ -128,29 +128,32 @@ print <) { +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 () { # 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 () { 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 <) { ?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 <{$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 <&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, <_${f}_buffer, PL_reentrant_buffer->_${f}_size, char); + New(31338, PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); EOF push @free, <_${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, <_${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, <_${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, <_${g}_size = 1024; + PL_reentrant_buffer->_${genfunc}_size = 1024; EOF } else { push @struct, <_${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, <_${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, <_${g}_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE; #endif EOF push @init, <_${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, <_${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, <_${f}_size = sizeof($seent{$f}) + MAXPATHLEN + 1; + PL_reentrant_buffer->_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1; EOF push @init, <_${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, <_${f}_struct); + Safefree(PL_reentrant_buffer->_${func}_struct); EOF pushssif $endif; } @@ -574,79 +595,82 @@ EOF push @wrap, $ifdef; push @wrap, <_${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, <reentr.c"); select C; print <