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. 14use strict; # Restrict unsafe constructs. 15use warnings; # Enable all warnings. 16 17use FindBin; 18use lib "$FindBin::Bin/lib"; 19 20use tools; 21 22our $VERSION = "0.004"; 23 24# 25# Subroutines. 26# 27 28sub 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 104sub 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, omp_calloc, omp_realloc 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_calloc" and 113 $entry ne "omp_realloc" and $entry ne "omp_free" ) { 114 if ( not defined( $ordinal ) ) { 115 runtime_error( 116 "Bad entry \"$entry\": ordinal number is not specified." 117 ); 118 }; # if 119 if ( $ordinal ne "DATA" ) { 120 $entries->{ uc( $entry ) } = { ordinal => 1000 + $ordinal }; 121 } 122 }; # if 123 }; # if 124 }; # foreach 125 126 return %$entries; 127 128}; # sub process 129 130sub generate_output(\%$) { 131 132 my ( $entries, $output ) = @_; 133 my $bulk; 134 135 $bulk = "EXPORTS\n"; 136 foreach my $entry ( sort( keys( %$entries ) ) ) { 137 if ( not $entries->{ $entry }->{ obsolete } ) { 138 $bulk .= sprintf( " %-40s ", $entry ); 139 my $ordinal = $entries->{ $entry }->{ ordinal }; 140 if ( defined( $ordinal ) ) { 141 if ( $ordinal eq "DATA" ) { 142 $bulk .= "DATA"; 143 } else { 144 $bulk .= "\@" . $ordinal; 145 }; # if 146 }; # if 147 $bulk .= "\n"; 148 }; # if 149 }; # foreach 150 if ( defined( $output ) ) { 151 write_file( $output, \$bulk ); 152 } else { 153 print( $bulk ); 154 }; # if 155 156}; # sub generate_output 157 158# 159# Parse command line. 160# 161 162my $input; # The name of input file. 163my $output; # The name of output file. 164my %defs; 165 166get_options( 167 "output=s" => \$output, 168 "D|define=s" => 169 sub { 170 my ( $opt_name, $opt_value ) = @_; 171 my ( $def_name, $def_value ); 172 if ( $opt_value =~ m{\A(.*?)=(.*)\z} ) { 173 ( $def_name, $def_value ) = ( $1, $2 ); 174 } else { 175 ( $def_name, $def_value ) = ( $opt_value, 1 ); 176 }; # if 177 $defs{ $def_name } = $def_value; 178 }, 179); 180 181if ( @ARGV == 0 ) { 182 cmdline_error( "Not enough arguments." ); 183}; # if 184if ( @ARGV > 1 ) { 185 cmdline_error( "Too many arguments." ); 186}; # if 187$input = shift( @ARGV ); 188 189# 190# Work. 191# 192 193my %data = parse_input( $input, %defs ); 194%data = process( %data ); 195generate_output( %data, $output ); 196exit( 0 ); 197 198__END__ 199 200# 201# Embedded documentation. 202# 203 204=pod 205 206=head1 NAME 207 208B<generate-def.pl> -- Generate def file for OpenMP RTL. 209 210=head1 SYNOPSIS 211 212B<generate-def.pl> I<OPTION>... I<file> 213 214=head1 OPTIONS 215 216=over 217 218=item B<--define=>I<name>[=I<value>] 219 220=item B<-D> I<name>[=I<value>] 221 222Define specified name. If I<value> is omitted, I<name> is defined to 1. If I<value> is 0 or empty, 223name is B<not> defined. 224 225=item B<--output=>I<file> 226 227=item B<-o> I<file> 228 229Specify output file name. If option is not present, result is printed to stdout. 230 231=item B<--doc> 232 233=item B<--manual> 234 235Print full help message and exit. 236 237=item B<--help> 238 239Print short help message and exit. 240 241=item B<--usage> 242 243Print very short usage message and exit. 244 245=item B<--verbose> 246 247Do print informational messages. 248 249=item B<--version> 250 251Print version and exit. 252 253=item B<--quiet> 254 255Work quiet, do not print informational messages. 256 257=back 258 259=head1 ARGUMENTS 260 261=over 262 263=item I<file> 264 265A name of input file. 266 267=back 268 269=head1 DESCRIPTION 270 271The script reads input file, process conditional directives, checks content for consistency, and 272generates output file suitable for linker. 273 274=head2 Input File Format 275 276=over 277 278=item Comments 279 280 # It's a comment. 281 282Comments start with C<#> symbol and continue to the end of line. 283 284=item Conditional Directives 285 286 %ifdef name 287 %ifndef name 288 %endif 289 290A part of file surrounded by C<%ifdef I<name>> and C<%endif> directives is a conditional part -- it 291has effect only if I<name> is defined in the command line by B<--define> option. C<%ifndef> is a 292negated version of C<%ifdef> -- conditional part has an effect only if I<name> is B<not> defined. 293 294Conditional parts may be nested. 295 296=item Export Definitions 297 298 symbol 299 symbol ordinal 300 symbol DATA 301 302Symbols starting with C<omp_> or C<kmp_> must have ordinal specified. They are subjects for special 303processing: each symbol generates two output lines: original one and upper case version. The ordinal 304number of the second is original ordinal increased by 1000. 305 306=item Obsolete Symbols 307 308 - symbol 309 - symbol ordinal 310 - symbol DATA 311 312Obsolete symbols look like export definitions prefixed with minus sign. Obsolete symbols do not 313affect the output, but obsolete symbols and their ordinals cannot be (re)used in export definitions. 314 315=back 316 317=head1 EXAMPLES 318 319 $ generate-def.pl -D stub -D USE_TCHECK=0 -o libguide.def dllexport 320 321=cut 322 323# end of file # 324 325