summaryrefslogtreecommitdiffstats
path: root/VMS/translatesyms.pl
blob: c7d1bc1ce75c5d27e35f64a087aff7d2475b7590 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
#! /usr/bin/env perl
# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the Apache License 2.0 (the "License").  You may not use
# this file except in compliance with the License.  You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html


# This script will translate any SYMBOL_VECTOR item that has a translation
# in CXX$DEMANGLER_DB.  The latter is generated by and CC/DECC command that
# uses the qualifier /REPOSITORY with the build directory as value.  When
# /NAMES=SHORTENED has been used, this file will hold the translations from
# the original symbols to the shortened variants.
#
# CXX$DEMAGLER_DB. is an ISAM file, but with the magic of RMS, it can be
# read as a text file, with each record as one line.
#
# The lines will have the following syntax for any symbol found that's longer
# than 31 characters:
#
# LONG_symbol_34567890123{cksum}$LONG_symbol_34567890123_more_than_31_chars
#
# $ is present at the end of the shortened symbol name, and is preceded by a
# 7 character checksum.  The $ makes it easy to separate the shortened name
# from the original one.

use strict;
use warnings;

usage() if scalar @ARGV < 1;

my %translations = ();

open DEMANGLER_DATA, $ARGV[0]
    or die "Couldn't open $ARGV[0]: $!\n";
while(<DEMANGLER_DATA>) {
    s|\R$||;
    (my $translated, my $original) = split /\$/;
    $translations{$original} = $translated.'$';
}
close DEMANGLER_DATA;

$| = 1;                         # Autoflush
while(<STDIN>) {
    s@
      ((?:[A-Za-z0-9_]+)\/)?([A-Za-z0-9_]+)=(PROCEDURE|DATA)
     @
      if (defined($translations{$2})) {
          my $trans = $translations{$2};
          my $trans_uc = uc $trans;
          if (defined($1) && $trans ne $trans_uc) {
              "$trans_uc/$trans=$3"
          } else {
              "$trans=$3"
          }
      } else {
          $&
      }
     @gxe;
    print $_;
}