X-Git-Url: https://git.openssl.org/?p=openssl.git;a=blobdiff_plain;f=util%2Fmkdef.pl;h=071036a6d2caf6b67540cc16399512f12626a86b;hp=6d0f2cdc024570a319e2f43a0d0ac25caaa4591d;hb=6f9079fd505c28961049a732e33e662530bdad21;hpb=eb64730b9cb6fe9cb5bfa4b0b54bf8c9193ced2b diff --git a/util/mkdef.pl b/util/mkdef.pl index 6d0f2cdc02..071036a6d2 100755 --- a/util/mkdef.pl +++ b/util/mkdef.pl @@ -37,34 +37,38 @@ # - "platforms" is empty if it exists on all platforms, otherwise it contains # comma-separated list of the platform, just as they are if the symbol exists # for those platforms, or prepended with a "!" if not. This helps resolve -# symbol name replacements for platforms where the names are too long for the +# symbol name variants for platforms where the names are too long for the # compiler or linker, or if the systems is case insensitive and there is a -# clash. This script assumes those redefinitions are place in the file -# crypto/symhacks.h. -# The semantics for the platforms list is a bit complicated. The rule of -# thumb is that the list is exclusive, but it seems to mean different things. -# So, if the list is all negatives (like "!VMS,!WIN16"), the symbol exists -# on all platforms except those listed. If the list is all positives (like -# "VMS,WIN16"), the symbol exists only on those platforms and nowhere else. -# The combination of positives and negatives will act as if the positives -# weren't there. +# clash, or the symbol is implemented differently (see +# EXPORT_VAR_AS_FUNCTION). This script assumes renaming of symbols is found +# in the file crypto/symhacks.h. +# The semantics for the platforms is that every item is checked against the +# enviroment. For the negative items ("!FOO"), if any of them is false +# (i.e. "FOO" is true) in the enviroment, the corresponding symbol can't be +# used. For the positive itms, if all of them are false in the environment, +# the corresponding symbol can't be used. Any combination of positive and +# negative items are possible, and of course leave room for some redundancy. # - "kind" is "FUNCTION" or "VARIABLE". The meaning of that is obvious. # - "algorithms" is a comma-separated list of algorithm names. This helps # exclude symbols that are part of an algorithm that some user wants to # exclude. # +my $debug=0; + my $crypto_num= "util/libeay.num"; my $ssl_num= "util/ssleay.num"; my $do_update = 0; -my $do_rewrite = 0; +my $do_rewrite = 1; my $do_crypto = 0; my $do_ssl = 0; my $do_ctest = 0; my $do_ctestall = 0; -my $rsaref = 0; +my $do_checkexist = 0; +my $VMSVAX=0; +my $VMSAlpha=0; my $VMS=0; my $W32=0; my $W16=0; @@ -72,11 +76,20 @@ my $NT=0; # Set this to make typesafe STACK definitions appear in DEF my $safe_stack_def = 0; -my @known_platforms = ( "__FreeBSD__", "VMS", "WIN16", "WIN32", - "WINNT", "PERL5", "NeXT" ); +my @known_platforms = ( "__FreeBSD__", "PERL5", "NeXT", + "EXPORT_VAR_AS_FUNCTION" ); +my @known_ossl_platforms = ( "VMS", "WIN16", "WIN32", "WINNT" ); my @known_algorithms = ( "RC2", "RC4", "RC5", "IDEA", "DES", "BF", - "CAST", "MD2", "MD4", "MD5", "SHA", "RIPEMD", - "MDC2", "RSA", "DSA", "DH", "HMAC", "FP_API" ); + "CAST", "MD2", "MD4", "MD5", "SHA", "SHA0", "SHA1", + "RIPEMD", + "MDC2", "RSA", "DSA", "DH", "EC", "HMAC", "AES", + # Envelope "algorithms" + "EVP", "X509", "ASN1_TYPEDEFS", + # Helper "algorithms" + "BIO", "COMP", "BUFFER", "LHASH", "STACK", "ERR", + "LOCKING", + # External "algorithms" + "FP_API", "STDIO", "SOCK", "KRB5" ); my $options=""; open(IN,"$ssl_num"); &rewrite_numbers(*OUT,"SSLEAY",*ssl_list,@ssl_symbols); - close OUT; } else { open(OUT, ">>$ssl_num"); } @@ -239,6 +279,11 @@ if($do_crypto == 1) { close OUT; } +} elsif ($do_checkexist) { + &check_existing(*ssl_list, @ssl_symbols) + if $do_ssl == 1; + &check_existing(*crypto_list, @crypto_symbols) + if $do_crypto == 1; } elsif ($do_ctest || $do_ctestall) { print <<"EOF"; @@ -278,16 +323,21 @@ sub do_defs my %platform; # For anything undefined, we assume "" my %kind; # For anything undefined, we assume "FUNCTION" my %algorithm; # For anything undefined, we assume "" - my %rename; + my %variant; + my %variant_cnt; # To be able to allocate "name{n}" if "name" + # is the same name as the original. my $cpp; + my %unknown_algorithms = (); foreach $file (split(/\s+/,$symhacksfile." ".$files)) { + print STDERR "DEBUG: starting on $file:\n" if $debug; open(IN,"<$file") || die "unable to open $file:$!\n"; my $line = "", my $def= ""; my %tag = ( (map { $_ => 0 } @known_platforms), - (map { "NO_".$_ => 0 } @known_algorithms), + (map { "OPENSSL_SYS_".$_ => 0 } @known_ossl_platforms), + (map { "OPENSSL_NO_".$_ => 0 } @known_algorithms), NOPROTO => 0, PERL5 => 0, _WINDLL => 0, @@ -295,14 +345,70 @@ sub do_defs TRUE => 1, ); my $symhacking = $file eq $symhacksfile; + my @current_platforms = (); + my @current_algorithms = (); + + # params: symbol, alias, platforms, kind + # The reason to put this subroutine in a variable is that + # it will otherwise create it's own, unshared, version of + # %tag and %variant... + my $make_variant = sub + { + my ($s, $a, $p, $k) = @_; + my ($a1, $a2); + + print STDERR "DEBUG: make_variant: Entered with ",$s,", ",$a,", ",(defined($p)?$p:""),", ",(defined($k)?$k:""),"\n" if $debug; + if (defined($p)) + { + $a1 = join(",",$p, + grep(!/^$/, + map { $tag{$_} == 1 ? $_ : "" } + @known_platforms)); + } + else + { + $a1 = join(",", + grep(!/^$/, + map { $tag{$_} == 1 ? $_ : "" } + @known_platforms)); + } + $a2 = join(",", + grep(!/^$/, + map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : "" } + @known_ossl_platforms)); + print STDERR "DEBUG: make_variant: a1 = $a1; a2 = $a2\n" if $debug; + if ($a1 eq "") { $a1 = $a2; } + elsif ($a1 ne "" && $a2 ne "") { $a1 .= ",".$a2; } + if ($a eq $s) + { + if (!defined($variant_cnt{$s})) + { + $variant_cnt{$s} = 0; + } + $variant_cnt{$s}++; + $a .= "{$variant_cnt{$s}}"; + } + my $toadd = $a.":".$a1.(defined($k)?":".$k:""); + my $togrep = $s.'(\{[0-9]+\})?:'.$a1.(defined($k)?":".$k:""); + if (!grep(/^$togrep$/, + split(/;/, defined($variant{$s})?$variant{$s}:""))) { + if (defined($variant{$s})) { $variant{$s} .= ";"; } + $variant{$s} .= $toadd; + } + print STDERR "DEBUG: make_variant: Exit with variant of ",$s," = ",$variant{$s},"\n" if $debug; + }; + + print STDERR "DEBUG: parsing ----------\n" if $debug; while() { - last if (/BEGIN ERROR CODES/); + last if (/\/\* Error codes for the \w+ functions\. \*\//); if ($line ne '') { $_ = $line . $_; $line = ''; } if (/\\$/) { + chomp; # remove eol + chop; # remove ending backslash $line = $_; next; } @@ -315,134 +421,344 @@ sub do_defs s/\/\*.*?\*\///gs; # ignore comments s/{[^{}]*}//gs; # ignore {} blocks - if (/^\#\s*ifndef (.*)/) { + print STDERR "DEBUG: \$_=\"$_\"\n" if $debug; + if (/^\#\s*ifndef\s+(.*)/) { + push(@tag,"-"); push(@tag,$1); $tag{$1}=-1; - } elsif (/^\#\s*if !defined\(([^\)]+)\)/) { - push(@tag,$1); - $tag{$1}=-1; - } elsif (/^\#\s*ifdef (.*)/) { - push(@tag,$1); - $tag{$1}=1; - } elsif (/^\#\s*if defined\(([^\)]+)\)/) { + print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug; + } elsif (/^\#\s*if\s+!defined\(([^\)]+)\)/) { + push(@tag,"-"); + if (/^\#\s*if\s+(!defined\(([^\)]+)\)(\s+\&\&\s+!defined\(([^\)]+)\))*)$/) { + my $tmp_1 = $1; + my $tmp_; + foreach $tmp_ (split '\&\&',$tmp_1) { + $tmp_ =~ /!defined\(([^\)]+)\)/; + print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug; + push(@tag,$1); + $tag{$1}=-1; + } + } else { + print STDERR "Warning: $file: complicated expression: $_" if $debug; # because it is O... + print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug; + push(@tag,$1); + $tag{$1}=-1; + } + } elsif (/^\#\s*ifdef\s+(.*)/) { + push(@tag,"-"); push(@tag,$1); $tag{$1}=1; + print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug; + } elsif (/^\#\s*if\s+defined\(([^\)]+)\)/) { + push(@tag,"-"); + if (/^\#\s*if\s+(defined\(([^\)]+)\)(\s+\|\|\s+defined\(([^\)]+)\))*)$/) { + my $tmp_1 = $1; + my $tmp_; + foreach $tmp_ (split '\|\|',$tmp_1) { + $tmp_ =~ /defined\(([^\)]+)\)/; + print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug; + push(@tag,$1); + $tag{$1}=1; + } + } else { + print STDERR "Warning: $file: complicated expression: $_\n" if $debug; # because it is O... + print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug; + push(@tag,$1); + $tag{$1}=1; + } } elsif (/^\#\s*error\s+(\w+) is disabled\./) { - if ($tag[$#tag] eq "NO_".$1) { - $tag{$tag[$#tag]}=2; + my $tag_i = $#tag; + while($tag[$tag_i] ne "-") { + if ($tag[$tag_i] eq "OPENSSL_NO_".$1) { + $tag{$tag[$tag_i]}=2; + print STDERR "DEBUG: $file: chaged tag $1 = 2\n" if $debug; + } + $tag_i--; } } elsif (/^\#\s*endif/) { - if ($tag{$tag[$#tag]}==2) { - $tag{$tag[$#tag]}=-1; - } else { - $tag{$tag[$#tag]}=0; + my $tag_i = $#tag; + while($tag[$tag_i] ne "-") { + my $t=$tag[$tag_i]; + print STDERR "DEBUG: \$t=\"$t\"\n" if $debug; + if ($tag{$t}==2) { + $tag{$t}=-1; + } else { + $tag{$t}=0; + } + print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug; + pop(@tag); + if ($t =~ /^OPENSSL_NO_([A-Z0-9_]+)$/) { + $t=$1; + } else { + $t=""; + } + if ($t ne "" + && !grep(/^$t$/, @known_algorithms)) { + $unknown_algorithms{$t} = 1; + #print STDERR "DEBUG: Added as unknown algorithm: $t\n" if $debug; + } + $tag_i--; } pop(@tag); } elsif (/^\#\s*else/) { - my $t=$tag[$#tag]; - $tag{$t}= -$tag{$t}; + my $tag_i = $#tag; + while($tag[$tag_i] ne "-") { + my $t=$tag[$tag_i]; + $tag{$t}= -$tag{$t}; + print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug; + $tag_i--; + } } elsif (/^\#\s*if\s+1/) { + push(@tag,"-"); # Dummy tag push(@tag,"TRUE"); $tag{"TRUE"}=1; + print STDERR "DEBUG: $file: found 1\n" if $debug; } elsif (/^\#\s*if\s+0/) { + push(@tag,"-"); # Dummy tag push(@tag,"TRUE"); $tag{"TRUE"}=-1; + print STDERR "DEBUG: $file: found 0\n" if $debug; } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/ - && $symhacking) { - my $s = $1; - my $a = - $2.":".join(",", grep(!/^$/, - map { $tag{$_} == 1 ? - $_ : "" } - @known_platforms)); - $rename{$s} = $a; + && $symhacking && $tag{'TRUE'} != -1) { + # This is for aliasing. When we find an alias, + # we have to invert + &$make_variant($1,$2); + print STDERR "DEBUG: $file: defined $1 = $2\n" if $debug; } if (/^\#/) { - my @p = grep(!/^$/, - map { $tag{$_} == 1 ? $_ : - $tag{$_} == -1 ? "!".$_ : "" } - @known_platforms); - my @a = grep(!/^$/, - map { $tag{"NO_".$_} == -1 ? $_ : "" } - @known_algorithms); - $def .= "#INFO:".join(',',@p).":".join(',',@a).";"; + @current_platforms = + grep(!/^$/, + map { $tag{$_} == 1 ? $_ : + $tag{$_} == -1 ? "!".$_ : "" } + @known_platforms); + push @current_platforms + , grep(!/^$/, + map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : + $tag{"OPENSSL_SYS_".$_} == -1 ? "!".$_ : "" } + @known_ossl_platforms); + @current_algorithms = + grep(!/^$/, + map { $tag{"OPENSSL_NO_".$_} == -1 ? $_ : "" } + @known_algorithms); + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; next; } - if (/^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) { - next; - } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) { - next; - } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) { - next; - } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || - /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ) { - # Things not in Win16 - $syms{"PEM_read_${1}"} = 1; - $platform{"PEM_read_${1}"} = "!WIN16"; - $syms{"PEM_write_${1}"} = 1; - $platform{"PEM_write_${1}"} = "!WIN16"; - # Things that are everywhere - $syms{"PEM_read_bio_${1}"} = 1; - $syms{"PEM_write_bio_${1}"} = 1; - if ($1 eq "RSAPrivateKey" || - $1 eq "RSAPublicKey" || - $1 eq "RSA_PUBKEY") { - $algorithm{"PEM_read_${1}"} = "RSA"; - $algorithm{"PEM_write_${1}"} = "RSA"; - $algorithm{"PEM_read_bio_${1}"} = "RSA"; - $algorithm{"PEM_write_bio_${1}"} = "RSA"; - } - elsif ($1 eq "DSAPrivateKey" || - $1 eq "DSAparams" || - $1 eq "RSA_PUBKEY") { - $algorithm{"PEM_read_${1}"} = "DSA"; - $algorithm{"PEM_write_${1}"} = "DSA"; - $algorithm{"PEM_read_bio_${1}"} = "DSA"; - $algorithm{"PEM_write_bio_${1}"} = "DSA"; - } - elsif ($1 eq "DHparams") { - $algorithm{"PEM_read_${1}"} = "DH"; - $algorithm{"PEM_write_${1}"} = "DH"; - $algorithm{"PEM_read_bio_${1}"} = "DH"; - $algorithm{"PEM_write_bio_${1}"} = "DH"; - } - } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || - /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { - # Things not in Win16 - $syms{"PEM_write_${1}"} = 1; - $platform{"PEM_write_${1}"} .= ",!WIN16"; - # Things that are everywhere - $syms{"PEM_write_bio_${1}"} = 1; - if ($1 eq "RSAPrivateKey" || - $1 eq "RSAPublicKey" || - $1 eq "RSA_PUBKEY") { - $algorithm{"PEM_write_${1}"} = "RSA"; - $algorithm{"PEM_write_bio_${1}"} = "RSA"; - } - elsif ($1 eq "DSAPrivateKey" || - $1 eq "DSAparams" || - $1 eq "RSA_PUBKEY") { - $algorithm{"PEM_write_${1}"} = "DSA"; - $algorithm{"PEM_write_bio_${1}"} = "DSA"; - } - elsif ($1 eq "DHparams") { - $algorithm{"PEM_write_${1}"} = "DH"; - $algorithm{"PEM_write_bio_${1}"} = "DH"; - } - } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || - /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { - # Things not in Win16 - $syms{"PEM_read_${1}"} = 1; - $platform{"PEM_read_${1}"} .= ",!WIN16"; - # Things that are everywhere - $syms{"PEM_read_bio_${1}"} = 1; - } elsif ( - ($tag{'TRUE'} != -1) - && ($tag{'CONST_STRICT'} != 1) - ) - { + if ($tag{'TRUE'} != -1) { + if (/^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) { + next; + } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) { + $def .= "int d2i_$3(void);"; + $def .= "int i2d_$3(void);"; + # Variant for platforms that do not + # have to access globale variables + # in shared libraries through functions + $def .= + "#INFO:" + .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "OPENSSL_EXTERN int $2_it;"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Variant for platforms that have to + # access globale variables in shared + # libraries through functions + &$make_variant("$2_it","$2_it", + "EXPORT_VAR_AS_FUNCTION", + "FUNCTION"); + next; + } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_fname\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) { + $def .= "int d2i_$3(void);"; + $def .= "int i2d_$3(void);"; + $def .= "int $3_free(void);"; + $def .= "int $3_new(void);"; + # Variant for platforms that do not + # have to access globale variables + # in shared libraries through functions + $def .= + "#INFO:" + .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "OPENSSL_EXTERN int $2_it;"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Variant for platforms that have to + # access globale variables in shared + # libraries through functions + &$make_variant("$2_it","$2_it", + "EXPORT_VAR_AS_FUNCTION", + "FUNCTION"); + next; + } elsif (/^\s*DECLARE_ASN1_FUNCTIONS\s*\(\s*(\w*)\s*\)/ || + /^\s*DECLARE_ASN1_FUNCTIONS_const\s*\(\s*(\w*)\s*\)/) { + $def .= "int d2i_$1(void);"; + $def .= "int i2d_$1(void);"; + $def .= "int $1_free(void);"; + $def .= "int $1_new(void);"; + # Variant for platforms that do not + # have to access globale variables + # in shared libraries through functions + $def .= + "#INFO:" + .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "OPENSSL_EXTERN int $1_it;"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Variant for platforms that have to + # access globale variables in shared + # libraries through functions + &$make_variant("$1_it","$1_it", + "EXPORT_VAR_AS_FUNCTION", + "FUNCTION"); + next; + } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS_const\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) { + $def .= "int d2i_$2(void);"; + $def .= "int i2d_$2(void);"; + # Variant for platforms that do not + # have to access globale variables + # in shared libraries through functions + $def .= + "#INFO:" + .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "OPENSSL_EXTERN int $2_it;"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Variant for platforms that have to + # access globale variables in shared + # libraries through functions + &$make_variant("$2_it","$2_it", + "EXPORT_VAR_AS_FUNCTION", + "FUNCTION"); + next; + } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) { + $def .= "int d2i_$2(void);"; + $def .= "int i2d_$2(void);"; + $def .= "int $2_free(void);"; + $def .= "int $2_new(void);"; + # Variant for platforms that do not + # have to access globale variables + # in shared libraries through functions + $def .= + "#INFO:" + .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "OPENSSL_EXTERN int $2_it;"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Variant for platforms that have to + # access globale variables in shared + # libraries through functions + &$make_variant("$2_it","$2_it", + "EXPORT_VAR_AS_FUNCTION", + "FUNCTION"); + next; + } elsif (/^\s*DECLARE_ASN1_ITEM\s*\(\s*(\w*)\s*\)/) { + # Variant for platforms that do not + # have to access globale variables + # in shared libraries through functions + $def .= + "#INFO:" + .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "OPENSSL_EXTERN int $1_it;"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Variant for platforms that have to + # access globale variables in shared + # libraries through functions + &$make_variant("$1_it","$1_it", + "EXPORT_VAR_AS_FUNCTION", + "FUNCTION"); + next; + } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) { + next; + } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) { + next; + } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || + /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ) { + # Things not in Win16 + $def .= + "#INFO:" + .join(',',"!WIN16",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "int PEM_read_$1(void);"; + $def .= "int PEM_write_$1(void);"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Things that are everywhere + $def .= "int PEM_read_bio_$1(void);"; + $def .= "int PEM_write_bio_$1(void);"; + next; + } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || + /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { + # Things not in Win16 + $def .= + "#INFO:" + .join(',',"!WIN16",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "int PEM_write_$1(void);"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Things that are everywhere + $def .= "int PEM_write_bio_$1(void);"; + next; + } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || + /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { + # Things not in Win16 + $def .= + "#INFO:" + .join(',',"!WIN16",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "int PEM_read_$1(void);"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Things that are everywhere + $def .= "int PEM_read_bio_$1(void);"; + next; + } elsif (/^OPENSSL_DECLARE_GLOBAL\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) { + # Variant for platforms that do not + # have to access globale variables + # in shared libraries through functions + $def .= + "#INFO:" + .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" + .join(',',@current_algorithms).";"; + $def .= "OPENSSL_EXTERN int _shadow_$2;"; + $def .= + "#INFO:" + .join(',',@current_platforms).":" + .join(',',@current_algorithms).";"; + # Variant for platforms that have to + # access globale variables in shared + # libraries through functions + &$make_variant("_shadow_$2","_shadow_$2", + "EXPORT_VAR_AS_FUNCTION", + "FUNCTION"); + } elsif ($tag{'CONST_STRICT'} != 1) { if (/\{|\/\*|\([^\)]*$/) { $line = $_; } else { @@ -450,11 +766,13 @@ sub do_defs } } } + } close(IN); my $algs; my $plays; + print STDERR "DEBUG: postprocessing ----------\n" if $debug; foreach (split /;/, $def) { my $s; my $k = "FUNCTION"; my $p; my $a; s/^[\n\s]*//g; @@ -463,26 +781,32 @@ sub do_defs next if(/typedef\W/); next if(/\#define/); + print STDERR "DEBUG: \$_ = \"$_\"\n" if $debug; if (/^\#INFO:([^:]*):(.*)$/) { $plats = $1; $algs = $2; + print STDERR "DEBUG: found info on platforms ($plats) and algorithms ($algs)\n" if $debug; next; - } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+)(\[[0-9]*\])*\s*$/) { + } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+(\{[0-9]+\})?)(\[[0-9]*\])*\s*$/) { $s = $1; $k = "VARIABLE"; - } elsif (/\(\*(\w*)\([^\)]+/) { + print STDERR "DEBUG: found external variable $s\n" if $debug; + } elsif (/\(\*(\w*(\{[0-9]+\})?)\([^\)]+/) { $s = $1; + print STDERR "DEBUG: found ANSI C function $s\n" if $debug; } elsif (/\w+\W+(\w+)\W*\(\s*\)$/s) { # K&R C + print STDERR "DEBUG: found K&R C function $s\n" if $debug; next; - } elsif (/\w+\W+\w+\W*\(.*\)$/s) { + } elsif (/\w+\W+\w+(\{[0-9]+\})?\W*\(.*\)$/s) { while (not /\(\)$/s) { s/[^\(\)]*\)$/\)/s; s/\([^\(\)]*\)\)$/\)/s; } s/\(void\)//; - /(\w+)\W*\(\)/s; + /(\w+(\{[0-9]+\})?)\W*\(\)/s; $s = $1; + print STDERR "DEBUG: found function $s\n" if $debug; } elsif (/\(/ and not (/=/)) { print STDERR "File $file: cannot parse: $_;\n"; next; @@ -513,67 +837,61 @@ sub do_defs $a .= ",RSA" if($s =~ /RSAPrivateKey/); $a .= ",RSA" if($s =~ /SSLv23?_((client|server)_)?method/); - $platform{$s} .= ','.$p; + $platform{$s} = + &reduce_platforms((defined($platform{$s})?$platform{$s}.',':"").$p); $algorithm{$s} .= ','.$a; - if (defined($rename{$s})) { - (my $r, my $p) = split(/:/,$rename{$s}); - my @ip = map { /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p; - $syms{$r} = 1; - $kind{$r} = $kind{$s}."(".$s.")"; - $algorithm{$r} = $algorithm{$s}; - $platform{$r} = $platform{$s}.",".$p; - $platform{$s} .= ','.join(',', @ip).','.join(',', @ip); + if (defined($variant{$s})) { + foreach $v (split /;/,$variant{$s}) { + (my $r, my $p, my $k) = split(/:/,$v); + my $ip = join ',',map({ /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p); + $syms{$r} = 1; + if (!defined($k)) { $k = $kind{$s}; } + $kind{$r} = $k."(".$s.")"; + $algorithm{$r} = $algorithm{$s}; + $platform{$r} = &reduce_platforms($platform{$s}.",".$p.",".$p); + $platform{$s} = &reduce_platforms($platform{$s}.','.$ip.','.$ip); + print STDERR "DEBUG: \$variant{\"$s\"} = ",$v,"; \$r = $r; \$p = ",$platform{$r},"; \$a = ",$algorithm{$r},"; \$kind = ",$kind{$r},"\n" if $debug; + } } + print STDERR "DEBUG: \$s = $s; \$p = ",$platform{$s},"; \$a = ",$algorithm{$s},"; \$kind = ",$kind{$s},"\n" if $debug; } } # Prune the returned symbols - $platform{"crypt"} .= ",!PERL5,!__FreeBSD__,!NeXT"; - - delete $syms{"SSL_add_dir_cert_subjects_to_stack"}; delete $syms{"bn_dump1"}; - - $platform{"BIO_s_file_internal"} .= ",WIN16"; - $platform{"BIO_new_file_internal"} .= ",WIN16"; - $platform{"BIO_new_fp_internal"} .= ",WIN16"; - - $platform{"BIO_s_file"} .= ",!WIN16"; - $platform{"BIO_new_file"} .= ",!WIN16"; - $platform{"BIO_new_fp"} .= ",!WIN16"; - $platform{"BIO_s_log"} .= ",!WIN32,!WIN16,!macintosh"; - if(exists $syms{"ERR_load_CRYPTO_strings"}) { - $platform{"ERR_load_CRYPTO_strings"} .= ",!VMS,!WIN16"; - $syms{"ERR_load_CRYPTOlib_strings"} = 1; - $platform{"ERR_load_CRYPTOlib_strings"} .= ",VMS,WIN16"; - } + $platform{"PEM_read_NS_CERT_SEQ"} = "VMS"; + $platform{"PEM_write_NS_CERT_SEQ"} = "VMS"; + $platform{"PEM_read_P8_PRIV_KEY_INFO"} = "VMS"; + $platform{"PEM_write_P8_PRIV_KEY_INFO"} = "VMS"; # Info we know about - $platform{"RSA_PKCS1_RSAref"} = "RSAREF"; - $algorithm{"RSA_PKCS1_RSAref"} = "RSA"; - push @ret, map { $_."\\".&info_string($_,"EXIST", $platform{$_}, $kind{$_}, $algorithm{$_}) } keys %syms; + if (keys %unknown_algorithms) { + print STDERR "WARNING: mkdef.pl doesn't know the following algorithms:\n"; + print STDERR "\t",join("\n\t",keys %unknown_algorithms),"\n"; + } return(@ret); } -sub info_string { - (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_; - - my %a = defined($algorithms) ? - map { $_ => 1 } split /,/, $algorithms : (); +# Param: string of comma-separated platform-specs. +sub reduce_platforms +{ + my ($platforms) = @_; my $pl = defined($platforms) ? $platforms : ""; my %p = map { $_ => 0 } split /,/, $pl; - my $k = defined($kind) ? $kind : "FUNCTION"; my $ret; + print STDERR "DEBUG: Entered reduce_platforms with \"$platforms\"\n" + if $debug; # We do this, because if there's code like the following, it really # means the function exists in all cases and should therefore be # everywhere. By increasing and decreasing, we may attain 0: @@ -595,12 +913,28 @@ sub info_string { } delete $p{""}; + + $ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p)); + print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n" + if $debug; + return $ret; +} + +sub info_string { + (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_; + + my %a = defined($algorithms) ? + map { $_ => 1 } split /,/, $algorithms : (); + my $k = defined($kind) ? $kind : "FUNCTION"; + my $ret; + my $p = &reduce_platforms($platforms); + delete $a{""}; $ret = $exist; - $ret .= ":".join(',',map { $p{$_} < 0 ? "!".$_ : $_ } keys %p); + $ret .= ":".$p; $ret .= ":".$k; - $ret .= ":".join(',',keys %a); + $ret .= ":".join(',',sort keys %a); return $ret; } @@ -608,19 +942,30 @@ sub maybe_add_info { (my $name, *nums, my @symbols) = @_; my $sym; my $new_info = 0; + my %syms=(); print STDERR "Updating $name info\n"; foreach $sym (@symbols) { (my $s, my $i) = split /\\/, $sym; - $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/; if (defined($nums{$s})) { + $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/; (my $n, my $dummy) = split /\\/, $nums{$s}; if (!defined($dummy) || $i ne $dummy) { $nums{$s} = $n."\\".$i; $new_info++; - #print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n"; + print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug; } } + $syms{$s} = 1; + } + + my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; + foreach $sym (@s) { + (my $n, my $i) = split /\\/, $nums{$sym}; + if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) { + $new_info++; + print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug; + } } if ($new_info) { print STDERR "$new_info old symbols got an info update\n"; @@ -632,35 +977,121 @@ sub maybe_add_info { } } +# Param: string of comma-separated keywords, each possibly prefixed with a "!" +sub is_valid +{ + my ($keywords_txt,$platforms) = @_; + my (@keywords) = split /,/,$keywords_txt; + my ($falsesum, $truesum) = (0, !grep(/^[^!]/,@keywords)); + + # Param: one keyword + sub recognise + { + my ($keyword,$platforms) = @_; + + if ($platforms) { + # platforms + if ($keyword eq "VMS" && $VMS) { return 1; } + if ($keyword eq "WIN32" && $W32) { return 1; } + if ($keyword eq "WIN16" && $W16) { return 1; } + if ($keyword eq "WINNT" && $NT) { return 1; } + # Special platforms: + # EXPORT_VAR_AS_FUNCTION means that global variables + # will be represented as functions. This currently + # only happens on VMS-VAX. + if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && ($VMSVAX || $W32 || $W16)) { + return 1; + } + return 0; + } else { + # algorithms + if ($keyword eq "RC2" && $no_rc2) { return 0; } + if ($keyword eq "RC4" && $no_rc4) { return 0; } + if ($keyword eq "RC5" && $no_rc5) { return 0; } + if ($keyword eq "IDEA" && $no_idea) { return 0; } + if ($keyword eq "DES" && $no_des) { return 0; } + if ($keyword eq "BF" && $no_bf) { return 0; } + if ($keyword eq "CAST" && $no_cast) { return 0; } + if ($keyword eq "MD2" && $no_md2) { return 0; } + if ($keyword eq "MD4" && $no_md4) { return 0; } + if ($keyword eq "MD5" && $no_md5) { return 0; } + if ($keyword eq "SHA" && $no_sha) { return 0; } + if ($keyword eq "RIPEMD" && $no_ripemd) { return 0; } + if ($keyword eq "MDC2" && $no_mdc2) { return 0; } + if ($keyword eq "RSA" && $no_rsa) { return 0; } + if ($keyword eq "DSA" && $no_dsa) { return 0; } + if ($keyword eq "DH" && $no_dh) { return 0; } + if ($keyword eq "EC" && $no_ec) { return 0; } + if ($keyword eq "HMAC" && $no_hmac) { return 0; } + if ($keyword eq "AES" && $no_aes) { return 0; } + if ($keyword eq "EVP" && $no_evp) { return 0; } + if ($keyword eq "LHASH" && $no_lhash) { return 0; } + if ($keyword eq "STACK" && $no_stack) { return 0; } + if ($keyword eq "ERR" && $no_err) { return 0; } + if ($keyword eq "BUFFER" && $no_buffer) { return 0; } + if ($keyword eq "BIO" && $no_bio) { return 0; } + if ($keyword eq "COMP" && $no_comp) { return 0; } + if ($keyword eq "DSO" && $no_dso) { return 0; } + if ($keyword eq "KRB5" && $no_krb5) { return 0; } + if ($keyword eq "FP_API" && $no_fp_api) { return 0; } + + # Nothing recognise as true + return 1; + } + } + + foreach $k (@keywords) { + if ($k =~ /^!(.*)$/) { + $falsesum += &recognise($1,$platforms); + } else { + $truesum += &recognise($k,$platforms); + } + } + print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug; + return (!$falsesum) && $truesum; +} + sub print_test_file { - (*OUT,my $name,*nums,my @symbols)=@_; + (*OUT,my $name,*nums,my $testall,my @symbols)=@_; my $n = 1; my @e; my @r; my $sym; my $prev = ""; my $prefSSLeay; - (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); - (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); + (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols); + (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols); @symbols=((sort @e),(sort @r)); foreach $sym (@symbols) { (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; - if ($s ne $prev) { - if (!defined($nums{$sym})) { - printf STDERR "Warning: $sym does not have a number assigned\n" - if(!$do_update); + my $v = 0; + $v = 1 if $i=~ /^.*?:.*?:VARIABLE/; + my $p = ($i =~ /^[^:]*:([^:]*):/,$1); + my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1); + if (!defined($nums{$s})) { + print STDERR "Warning: $s does not have a number assigned\n" + if(!$do_update); + } elsif (is_valid($p,1) && is_valid($a,0)) { + my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1); + if ($prev eq $s2) { + print OUT "\t/* The following has already appeared previously */\n"; + print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n"; + } + $prev = $s2; # To warn about duplicates... + + ($nn,$ni)=($nums{$s2} =~ /^(.*?)\\(.*)$/); + if ($v) { + print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n"; } else { - $n=$nums{$s}; - print OUT "\t$s();\n"; + print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n"; } } - $prev = $s; # To avoid duplicates... } } sub print_def_file { (*OUT,my $name,*nums,my @symbols)=@_; - my $n = 1; my @e; my @r; + my $n = 1; my @e; my @r; my @v; my $prev=""; if ($W32) { $name.="32"; } @@ -693,80 +1124,35 @@ EOF print "EXPORTS\n"; - (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); - (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); - @symbols=((sort @e),(sort @r)); + (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols); + (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols); + (@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols); + @symbols=((sort @e),(sort @r), (sort @v)); foreach $sym (@symbols) { (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; + my $v = 0; + $v = 1 if $i =~ /^.*?:.*?:VARIABLE/; if (!defined($nums{$s})) { printf STDERR "Warning: $s does not have a number assigned\n" - if(!$do_update); + if(!$do_update); } else { - (my $n, my $i) = split /\\/, $nums{$s}; + (my $n, my $dummy) = split /\\/, $nums{$s}; my %pf = (); - my @p = split(/,/, ($i =~ /^[^:]*:([^:]*):/,$1)); - my @a = split(/,/, ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1)); - # @p_purged must contain hardware platforms only - my @p_purged = (); - foreach $ptmp (@p) { - next if $ptmp =~ /^!?RSAREF$/; - push @p_purged, $ptmp; - } - my $negatives = !!grep(/^!/,@p); - # It is very important to check NT before W32 - if ((($NT && (!@p_purged - || (!$negatives && grep(/^WINNT$/,@p)) - || ($negatives && !grep(/^!WINNT$/,@p)))) - || ($W32 && (!@p_purged - || (!$negatives && grep(/^WIN32$/,@p)) - || ($negatives && !grep(/^!WIN32$/,@p)))) - || ($W16 && (!@p_purged - || (!$negatives && grep(/^WIN16$/,@p)) - || ($negatives && !grep(/^!WIN16$/,@p))))) - && (!@p - || (!$negatives - && ($rsaref || !grep(/^RSAREF$/,@p))) - || ($negatives - && (!$rsaref || !grep(/^!RSAREF$/,@p)))) - && (!@a || (!$no_rc2 || !grep(/^RC2$/,@a))) - && (!@a || (!$no_rc4 || !grep(/^RC4$/,@a))) - && (!@a || (!$no_rc5 || !grep(/^RC5$/,@a))) - && (!@a || (!$no_idea || !grep(/^IDEA$/,@a))) - && (!@a || (!$no_des || !grep(/^DES$/,@a))) - && (!@a || (!$no_bf || !grep(/^BF$/,@a))) - && (!@a || (!$no_cast || !grep(/^CAST$/,@a))) - && (!@a || (!$no_md2 || !grep(/^MD2$/,@a))) - && (!@a || (!$no_md4 || !grep(/^MD4$/,@a))) - && (!@a || (!$no_md5 || !grep(/^MD5$/,@a))) - && (!@a || (!$no_sha || !grep(/^SHA$/,@a))) - && (!@a || (!$no_ripemd || !grep(/^RIPEMD$/,@a))) - && (!@a || (!$no_mdc2 || !grep(/^MDC2$/,@a))) - && (!@a || (!$no_rsa || !grep(/^RSA$/,@a))) - && (!@a || (!$no_dsa || !grep(/^DSA$/,@a))) - && (!@a || (!$no_dh || !grep(/^DH$/,@a))) - && (!@a || (!$no_hmac || !grep(/^HMAC$/,@a))) - && (!@a || (!$no_fp_api || !grep(/^FP_API$/,@a))) - ) { - printf OUT " %s%-40s@%d\n",($W32)?"":"_",$s,$n; -# } else { -# print STDERR "DEBUG: \"$sym\" (@p):", -# " rsaref:", !!(!@p -# || (!$negatives -# && ($rsaref || !grep(/^RSAREF$/,@p))) -# || ($negatives -# && (!$rsaref || !grep(/^!RSAREF$/,@p))))?1:0, -# " 16:", !!($W16 && (!@p_purged -# || (!$negatives && grep(/^WIN16$/,@p)) -# || ($negatives && !grep(/^!WIN16$/,@p)))), -# " 32:", !!($W32 && (!@p_purged -# || (!$negatives && grep(/^WIN32$/,@p)) -# || ($negatives && !grep(/^!WIN32$/,@p)))), -# " NT:", !!($NT && (!@p_purged -# || (!$negatives && grep(/^WINNT$/,@p)) -# || ($negatives && !grep(/^!WINNT$/,@p)))), -# "\n"; + my $p = ($i =~ /^[^:]*:([^:]*):/,$1); + my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1); + if (is_valid($p,1) && is_valid($a,0)) { + my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1); + if ($prev eq $s2) { + print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n"; + } + $prev = $s2; # To warn about duplicates... + if($v) { + printf OUT " %s%-39s @%-8d DATA\n",($W32)?"":"_",$s2,$n; + } else { + printf OUT " %s%-39s @%d\n",($W32)?"":"_",$s2,$n; + } } } } @@ -781,6 +1167,7 @@ sub load_numbers $max_num = 0; $num_noinfo = 0; $prev = ""; + $prev_cnt = 0; open(IN,"<$name") || die "unable to open $name:$!\n"; while () { @@ -789,14 +1176,22 @@ sub load_numbers next if /^\s*$/; @a=split; if (defined $ret{$a[0]}) { - print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; + # This is actually perfectly OK + #print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; } if ($max_num > $a[1]) { print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n"; } - if ($max_num == $a[1]) { + elsif ($max_num == $a[1]) { # This is actually perfectly OK #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n"; + if ($a[0] eq $prev) { + $prev_cnt++; + $a[0] .= "{$prev_cnt}"; + } + } + else { + $prev_cnt = 0; } if ($#a < 2) { # Existence will be proven later, in do_defs @@ -838,7 +1233,7 @@ sub rewrite_numbers print STDERR "Rewriting $name\n"; - my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); + my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols); my $r; my %r; my %rsyms; foreach $r (@r) { (my $s, my $i) = split /\\/, $r; @@ -848,16 +1243,31 @@ sub rewrite_numbers $rsyms{$s} = 1; } - my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; + my %syms = (); + foreach $_ (@symbols) { + (my $n, my $i) = split /\\/; + $syms{$n} = 1; + } + + my @s=sort { + &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") + || $a cmp $b + } keys %nums; foreach $sym (@s) { (my $n, my $i) = split /\\/, $nums{$sym}; next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/; next if defined($rsyms{$sym}); - $i="NOEXIST::FUNCTION:" if !defined($i) || $i eq ""; - printf OUT "%s%-40s%d\t%s\n","",$sym,$n,$i; + print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug; + $i="NOEXIST::FUNCTION:" + if !defined($i) || $i eq "" || !defined($syms{$sym}); + my $s2 = $sym; + $s2 =~ s/\{[0-9]+\}$//; + printf OUT "%s%-39s %d\t%s\n","",$s2,$n,$i; if (exists $r{$sym}) { (my $s, $i) = split /\\/,$r{$sym}; - printf OUT "%s%-40s%d\t%s\n","",$s,$n,$i; + my $s2 = $s; + $s2 =~ s/\{[0-9]+\}$//; + printf OUT "%s%-39s %d\t%s\n","",$s2,$n,$i; } } } @@ -869,7 +1279,7 @@ sub update_numbers print STDERR "Updating $name numbers\n"; - my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); + my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols); my $r; my %r; my %rsyms; foreach $r (@r) { (my $s, my $i) = split /\\/, $r; @@ -887,10 +1297,13 @@ sub update_numbers if $i eq ""; if (!exists $nums{$s}) { $new_syms++; - printf OUT "%s%-40s%d\t%s\n","",$s, ++$start_num,$i; + my $s2 = $s; + $s2 =~ s/\{[0-9]+\}$//; + printf OUT "%s%-39s %d\t%s\n","",$s2, ++$start_num,$i; if (exists $r{$s}) { ($s, $i) = split /\\/,$r{$s}; - printf OUT "%s%-40s%d\t%s\n","",$s, $start_num,$i; + $s =~ s/\{[0-9]+\}$//; + printf OUT "%s%-39s %d\t%s\n","",$s, $start_num,$i; } } }