openmp/runtime/tools/generate-def.pl

   1 #!/usr/bin/env perl
   2
   3 #
   4 #//===----------------------------------------------------------------------===//
   5 #//
   6 #// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   7 #// See https://llvm.org/LICENSE.txt for license information.
   8 #// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   9 #//
  10 #//===----------------------------------------------------------------------===//
  11 #
  12
  13 # Some pragmas.
  14 use strict;          # Restrict unsafe constructs.
  15 use warnings;        # Enable all warnings.
  16
  17 use FindBin;
  18 use lib "$FindBin::Bin/lib";
  19
  20 use tools;
  21
  22 our $VERSION = "0.004";
  23
  24 #
  25 # Subroutines.
  26 #
  27
  28 sub parse_input($\%) {
  29
  30     my ( $input, $defs ) = @_;
  31     my @bulk = read_file( $input );
  32     my %entries;
  33     my %ordinals;
  34     my @dirs;
  35     my $value = 1;
  36
  37     my $error =
  38         sub {
  39             my ( $msg, $l, $line ) = @_;
  40             runtime_error(
  41                 "Error parsing file \"$input\" line $l:\n" .
  42                 "    $line" .
  43                 ( $msg ? $msg . "\n" : () )
  44             );
  45         }; # sub
  46
  47     my $n = 0;    # Line number.
  48     foreach my $line ( @bulk ) {
  49         ++ $n;
  50         if ( 0 ) {
  51         } elsif ( $line =~ m{^\s*(?:#|\n)} ) {
  52             # Empty line or comment. Skip it.
  53         } elsif ( $line =~ m{^\s*%} ) {
  54             # A directive.
  55             if ( 0  ) {
  56             } elsif ( $line =~ m{^\s*%\s*if(n)?def\s+([A-Za-z0-9_]+)\s*(?:#|\n)} ) {
  57                 my ( $negation, $name ) = ( $1, $2 );
  58                 my $dir = { n => $n, line => $line, name => $name, value => $value };
  59                 push( @dirs, $dir );
  60                 $value = ( $value and ( $negation xor $defs->{ $name } ) );
  61             } elsif ( $line =~ m{^\s*%\s*endif\s*(?:#|\n)} ) {
  62                 if ( not @dirs ) {
  63                     $error->( "Orphan %endif directive.", $n, $line );
  64                 }; # if
  65                 my $dir = pop( @dirs );
  66                 $value = $dir->{ value };
  67             } else {
  68                 $error->( "Bad directive.", $n, $line );
  69             }; # if
  70         } elsif ( $line =~ m{^\s*(-)?\s*([A-Za-z0-9_]+)(?:\s+(\d+|DATA))?\s*(?:#|\n)} ) {
  71             my ( $obsolete, $entry, $ordinal ) = ( $1, $2, $3 );
  72             if ( $value ) {
  73                 if ( exists( $entries{ $entry } ) ) {
  74                     $error->( "Entry \"$entry\" has already been specified.", $n, $line );
  75                 }; # if
  76                 $entries{ $entry } = { ordinal => $ordinal, obsolete => defined( $obsolete ) };
  77                 if ( defined( $ordinal ) and $ordinal ne "DATA" ) {
  78                     if ( $ordinal >= 1000 and $entry =~ m{\A[ok]mp_} ) {
  79                         $error->( "Ordinal of user-callable entry must be < 1000", $n, $line );
  80                     }; # if
  81                     if ( $ordinal >= 1000 and $ordinal < 2000 ) {
  82                         $error->( "Ordinals between 1000 and 1999 are reserved.", $n, $line );
  83                     }; # if
  84                     if ( exists( $ordinals{ $ordinal } ) ) {
  85                         $error->( "Ordinal $ordinal has already been used.", $n, $line );
  86                     }; # if
  87                     $ordinals{ $ordinal } = $entry;
  88                 }; # if
  89             }; # if
  90         } else {
  91             $error->( "", $n, $line );
  92         }; # if
  93     }; # foreach
  94
  95     if ( @dirs ) {
  96         my $dir = pop( @dirs );
  97         $error->( "Unterminated %if directive.", $dir->{ n }, $dir->{ line } );
  98     }; # while
  99
 100     return %entries;
 101
 102 }; # sub parse_input
 103
 104 sub process(\%) {
 105
 106     my ( $entries ) = @_;
 107
 108     foreach my $entry ( keys( %$entries ) ) {
 109         if ( not $entries->{ $entry }->{ obsolete } ) {
 110             my $ordinal = $entries->{ $entry }->{ ordinal };
 111             # omp_alloc and omp_free are C/C++ only functions, skip "1000+ordinal" for them
 112             if ( $entry =~ m{\A[ok]mp_} and $entry ne "omp_alloc" and $entry ne "omp_free" and
 113                 $entry ne "omp_calloc" and $entry ne "omp_realloc" and
 114                 $entry ne "omp_aligned_alloc" and $entry ne "omp_aligned_calloc" ) {
 115                 if ( not defined( $ordinal ) ) {
 116                     runtime_error(
 117                         "Bad entry \"$entry\": ordinal number is not specified."
 118                     );
 119                 }; # if
 120                 if ( $ordinal ne "DATA" ) {
 121                     $entries->{ uc( $entry ) } = { ordinal => 1000 + $ordinal };
 122                 }
 123             }; # if
 124         }; # if
 125     }; # foreach
 126
 127     return %$entries;
 128
 129 }; # sub process
 130
 131 sub generate_output(\%$\%) {
 132
 133     my ( $entries, $output, $defs ) = @_;
 134     my $lib = %$defs {'NAME'};
 135     my $bulk;
 136
 137     if (defined($lib)) {
 138         $bulk = sprintf("NAME %s\n", $lib);
 139     }
 140     $bulk .= sprintf("EXPORTS\n");
 141     foreach my $entry ( sort( keys( %$entries ) ) ) {
 142         if ( not $entries->{ $entry }->{ obsolete } ) {
 143             $bulk .= sprintf( "    %-40s ", $entry );
 144             my $ordinal = $entries->{ $entry }->{ ordinal };
 145             if ( defined( $ordinal ) ) {
 146                 if ( $ordinal eq "DATA" ) {
 147                     $bulk .= "DATA";
 148                 } else {
 149                     if (not %$defs {'NOORDINALS'}) {
 150                         $bulk .= "\@" . $ordinal;
 151                     }
 152                 }; # if
 153             }; # if
 154             $bulk .= "\n";
 155         }; # if
 156     }; # foreach
 157     if ( defined( $output ) ) {
 158         write_file( $output, \$bulk );
 159     } else {
 160         print( $bulk );
 161     }; # if
 162
 163 }; # sub generate_output
 164
 165 #
 166 # Parse command line.
 167 #
 168
 169 my $input;   # The name of input file.
 170 my $output;  # The name of output file.
 171 my %defs;
 172
 173 get_options(
 174     "output=s"    => \$output,
 175     "D|define=s"  =>
 176         sub {
 177             my ( $opt_name, $opt_value ) = @_;
 178             my ( $def_name, $def_value );
 179             if ( $opt_value =~ m{\A(.*?)=(.*)\z} ) {
 180                 ( $def_name, $def_value ) = ( $1, $2 );
 181             } else {
 182                 ( $def_name, $def_value ) = ( $opt_value, 1 );
 183             }; # if
 184             $defs{ $def_name } = $def_value;
 185         },
 186 );
 187
 188 if ( @ARGV == 0 ) {
 189     cmdline_error( "Not enough arguments." );
 190 }; # if
 191 if ( @ARGV > 1 ) {
 192     cmdline_error( "Too many arguments." );
 193 }; # if
 194 $input = shift( @ARGV );
 195
 196 #
 197 # Work.
 198 #
 199
 200 my %data = parse_input( $input, %defs );
 201 %data = process( %data );
 202 generate_output( %data, $output, %defs );
 203 exit( 0 );
 204
 205 __END__
 206
 207 #
 208 # Embedded documentation.
 209 #
 210
 211 =pod
 212
 213 =head1 NAME
 214
 215 B<generate-def.pl> -- Generate def file for OpenMP RTL.
 216
 217 =head1 SYNOPSIS
 218
 219 B<generate-def.pl> I<OPTION>... I<file>
 220
 221 =head1 OPTIONS
 222
 223 =over
 224
 225 =item B<--define=>I<name>[=I<value>]
 226
 227 =item B<-D> I<name>[=I<value>]
 228
 229 Define specified name. If I<value> is omitted, I<name> is defined to 1. If I<value> is 0 or empty,
 230 name is B<not> defined.
 231
 232 =item B<--output=>I<file>
 233
 234 =item B<-o> I<file>
 235
 236 Specify output file name. If option is not present, result is printed to stdout.
 237
 238 =item B<--doc>
 239
 240 =item B<--manual>
 241
 242 Print full help message and exit.
 243
 244 =item B<--help>
 245
 246 Print short help message and exit.
 247
 248 =item B<--usage>
 249
 250 Print very short usage message and exit.
 251
 252 =item B<--verbose>
 253
 254 Do print informational messages.
 255
 256 =item B<--version>
 257
 258 Print version and exit.
 259
 260 =item B<--quiet>
 261
 262 Work quiet, do not print informational messages.
 263
 264 =back
 265
 266 =head1 ARGUMENTS
 267
 268 =over
 269
 270 =item I<file>
 271
 272 A name of input file.
 273
 274 =back
 275
 276 =head1 DESCRIPTION
 277
 278 The script reads input file, process conditional directives, checks content for consistency, and
 279 generates output file suitable for linker.
 280
 281 =head2 Input File Format
 282
 283 =over
 284
 285 =item Comments
 286
 287     # It's a comment.
 288
 289 Comments start with C<#> symbol and continue to the end of line.
 290
 291 =item Conditional Directives
 292
 293     %ifdef name
 294     %ifndef name
 295     %endif
 296
 297 A part of file surrounded by C<%ifdef I<name>> and C<%endif> directives is a conditional part -- it
 298 has effect only if I<name> is defined in the command line by B<--define> option. C<%ifndef> is a
 299 negated version of C<%ifdef> -- conditional part has an effect only if I<name> is B<not> defined.
 300
 301 Conditional parts may be nested.
 302
 303 =item Export Definitions
 304
 305     symbol
 306     symbol ordinal
 307     symbol DATA
 308
 309 Symbols starting with C<omp_> or C<kmp_> must have ordinal specified. They are subjects for special
 310 processing: each symbol generates two output lines: original one and upper case version. The ordinal
 311 number of the second is original ordinal increased by 1000.
 312
 313 =item Obsolete Symbols
 314
 315     - symbol
 316     - symbol ordinal
 317     - symbol DATA
 318
 319 Obsolete symbols look like export definitions prefixed with minus sign. Obsolete symbols do not
 320 affect the output, but obsolete symbols and their ordinals cannot be (re)used in export definitions.
 321
 322 =back
 323
 324 =head1 EXAMPLES
 325
 326     $ generate-def.pl -D stub -D USE_TCHECK=0 -o libguide.def dllexport
 327
 328 =cut
 329
 330 # end of file #
 331