Commit 36d3acb9 authored by Richard Levitte's avatar Richard Levitte
Browse files

util/mkdef.pl: for VMS, allow generation of case insensitive symbol vector 



Some modules are built with case insensitive (uppercase) symbols on
VMS.  This needs to be reflected in the export symbol vector.

Reviewed-by: default avatarTim Hudson <tjh@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/7347)
parent 05a72c28

Configurations/descrip.mms.tmpl

+4 −1
Original line number Diff line number Diff line
@@ -761,9 +761,12 @@ reconfigure reconf : 
          my $ord_ver = $args{intent} eq 'lib' ? ' --version $(VERSION)' : '';

          my $ord_name =

              $args{generator}->[1] || basename($args{product}, '.EXE');

          my $case_insensitive =

              $target{$args{intent}.'_cflags'} =~ m|/NAMES=[^/]*AS_IS|i

              ? '' : ' --case-insensitive';

          return <<"EOF";

$target : $args{generator}->[0] $deps $mkdef

	\$(PERL) $mkdef$ord_ver --ordinals $args{generator}->[0] --name $ord_name "--OS" "VMS" > $target

	\$(PERL) $mkdef$ord_ver --ordinals $args{generator}->[0] --name $ord_name "--OS" "VMS"$case_insensitive > $target

EOF

      } elsif ($target !~ /\.[sS]$/) {

          my $target = $args{src};

util/mkdef.pl

+53 −30
Original line number Diff line number Diff line
@@ -28,12 +28,17 @@ my $OS = undef; # the operating system family 
my $verbose = 0;

my $ctest = 0;



# For VMS, some modules may have case insensitive names

my $case_insensitive = 0;



GetOptions('name=s'     => \$name,

           'ordinals=s' => \$ordinals_file,

           'version=s'  => \$version,

           'OS=s'       => \$OS,

           'ctest'      => \$ctest,

           'verbose'    => \$verbose)

           'verbose'    => \$verbose,

           # For VMS

           'case-insensitive' => \$case_insensitive)

    or die "Error in command line arguments\n";



die "Please supply arguments\n"
@@ -289,38 +294,51 @@ _____ 
    }

}



sub collect_VMS_mixedcase {

    return [ 'SPARE', 'SPARE' ] unless @_;



    my $s = shift;

    my $s_uc = uc($s);

    my $type = shift;



    return [ "$s=$type", 'SPARE' ] if $s_uc eq $s;

    return [ "$s_uc/$s=$type", "$s=$type" ];

}



sub collect_VMS_uppercase {

    return [ 'SPARE' ] unless @_;



    my $s = shift;

    my $s_uc = uc($s);

    my $type = shift;



    return [ "$s_uc=$type" ];

}



sub writer_VMS {

    my @slot_collection = ();

    my $write_vector_slot_pair =

        sub {

            my $slot1 = shift;

            my $slot2 = shift;

            my $slotpair_text = " $slot1, -\n  $slot2, -\n"

        };

    my $collector =

        $case_insensitive ? \&collect_VMS_uppercase : \&collect_VMS_mixedcase;



    my $last_num = 0;

    foreach (@_) {

        while (++$last_num < $_->number()) {

            push @slot_collection, [ 'SPARE', 'SPARE' ];

            push @slot_collection, $collector->(); # Just occupy a slot

        }

        my $type = {

            FUNCTION    => 'PROCEDURE',

            VARIABLE    => 'DATA'

           } -> {$_->type()};

        my $s = $_->name();

        my $s_uc = uc($s);

        if ($s_uc eq $s) {

            push @slot_collection, [ "$s=$type", 'SPARE' ];

        } else {

            push @slot_collection, [ "$s_uc/$s=$type", "$s=$type" ];

        }

        push @slot_collection, $collector->($_->name(), $type);

    }



    print <<"_____" if defined $version;

IDENTIFICATION=$version

_____

    print <<"_____";

    print <<"_____" unless $case_insensitive;

CASE_SENSITIVE=YES

_____

    print <<"_____";

SYMBOL_VECTOR=(-

_____

    # It's uncertain how long aggregated lines the linker can handle,
@@ -330,18 +348,19 @@ _____ 
    # can have more than one of those...

    my $symvtextcount = 16;     # The length of "SYMBOL_VECTOR=("

    while (@slot_collection) {

        my $pair = shift @slot_collection;

        my $pairtextlength =

            2                   # one space indentation and comma

            + length($pair->[0])

            + 1                 # postdent

        my $set = shift @slot_collection;

        my $settextlength = 0;

        foreach (@$set) {

            $settextlength +=

                + 3             # two space indentation and comma

            + length($pair->[1])

                + length($_)

                + 1             # postdent

                ;

        }

        $settextlength--;       # only one space indentation on the first one

        my $firstcomma = ',';



        if ($symvtextcount + $pairtextlength > 1024) {

        if ($symvtextcount + $settextlength > 1024) {

            print <<"_____";

)

SYMBOL_VECTOR=(-
@@ -351,11 +370,15 @@ _____ 
        if ($symvtextcount == 16) {

            $firstcomma = '';

        }



        my $indent = ' '.$firstcomma;

        foreach (@$set) {

            print <<"_____";

 $firstcomma$pair->[0] -

  ,$pair->[1] -

$indent$_ -

_____

        $symvtextcount += $pairtextlength;

            $symvtextcount += length($indent) + length($_) + 1;

            $indent = '  ,';

        }

    }

    print <<"_____";

)