include: Add binres.idl.
[wine] / tools / winapi / winapi_extract
1 #!/usr/bin/perl -w
2
3 # Copyright 2002 Patrik Stridvall
4 #
5 # This library is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU Lesser General Public
7 # License as published by the Free Software Foundation; either
8 # version 2.1 of the License, or (at your option) any later version.
9 #
10 # This library is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13 # Lesser General Public License for more details.
14 #
15 # You should have received a copy of the GNU Lesser General Public
16 # License along with this library; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
18 #
19
20 use strict;
21
22 BEGIN {
23     $0 =~ m%^(.*?/?tools)/winapi/winapi_extract$%;
24     require "$1/winapi/setup.pm";
25 }
26
27 use config qw(
28     files_skip files_filter get_spec_files
29     $current_dir $wine_dir $winapi_dir
30 );
31 use output qw($output);
32 use winapi_extract_options qw($options);
33
34 if($options->progress) {
35     $output->enable_progress;
36 } else {
37     $output->disable_progress;
38 }
39
40 use c_parser;
41 use function;
42 use type;
43
44 use winapi_function;
45
46 use vars qw($win16api $win32api @winapis);
47 if ($options->implemented || $options->stub_statistics || $options->winetest) {
48     require winapi;
49     import winapi qw($win16api $win32api @winapis);
50 }
51
52 my %module2entries;
53 my %module2spec_file;
54 if($options->winetest) {
55     local $_;
56
57     foreach my $spec_file (get_spec_files("winelib")) {
58         my $entries = [];
59
60         my $module = $spec_file;
61         $module =~ s/^.*?([^\/]*)\.spec$/$1/;
62
63         my $type = "win32";
64
65         open(IN, "< $wine_dir/$spec_file") || die "Error: Can't open $wine_dir/$spec_file: $!\n";
66
67         my $header = 1;
68         my $lookahead = 0;
69         while($lookahead || defined($_ = <IN>)) {
70             $lookahead = 0;
71
72             s/^\s*?(.*?)\s*$/$1/; # remove whitespace at beginning and end of line
73             s/^(.*?)\s*#.*$/$1/;  # remove comments
74             /^$/ && next;         # skip empty lines
75
76             if($header)  {
77                 if(/^(?:\d+|@)/) {
78                     $header = 0;
79                     $lookahead = 1;
80                 }
81                 next;
82             }
83
84             if(/^(\d+|@)\s+stdcall\s+(\w+)\s*\(\s*([^\)]*)\s*\)/) {
85                 my $ordinal = $1;
86                 my $name = $2;
87                 my @args = split(/\s+/, $3);
88
89                 push @$entries, [$name, "undef", \@args];
90             }
91         }
92         close(IN);
93
94         $module2spec_file{$module} = $spec_file;
95         $module2entries{$module} = $entries;
96     }
97 }
98
99 my %specifications;
100
101 sub documentation_specifications($) {
102     my $function = shift;
103
104     my @debug_channels = @{$function->debug_channels};
105     my $documentation = $function->documentation;
106     my $documentation_line = $function->documentation_line;
107     my $return_type = $function->return_type;
108     my $linkage = $function->linkage;
109     my $internal_name = $function->internal_name;
110
111     if($linkage eq "static") {
112         return;
113     }
114
115     local $_;
116     foreach (split(/\n/, $documentation)) {
117         if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*(\S+)\s*[\)\]]/) {
118             my $external_name = $1;
119             my $module = lc($2);
120             my $ordinal = $3;
121
122             if($ordinal eq "@") {
123                 if(1 || !exists($specifications{$module}{unfixed}{$external_name})) {
124                     $specifications{$module}{unfixed}{$external_name}{ordinal} = $ordinal;
125                     $specifications{$module}{unfixed}{$external_name}{external_name} = $external_name;
126                     $specifications{$module}{unfixed}{$external_name}{function} = $function;
127                 } else {
128                     $output->write("$external_name ($module.$ordinal) already exists\n");
129                 }
130             } elsif($ordinal =~ /^\d+$/) {
131                 if(1 || !exists($specifications{$module}{fixed}{$ordinal})) {
132                     $specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
133                     $specifications{$module}{fixed}{$ordinal}{external_name} = $external_name;
134                     $specifications{$module}{fixed}{$ordinal}{function} = $function;
135                     } else {
136                         $output->write("$external_name ($module.$ordinal) already exists\n");
137                     }
138             } elsif($ordinal eq "init") {
139                 if(!exists($specifications{$module}{init})) {
140                     $specifications{$module}{init}{function} = $function;
141                 } else {
142                     $output->write("$external_name ($module.$ordinal) already exists\n");
143                 }
144             } else {
145                 if(!exists($specifications{$module}{unknown}{$external_name})) {
146                     $specifications{$module}{unknown}{$external_name}{ordinal} = $ordinal;
147                     $specifications{$module}{unknown}{$external_name}{external_name} = $external_name;
148                     $specifications{$module}{unknown}{$external_name}{function} = $function;
149                 } else {
150                     $output->write("$external_name ($module.$ordinal) already exists\n");
151                 }
152             }
153
154             if($options->debug) {
155                 $output->write("$external_name ($module.$ordinal)\n");
156             }
157         }
158     }
159 }
160
161 my %module_pseudo_stub;
162
163 sub statements_pseudo_stub($) {
164     my $function = shift;
165
166     my $pseudo_stub = 0;
167     my $statements = $function->statements;
168     if(defined($statements) && $statements =~ /FIXME[^;]*stub/s) {
169         if($options->win16) {
170             my $external_name16 = $function->external_name16;
171             foreach my $module16 ($function->modules16) {
172                 $module_pseudo_stub{$module16}{$external_name16}++;
173                 $pseudo_stub = 1;
174             }
175         }
176         if($options->win32) {
177             my $external_name32 = $function->external_name32;
178             foreach my $module32 ($function->modules32) {
179                 $module_pseudo_stub{$module32}{$external_name32}++;
180                 $pseudo_stub = 1;
181             }
182         }
183     }
184
185     return $pseudo_stub;
186 }
187
188 my @h_files = ();
189 if($options->headers) {
190     @h_files = $options->h_files;
191     @h_files = files_skip(@h_files);
192     @h_files = files_filter("winelib", @h_files);
193 }
194
195 my @c_files = ();
196 if($options->pseudo_implemented || $options->pseudo_stub_statistics) {
197     @c_files = $options->c_files;
198     @c_files = files_skip(@c_files);
199     @c_files = files_filter("winelib", @c_files);
200 }
201
202 my $progress_output;
203 my $progress_current = 0;
204 my $progress_max = scalar(@h_files) + scalar(@c_files);
205
206 foreach my $file (@h_files, @c_files) {
207     my %functions;
208
209     $progress_current++;
210
211     {
212         open(IN, "< $file") || die "Error: Can't open $file: $!\n";
213         local $/ = undef;
214         $_ = <IN>;
215         close(IN);
216     }
217
218     my $max_line = 0;
219     {
220       local $_ = $_;
221       while(s/^.*?\n//) { $max_line++; }
222       if($_) { $max_line++; }
223     }
224
225     my $parser = new c_parser($file);
226
227     my $function;
228     my $line;
229
230     my $update_output = sub {
231         my $progress = "";
232         my $prefix = "";
233
234         $progress .= "$file (file $progress_current of $progress_max)";
235         $prefix .= "$file:";
236
237         if(defined($function)) {
238             my $name = $function->name;
239             my $begin_line = $function->begin_line;
240             my $begin_column = $function->begin_column;
241
242             $progress .= ": function $name";
243             $prefix .= "$begin_line.$begin_column: function $name: ";
244         } else {
245             $prefix .= " "; 
246         }
247
248         if(defined($line)) {
249             $progress .= ": line $line of $max_line";
250         }
251
252         $output->progress($progress);
253         $output->prefix($prefix);
254     };
255
256     &$update_output();
257
258     my $found_function = sub {
259         $function = shift;
260
261         my $name = $function->name;
262         $functions{$name} = $function;
263
264         if ($function->statements) {
265             &$update_output();
266         }
267
268         my $old_function;
269         if($options->implemented || $options->stub_statistics) {
270             $old_function = 'winapi_function'->new;
271         } else {
272             $old_function = 'function'->new;
273         }
274
275         $old_function->file($function->file);
276         $old_function->debug_channels([]); # FIXME: Not complete
277
278         $old_function->documentation_line(0); # FIXME: Not complete
279         $old_function->documentation(""); # FIXME: Not complete
280
281         $old_function->function_line($function->begin_line());
282         $old_function->linkage($function->linkage);
283         $old_function->return_type($function->return_type);
284         $old_function->calling_convention($function->calling_convention);
285         $old_function->internal_name($function->name);
286         if (defined($function->argument_types)) {
287             $old_function->argument_types([@{$function->argument_types}]);
288         }
289         if (defined($function->argument_names)) {
290             $old_function->argument_names([@{$function->argument_names}]);
291         }
292         $old_function->argument_documentations([]); # FIXME: Not complete
293         $old_function->statements_line($function->statements_line);
294         $old_function->statements($function->statements);
295
296         if($options->winetest) {
297             documentation_specifications($old_function);
298         }
299
300         if ($function->statements) {
301             $function = undef;
302             &$update_output();
303         } else {
304             $function = undef;
305         }
306
307         my $pseudo_stub = 0;
308         if ($options->pseudo_implemented || $options->pseudo_stub_statistics) {
309             $pseudo_stub = statements_pseudo_stub($old_function);
310         }
311
312         my $module = $old_function->module;
313         my $external_name = $old_function->external_name;
314         my $statements = $old_function->statements;
315         if ($options->pseudo_implemented && $module && $external_name && $statements) {
316             my @external_names = split(/\s*&\s*/, $external_name);
317             my @modules = split(/\s*&\s*/, $module);
318
319             my @external_names2;
320             while(defined(my $external_name = shift @external_names) &&
321                   defined(my $module = shift @modules))
322             {
323                 if ($pseudo_stub) {
324                     $output->write("$module.$external_name: pseudo implemented\n");
325                 } else {
326                     $output->write("$module.$external_name: implemented\n");
327                 }
328             }
329         }
330     };
331     $parser->set_found_function_callback($found_function);
332
333     my $found_line = sub {
334         $line = shift;
335
336         &$update_output;
337     };
338     $parser->set_found_line_callback($found_line);
339
340     my $found_type = sub {
341         my $type = shift;
342
343         &$update_output();
344         
345         my $kind = $type->kind;
346         my $_name = $type->_name;
347         my $name = $type->name;
348         
349         foreach my $field ($type->fields) {
350             my $field_type_name = $field->type_name;
351             my $field_name = $field->name;
352
353             if ($options->struct && $kind =~ /^(?:struct|union)$/) {
354                 if ($name) {
355                     $output->write("$name:$field_type_name:$field_name\n");
356                 } else {
357                     $output->write("$kind $_name:$field_type_name:$field_name\n");
358                 }
359             }
360         }
361
362         return 1;
363     };
364     $parser->set_found_type_callback($found_type);
365
366     {
367         my $line = 1;
368         my $column = 0;
369         if(!$parser->parse_c_file(\$_, \$line, \$column)) {
370             $output->write("can't parse file\n");
371         }
372     }
373
374     $output->prefix("");
375 }
376
377
378 if($options->implemented && !$options->pseudo_implemented) {
379     foreach my $winapi (@winapis) {
380         my $type = $winapi->name;
381
382         if($type eq "win16" && !$options->win16) { next; }
383         if($type eq "win32" && !$options->win32) { next; }
384
385         foreach my $module ($winapi->all_modules) {
386             foreach my $external_name ($winapi->all_functions_in_module($module)) {
387                  my $external_calling_convention =
388                      $winapi->function_external_calling_convention_in_module($module, $external_name);
389
390                  if($external_calling_convention eq "forward") {
391                      (my $forward_module, my $forward_external_name) =
392                          $winapi->function_forward_final_destination($module, $external_name);
393
394                      my $forward_external_calling_convention =
395                          $winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
396
397                      if(!defined($forward_external_calling_convention)) {
398                          next;
399                      }
400
401                      $external_calling_convention = $forward_external_calling_convention;
402                  }
403
404                  if ($external_calling_convention ne "stub") {
405                      $output->write("*.spec: $module.$external_name: implemented\n");
406                  }
407             }
408         }
409     }
410 }
411
412 sub output_function($$$$$) {
413     local *OUT = shift;
414     my $type = shift;
415     my $ordinal = shift;
416     my $external_name = shift;
417     my $function = shift;
418
419     my $internal_name = $function->internal_name;
420
421     my $return_kind;
422     my $calling_convention;
423     my $refargument_kinds;
424     if($type eq "win16") {
425         $return_kind = $function->return_kind16 || "undef";
426         $calling_convention = $function->calling_convention16 || "undef";
427         $refargument_kinds = $function->argument_kinds16;
428     } elsif($type eq "win32") {
429         $return_kind = $function->return_kind32 || "undef";
430         $calling_convention = $function->calling_convention32 || "undef";
431         $refargument_kinds = $function->argument_kinds32;
432     }
433
434     if(defined($refargument_kinds)) {
435         my @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
436         print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
437     } else {
438         print OUT "$ordinal $calling_convention $external_name() $internal_name # FIXME: arguments undefined\n";
439     }
440 }
441
442 if($options->stub_statistics) {
443     foreach my $winapi (@winapis) {
444         my $type = $winapi->name;
445
446         if($type eq "win16" && !$options->win16) { next; }
447         if($type eq "win32" && !$options->win32) { next; }
448
449         my %module_counts;
450          foreach my $module ($winapi->all_modules) {
451              foreach my $external_name ($winapi->all_functions_in_module($module)) {
452                  my $external_calling_convention =
453                      $winapi->function_external_calling_convention_in_module($module, $external_name);
454                  if($external_calling_convention !~ /^(?:forward|stub)$/) {
455                      if($module_pseudo_stub{$module}{$external_name}) {
456                          $external_calling_convention = "pseudo_stub";
457                      }
458                  } elsif($external_calling_convention eq "forward") {
459                      (my $forward_module, my $forward_external_name) =
460                          $winapi->function_forward_final_destination($module, $external_name);
461
462                      my $forward_external_calling_convention =
463                          $winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
464
465                      if(!defined($forward_external_calling_convention)) {
466                          next;
467                      }
468
469                      if($forward_external_calling_convention ne "stub" &&
470                         $module_pseudo_stub{$forward_module}{$forward_external_name})
471                      {
472                          $forward_external_calling_convention = "pseudo_stub";
473                      }
474
475                      $external_calling_convention = "forward_$forward_external_calling_convention";
476                  }
477
478                  $module_counts{$module}{$external_calling_convention}++;
479              }
480          }
481
482         foreach my $module ($winapi->all_modules) {
483             my $pseudo_stubs = $module_counts{$module}{pseudo_stub} || 0;
484             my $real_stubs = $module_counts{$module}{stub} || 0;
485             my $forward_pseudo_stubs = $module_counts{$module}{forward_pseudo_stub} || 0;
486             my $forward_real_stubs = $module_counts{$module}{forward_stub} || 0;
487
488             my $forwards = 0;
489             my $total = 0;
490             foreach my $calling_convention (keys(%{$module_counts{$module}})) {
491                 my $count = $module_counts{$module}{$calling_convention};
492                 if($calling_convention =~ /^forward/) {
493                     $forwards += $count;
494                 }
495                 $total += $count;
496             }
497
498             if($total > 0) {
499                 my $stubs = $real_stubs + $pseudo_stubs;
500
501                 $output->write("*.c: $module: ");
502                 $output->write("$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo) " .
503                                "and $forwards are forwards\n");
504             }
505
506             if($forwards > 0) {
507                 my $forward_stubs = $forward_real_stubs + $forward_pseudo_stubs;
508
509                 $output->write("*.c: $module: ");
510                 $output->write("$forward_stubs of $forwards forwarded functions are stubs " .
511                                "($forward_real_stubs real, $forward_pseudo_stubs pseudo)\n");
512             }
513         }
514     }
515 }
516
517 if($options->winetest) {
518     foreach my $module ($win32api->all_modules) {
519         my $type = "win32";
520
521         my $package = $module;
522         $package =~ s/\.dll$//;
523         $package =~ s/\./_/g;
524
525         my @entries;
526
527         foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
528             my $entry = $specifications{$module}{unknown}{$external_name};
529             push @entries, $entry;
530         }
531
532         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
533             my $entry = $specifications{$module}{fixed}{$ordinal};
534             push @entries, $entry;
535         }
536
537         foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
538             my $entry = $specifications{$module}{unfixed}{$external_name};
539             push @entries, $entry;
540         }
541
542         my $n = 0;
543         foreach my $entry (@entries) {
544             my $external_name = $entry->{external_name};
545             my $ordinal = $entry->{ordinal};
546             my $function = $entry->{function};
547
548             my $return_kind = $function->return_kind32 || "undef";
549             my $calling_convention = $function->calling_convention32 || "undef";
550             my $refargument_kinds = $function->argument_kinds32;
551
552             my @argument_kinds;
553             if(defined($refargument_kinds)) {
554                 @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
555             }
556
557             next if $calling_convention ne "stdcall";
558             next if $external_name eq "\@";
559
560             if($n == 0) {
561                 open(OUT, "> $wine_dir/programs/winetest/include/${package}.pm") || die "Error: Can't open $wine_dir/programs/winetest/include/${package}.pm: $!\n";
562
563                 print OUT "package ${package};\n";
564                 print OUT "\n";
565
566                 print OUT "use strict;\n";
567                 print OUT "\n";
568
569                 print OUT "require Exporter;\n";
570                 print OUT "\n";
571
572                 print OUT "use wine;\n";
573                 print OUT "use vars qw(\@ISA \@EXPORT \@EXPORT_OK);\n";
574                 print OUT "\n";
575
576                 print OUT "\@ISA = qw(Exporter);\n";
577                 print OUT "\@EXPORT = qw();\n";
578                 print OUT "\@EXPORT_OK = qw();\n";
579                 print OUT "\n";
580
581                 print OUT "my \$module_declarations = {\n";
582             } elsif($n > 0) {
583                 print OUT ",\n";
584             }
585
586             print OUT "    \"\Q$external_name\E\" => [\"$return_kind\",  [";
587             my $m = 0;
588             foreach my $argument_kind (@argument_kinds) {
589                 if($m > 0) {
590                     print OUT ", ";
591                 }
592                 print OUT "\"$argument_kind\"";
593                 $m++;
594             }
595             print OUT "]]";
596             $n++;
597         }
598
599         if($n > 0) {
600             print OUT "\n";
601             print OUT "};\n";
602             print OUT "\n";
603             print OUT "&wine::declare(\"$module\",\%\$module_declarations);\n";
604             print OUT "push \@EXPORT, map { \"&\" . \$_; } sort(keys(\%\$module_declarations));\n";
605             print OUT "1;\n";
606             close(OUT);
607         }
608     }
609 }