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