VMS/translatesyms.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the OpenSSL license (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9
  10 # This script will translate any SYMBOL_VECTOR item that has a translation
  11 # in CXX$DEMANGLER_DB.  The latter is generated by and CC/DECC command that
  12 # uses the qualifier /REPOSITORY with the build directory as value.  When
  13 # /NAMES=SHORTENED has been used, this file will hold the translations from
  14 # the original symbols to the shortened variants.
  15 #
  16 # CXX$DEMAGLER_DB. is an ISAM file, but with the magic of RMS, it can be
  17 # read as a text file, with each record as one line.
  18 #
  19 # The lines will have the following syntax for any symbol found that's longer
  20 # than 31 characters:
  21 #
  22 # LONG_symbol_34567890123{cksum}$LONG_symbol_34567890123_more_than_31_chars
  23 #
  24 # $ is present at the end of the shortened symbol name, and is preceded by a
  25 # 7 character checksum.  The $ makes it easy to separate the shortened name
  26 # from the original one.
  27
  28 use strict;
  29 use warnings;
  30
  31 usage() if scalar @ARGV < 1;
  32
  33 my %translations = ();
  34
  35 open DEMANGLER_DATA, $ARGV[0]
  36     or die "Couldn't open $ARGV[0]: $!\n";
  37 while(<DEMANGLER_DATA>) {
  38     s|\R$||;
  39     (my $translated, my $original) = split /\$/;
  40     $translations{$original} = $translated.'$';
  41 }
  42 close DEMANGLER_DATA;
  43
  44 $| = 1;                         # Autoflush
  45 while(<STDIN>) {
  46     s@
  47       ((?:[A-Za-z0-9_]+)\/)?([A-Za-z0-9_]+)=(PROCEDURE|DATA)
  48      @
  49       if (defined($translations{$2})) {
  50           my $trans = $translations{$2};
  51           my $trans_uc = uc $trans;
  52           if (defined($1) && $trans ne $trans_uc) {
  53               "$trans_uc/$trans=$3"
  54           } else {
  55               "$trans=$3"
  56           }
  57       } else {
  58           $&
  59       }
  60      @gxe;
  61     print $_;
  62 }