b32d5e8f3e04d8d0c16625a325203fbc4f786c5f
[panamaz] / src / export-defines
1 #!/usr/bin/perl
2
3 use File::Basename;
4
5 use Data::Dumper;
6
7 my $scriptPath = dirname(__FILE__);
8 push @INC,$scriptPath;
9
10 require genconfig;
11 require genconfig2;
12
13 my @includes = ();
14 my $header;
15 my $control = "api-defines.def";
16 my $output;
17 my $hackformat;
18
19 while (@ARGV) {
20         my $cmd = shift;
21
22         if ($cmd eq "-t") {
23                 $package = shift;
24     } elsif ($cmd eq "-d") {
25                 $output = shift;
26     } elsif ($cmd eq "-v") {
27                 $verbose++;
28         } elsif ($cmd eq "-I") {
29                 push @includes, shift;
30         } elsif ($cmd eq "--hack-new-format") {
31                 $hackformat = 1;
32         } elsif ($cmd eq "--hack-new-format-2") {
33                 $hackformat = 2;
34         } else {
35                 $control = $cmd;
36         }
37 }
38
39 die ("no output specified") if !$output;
40
41 my $defs;
42 my @xports;
43 if ($hackformat == 1) {
44         $defs = genconfig::loadControlFile($control);
45         @exports = grep { $_->{type} eq 'define' } @{$defs};
46 } elsif ($hackformat == 2) {
47         push @includes, $scriptPath;
48         my $conf = new genconfig2({ include => \@includes }, $control);
49         $defs = $conf->{objects};
50         @exports = grep { $_->{type} eq 'define' } @{$defs};
51 } else {
52         $defs = loadControlFile($control);
53         @exports = @{$defs->{define}};
54 }
55 my %rawDefines = (); # indexed by header
56
57 my $CPPFLAGS = "";
58
59 foreach $i (@includes) {
60         $CPPFLAGS .= " '-I$i'";
61 }
62
63 # flatten the generic format to a more usable format, work out defaults (. and syntax check?)
64 foreach $export (@exports) {
65         my $includes = 0, $excludes = 0;
66
67         foreach $inc (@{$export->{items}}) {
68                 my @options = @{$inc->{options}};
69
70                 if ($inc->{match} =~ m@^/(.*)/$@) {
71                         print "$export->{name} - $inc->{match} - regex $1\n";
72                         $inc->{regex} = qr/$1/;
73                 } else {
74                         $inc->{regex} = qr/^$inc->{match}$/;
75                 }
76
77                 $inc->{mode} = "include";
78                 foreach $o (@{$inc->{options}}) {
79                         if ($o =~ m/^(exclude|include|file-include|file-exclude)$/) {
80                                 $inc->{mode} = $o;
81                         }
82                 }
83                 if ($inc->{mode} =~ m/include/) {
84                         $includes += 1;
85                 } else {
86                         $excludes += 1;
87                 }
88         }
89
90         $export->{default} = 'all';
91         $export->{default} = 'none' if ($includes > 0);
92
93         my @options = @{$export->{options}};
94
95         foreach $o (@options) {
96                 if ($o =~ m/header=(.*)/) {
97                         $export->{header} = $1;
98                 } elsif ($o =~ m/default=(.*)/) {
99                         $export->{default} = $1;
100                 } elsif ($#options == 0) {
101                         $export->{header} = $o;
102                 } else {
103                         print STDERR "unknown defines option '$o'\n";
104                 }
105         }
106
107         # insert ignore <built-in> thing
108         if ($export->{default} eq 'all') {
109                 unshift @{$export->{items}}, { regex => qr/<built-in>/, mode => 'file-exclude' };
110         }
111
112         die ("no header for '$export->{name}'") if !$export->{header};
113 }
114
115 # load all defines once and link in
116 # keep_comments is a bit broken
117 foreach $export (@exports) {
118         my $header = $export->{header};
119
120         if (!defined($rawDefines{$header})) {
121                 $rawDefines{$header} = scanDefines($header, { CPPFLAGS=>$cppflags, keep_comments=>0 });
122         }
123
124         $export->{rawDefines} = $rawDefines{$header};
125 }
126
127 foreach $export (@exports) {
128         # extract matching #defines
129         my @defines = ();
130
131         foreach $d (@{$export->{rawDefines}}) {
132                 my $output = 0;
133                 my $matches = 0;
134
135                 print "? $d->{name} $d->{file} " if $verbose;
136                 foreach $inc (@{$export->{items}}) {
137                         if ($inc->{mode} eq "include") {
138                                 $matches = $d->{name} =~ m/$inc->{regex}/;
139                                 $output = 1 if $matches;
140                         } elsif ($inc->{mode} eq "exclude") {
141                                 $matches = $d->{name} =~ m/$inc->{regex}/;
142                         } elsif ($inc->{mode} eq "file-include") {
143                                 $matches = $d->{file} =~ m/$inc->{regex}/;
144                                 $output = 1 if $matches;
145                         } elsif ($inc->{mode} eq "file-exclude") {
146                                 $matches = $d->{file} =~ m/$inc->{regex}/;
147                         }
148                         print " ($inc->{mode} '$inc->{match}' '$inc->{regex}' =$matches)" if $verbose;
149                         last if $matches;
150                 }
151
152                 $output = 1 if (!$matches && $export->{default} eq "all");
153
154                 print " output=$output\n" if $verbose;
155
156                 push (@{$export->{export}}, $d) if $output;
157         }
158
159 }
160
161 open (my $fh, ">", "$output~") || die("can't open $output~ for writing");
162
163 export($fh, \@exports);
164
165 close ($fh) || die("error writing");
166 rename "$output~",$output || die("error overwriting $output");
167
168 exit 0;
169
170 # ######################################################################
171
172 sub uniq {
173   my %seen;
174   return grep { !$seen{$_}++ } @_;
175 }
176
177 sub export {
178         my $fp = shift;
179         my @exports = @{shift @_};
180
181         print $fp <<END;
182 #include <stdio.h>
183 #include <stdint.h>
184 END
185         foreach $h (uniq map { $_->{header} } @exports) {
186                 print $fp  "#include \"$h\"\n";
187         }
188
189         # this is effectively a function overloading system so that the
190         # compiler can select the datatype of the evaluation of the
191         # definition.
192         print $fp <<END;
193 /* note unsigned types are output as signed for java compatability */
194 /* unsigned long long might not be 64 bit i guess, could use sizeof i suppose */
195 #define FMT(x) \\
196         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), float),    "value=>'%a', type=>'f32'", \\
197         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), double),   "value=>'%a', type=>'f64'", \\
198         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), int32_t),  "value=>'%d', type=>'i32'", \\
199         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), uint32_t), "value=>'0x%08x', type=>'u32'", \\
200         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), int64_t),  "value=>'%ld', type=>'i64'", \\
201         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), uint64_t), "value=>'0x%016lx', type=>'u64'", \\
202         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), unsigned long long), "value=>'0x%016llx', type=>'u64'", \\
203         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), long long), "value=>'0x%016llx', type=>'i64'", \\
204         __builtin_choose_expr(__builtin_types_compatible_p(typeof(x), typeof(char[])),  "value=>'%s', type=>'string'", "type => undefined" )))))))))
205
206 int main(int argc, char **argv) {
207  FILE *fp = fopen(argv[1], "w");
208
209  fputs("{\\n", fp);
210 END
211
212         foreach $export (@exports) {
213                 print $fp <<END;
214 fputs("'define:$export->{name}' => { name => '$export->{name}', type => 'define', values => [\\n", fp);
215 END
216                 foreach $d (@{$export->{export}}) {
217                         my $docomment;
218
219                         if ($d->{comment}) {
220                                 my $comment = $d->{comment};
221                                 $comment =~ s@(['"])@\\\\\\$1@g;
222                                 $comment =~ s@\n@\\n@g;
223                                 $docomment = ", comment => '$comment' ";
224                         }
225
226                         print $fp <<END;
227  fputs("  { name => \\"$d->{name}\\", ", fp);
228  fprintf(fp, FMT($d->{name}), ($d->{name}));
229  fputs("$docomment},\\n", fp);
230 END
231                 }
232                 print $fp <<END;
233  fputs(" ],\\n},\\n", fp);
234 END
235         }
236         print $fp <<END;
237  fprintf(fp, "}\\n");
238  fclose(fp);
239 }
240 END
241 }
242
243 # args: filename, \@defines, \@defineList
244 # export a c file generator
245 sub export_generator {
246         my $filename = shift;
247         my @defines = @{shift @_};
248         my @defineList = @{shift @_};
249 }
250
251 # args: header, \%options
252 # options = {
253 #   CPPFLAGS => 'flags'
254 #   keep_comments => 1 to keep comments
255 # }
256 # returns a list of
257 # {
258 #   name=>'name',
259 #   comment='comment',
260 #   file='filename',
261 #   line=linenumber
262 # }
263 sub scanDefines {
264         my $header = shift;
265         my %o = %{shift @_};
266     my $lastc = "";
267         my $source;
268         my $sourceLine;
269
270     print STDERR "Scanning $header\n";
271
272     open (my $in,"-|","cpp -dD ".($o{keep_comments} ? '-CC' : '')." $o{CPPFLAGS} $header") || die("Can't find include file: $header");
273     while (<$in>) {
274                 # line markers
275                 if (m/^\# (\d+) \"([^\"]*)/) {
276                         $sourceLine = $1;
277                         $source = $2;
278                         next;
279                 }
280                 # accumulate comments
281                 # single line comments override multi-line
282                 if ($o{keep_comments}) {
283                         if (m@/\*(.*)\*/@) {
284                                 do {
285                                         $lastc = $1 if $lastc eq "";
286                                         s@/\*.*\*/@@;
287                                 } while (m@/\*(.*)\*/@);
288                         } elsif (m@/\*(.*)@) {
289                                 my $com = "$1\n" if $1;
290                                 while (<$in>) {
291                                         chop;
292                                         if (m@(.*)\*/@) {
293                                                 $com .= $1 if $1;
294                                                 last;
295                                         } else {
296                                                 $com .= "$_\n";
297                                         }
298                                 }
299                                 $lastc = $com if $com && $lastc eq "";
300                         } elsif (m@//(.*)@) {
301                                 $lastc = $1 if $1;
302                                 s@//.*@@;
303                         }
304                 }
305
306                 if (m/^\s*#define\s+(\w*)\(/) {
307                         # ignore macros
308                         $lastc = "";
309                 } elsif (m/^\s*#define\s+(\w*)\s*$/) {
310                         # ignore empty defines
311                         $lastc = "";
312                 } elsif (m/^\s*#define\s+(\w+)/) {
313                         my $name = $1;
314                         my %define = ();
315
316                         $define{name} = $name;
317                         $define{comment} = $lastc if $lastc ne "";
318                         $define{file} = $source;
319                         $define{line} = $sourceLine;
320
321                         push @defines, \%define;
322
323                         $lastc = "";
324                 }
325
326                 $sourceLine++;
327         }
328         close $in;
329
330         return \@defines;
331 }
332
333 # TODO: library
334 sub loadControlFile {
335         my $path = shift @_;
336         my %def = ();
337         my $target;
338
339         open (my $d,"<",$path);
340
341         while (<$d>) {
342                 next if /\s*\#/;
343
344                 chop;
345
346                 if ($target) {
347                         if (m/\s*\}\s*$/) {
348                                 undef $target;
349                         } elsif (/^\s*(\S+)\s*(.*)/) {
350                                 my @options = split(/\s+/,$2);
351                                 push @{$target->{items}}, {
352                                         match => $1,
353                                         options => \@options
354                                 };
355                         }
356                 } elsif (/^(\w+)\s+(\S*)\s*(.*)\s+\{/) {
357                         my @options = split(/\s+/,$3);
358
359                         $target = {
360                                 type => $1,
361                                 name => $2,
362                                 options => \@options,
363                                 items => []
364                         };
365                         push @{$def{$1}}, $target;
366                 } elsif (/\S/) {
367                         die("invalid line: %_");
368                 }
369         }
370
371         close $d;
372
373         return \%def;
374 }