Minor modifications and improvements.
[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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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     &file_type &files_skip &files_filter &get_spec_files
29     $current_dir $wine_dir $winapi_dir $winapi_check_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_c_parser;
45 use winapi_function;
46
47 use vars qw($win16api $win32api @winapis);
48 if ($options->spec_files || $options->implemented || $options->stub_statistics || $options->winetest) {
49     require winapi;
50     import winapi qw($win16api $win32api @winapis);
51 }
52
53 my %module2entries;
54 my %module2spec_file;
55 if($options->spec_files || $options->winetest) {
56     local $_;
57
58     foreach my $spec_file (get_spec_files("winelib")) {
59         my $entries = [];
60
61         my $module = $spec_file;
62         $module =~ s/^.*?([^\/]*)\.spec$/$1/;
63
64         my $type = "win32";
65
66         open(IN, "< $wine_dir/$spec_file");
67
68         my $header = 1;
69         my $lookahead = 0;
70         while($lookahead || defined($_ = <IN>)) {
71             $lookahead = 0;
72
73             s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begining and end of line
74             s/^(.*?)\s*#.*$/$1/;  # remove comments
75             /^$/ && next;         # skip empty lines
76
77             if($header)  {
78                 if(/^\d+|@/) {
79                     $header = 0;
80                     $lookahead = 1;
81                 }
82                 next;
83             }
84
85             if(/^(@|\d+)\s+stdcall\s+(\w+)\s*\(\s*([^\)]*)\s*\)/) {
86                 my $ordinal = $1;
87                 my $name = $2;
88                 my @args = split(/\s+/, $3);
89
90                 push @$entries, [$name, "undef", \@args];
91             }
92         }
93         close(IN);
94
95         $module2spec_file{$module} = $spec_file;
96         $module2entries{$module} = $entries;
97     }
98 }
99
100 my %specifications;
101
102 sub documentation_specifications {
103     my $function = shift;
104
105     my @debug_channels = @{$function->debug_channels};
106     my $documentation = $function->documentation;
107     my $documentation_line = $function->documentation_line;
108     my $return_type = $function->return_type;
109     my $linkage = $function->linkage;
110     my $internal_name = $function->internal_name;
111
112     if($linkage eq "static") {
113         return;
114     }
115
116     local $_;
117     foreach (split(/\n/, $documentation)) {
118         if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*(\S+)\s*[\)\]]/) {
119             my $external_name = $1;
120             my $module = lc($2);
121             my $ordinal = $3;
122
123             if($ordinal eq "@") {
124                 if(1 || !exists($specifications{$module}{unfixed}{$external_name})) {
125                     $specifications{$module}{unfixed}{$external_name}{ordinal} = $ordinal;
126                     $specifications{$module}{unfixed}{$external_name}{external_name} = $external_name;
127                     $specifications{$module}{unfixed}{$external_name}{function} = $function;
128                 } else {
129                     $output->write("$external_name ($module.$ordinal) already exists\n");
130                 }
131             } elsif($ordinal =~ /^\d+$/) {
132                 if(1 || !exists($specifications{$module}{fixed}{$ordinal})) {
133                     $specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
134                     $specifications{$module}{fixed}{$ordinal}{external_name} = $external_name;
135                     $specifications{$module}{fixed}{$ordinal}{function} = $function;
136                     } else {
137                         $output->write("$external_name ($module.$ordinal) already exists\n");
138                     }
139             } elsif($ordinal eq "init") {
140                 if(!exists($specifications{$module}{init})) {
141                     $specifications{$module}{init}{function} = $function;
142                 } else {
143                     $output->write("$external_name ($module.$ordinal) already exists\n");
144                 }
145             } else {
146                 if(!exists($specifications{$module}{unknown}{$external_name})) {
147                     $specifications{$module}{unknown}{$external_name}{ordinal} = $ordinal;
148                     $specifications{$module}{unknown}{$external_name}{external_name} = $external_name;
149                     $specifications{$module}{unknown}{$external_name}{function} = $function;
150                 } else {
151                     $output->write("$external_name ($module.$ordinal) already exists\n");
152                 }
153             }
154
155             if($options->debug) {
156                 $output->write("$external_name ($module.$ordinal)\n");
157             }
158         }
159     }
160 }
161
162 my %module_pseudo_stub;
163
164 sub statements_pseudo_stub {
165     my $function = shift;
166
167     my $pseudo_stub = 0;
168     my $statements = $function->statements;
169     if(defined($statements) && $statements =~ /FIXME[^;]*stub/s) {
170         if($options->win16) {
171             my $external_name16 = $function->external_name16;
172             foreach my $module16 ($function->modules16) {
173                 $module_pseudo_stub{$module16}{$external_name16}++;
174                 $pseudo_stub = 1;
175             }
176         }
177         if($options->win32) {
178             my $external_name32 = $function->external_name32;
179             foreach my $module32 ($function->modules32) {
180                 $module_pseudo_stub{$module32}{$external_name32}++;
181                 $pseudo_stub = 1;
182             }
183         }
184     }
185
186     return $pseudo_stub;
187 }
188
189 my @h_files = ();
190 if($options->headers) {
191     @h_files = $options->h_files;
192     @h_files = files_skip(@h_files);
193     @h_files = files_filter("winelib", @h_files);
194 }
195
196 my @c_files = ();
197 if($options->spec_files || $options->pseudo_implemented || $options->pseudo_stub_statistics) {
198     @c_files = $options->c_files;
199     @c_files = files_skip(@c_files);
200     @c_files = files_filter("winelib", @c_files);
201 }
202
203 my $progress_output;
204 my $progress_current = 0;
205 my $progress_max = scalar(@h_files) + scalar(@c_files);
206
207 foreach my $file (@h_files, @c_files) {
208     my %functions;
209
210     $progress_current++;
211
212     {
213         open(IN, "< $file");
214         local $/ = undef;
215         $_ = <IN>;
216         close(IN);
217     }
218
219     my $max_line = 0;
220     {
221       local $_ = $_;
222       while(s/^.*?\n//) { $max_line++; }
223       if($_) { $max_line++; }
224     }
225
226     my $parser;
227     if (!$options->old) {
228         $parser = new c_parser($file);
229     } else {
230         $parser = new winapi_c_parser($file);
231     }
232
233     my $function;
234     my $line;
235
236     my $update_output = sub {
237         my $progress = "";
238         my $prefix = "";
239
240         $progress .= "$file (file $progress_current of $progress_max)";
241         $prefix .= "$file:";
242
243         if(defined($function)) {
244             my $name = $function->name;
245             my $begin_line = $function->begin_line;
246             my $begin_column = $function->begin_column;
247
248             $progress .= ": function $name";
249             $prefix .= "$begin_line.$begin_column: function $name: ";
250         } else {
251             $prefix .= " "; 
252         }
253
254         if(defined($line)) {
255             $progress .= ": line $line of $max_line";
256         }
257
258         $output->progress($progress);
259         $output->prefix($prefix);
260     };
261
262     &$update_output();
263
264     my $found_function = sub {
265         $function = shift;
266
267         my $name = $function->name;
268         $functions{$name} = $function;
269
270         if ($function->statements) {
271             &$update_output();
272         }
273
274         my $old_function;
275         if($options->implemented || $options->stub_statistics) {
276             $old_function = 'winapi_function'->new;
277         } else {
278             $old_function = 'function'->new;
279         }
280
281         $old_function->file($function->file);
282         $old_function->debug_channels([]); # FIXME: Not complete
283
284         $old_function->documentation_line(0); # FIXME: Not complete
285         $old_function->documentation(""); # FIXME: Not complete
286
287         $old_function->function_line($function->begin_line());
288         $old_function->linkage($function->linkage);
289         $old_function->return_type($function->return_type);
290         $old_function->calling_convention($function->calling_convention);
291         $old_function->internal_name($function->name);
292         if (defined($function->argument_types)) {
293             $old_function->argument_types([@{$function->argument_types}]);
294         }
295         if (defined($function->argument_names)) {
296             $old_function->argument_names([@{$function->argument_names}]);
297         }
298         $old_function->argument_documentations([]); # FIXME: Not complete
299         $old_function->statements_line($function->statements_line);
300         $old_function->statements($function->statements);
301
302         if($options->spec_files || $options->winetest) {
303             documentation_specifications($old_function);
304         }
305
306         if ($function->statements) {
307             $function = undef;
308             &$update_output();
309         } else {
310             $function = undef;
311         }
312
313         my $pseudo_stub = 0;
314         if ($options->pseudo_implemented || $options->pseudo_stub_statistics) {
315             $pseudo_stub = statements_pseudo_stub($old_function);
316         }
317
318         my $module = $old_function->module;
319         my $external_name = $old_function->external_name;
320         my $statements = $old_function->statements;
321         if ($options->pseudo_implemented && $module && $external_name && $statements) {
322             my @external_names = split(/\s*&\s*/, $external_name);
323             my @modules = split(/\s*&\s*/, $module);
324
325             my @external_names2;
326             while(defined(my $external_name = shift @external_names) &&
327                   defined(my $module = shift @modules))
328             {
329                 if ($pseudo_stub) {
330                     $output->write("$module.$external_name: pseudo implemented\n");
331                 } else {
332                     $output->write("$module.$external_name: implemented\n");
333                 }
334             }
335         }
336     };
337     $parser->set_found_function_callback($found_function);
338
339     my $found_line = sub {
340         $line = shift;
341
342         &$update_output;
343     };
344     $parser->set_found_line_callback($found_line);
345
346     my $found_type = sub {
347         my $type = shift;
348
349         &$update_output();
350         
351         my $kind = $type->kind;
352         my $_name = $type->_name;
353         my $name = $type->name;
354         
355         foreach my $field ($type->fields) {
356             my $field_type_name = $field->type_name;
357             my $field_name = $field->name;
358
359             if ($options->struct && $kind =~ /^(?:struct|union)$/) {
360                 if ($name) {
361                     $output->write("$name:$field_type_name:$field_name\n");
362                 } else {
363                     $output->write("$kind $_name:$field_type_name:$field_name\n");
364                 }
365             }
366         }
367
368         return 1;
369     };
370     $parser->set_found_type_callback($found_type);
371
372     {
373         my $line = 1;
374         my $column = 0;
375         if(!$parser->parse_c_file(\$_, \$line, \$column)) {
376             $output->write("can't parse file\n");
377         }
378     }
379
380     $output->prefix("");
381 }
382
383
384 if($options->implemented && !$options->pseudo_implemented) {
385     foreach my $winapi (@winapis) {
386         my $type = $winapi->name;
387
388         if($type eq "win16" && !$options->win16) { next; }
389         if($type eq "win32" && !$options->win32) { next; }
390
391         foreach my $module ($winapi->all_modules) {
392             foreach my $external_name ($winapi->all_functions_in_module($module)) {
393                  my $external_calling_convention =
394                      $winapi->function_external_calling_convention_in_module($module, $external_name);
395
396                  if($external_calling_convention eq "forward") {
397                      (my $forward_module, my $forward_external_name) =
398                          $winapi->function_forward_final_destination($module, $external_name);
399
400                      my $forward_external_calling_convention =
401                          $winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
402
403                      if(!defined($forward_external_calling_convention)) {
404                          next;
405                      }
406
407                      $external_calling_convention = $forward_external_calling_convention;
408                  }
409
410                  if ($external_calling_convention ne "stub") {
411                      $output->write("*.spec: $module.$external_name: implemented\n");
412                  }
413             }
414         }
415     }
416 }
417
418 sub output_function {
419     local *OUT = shift;
420     my $type = shift;
421     my $ordinal = shift;
422     my $external_name = shift;
423     my $function = shift;
424
425     my $internal_name = $function->internal_name;
426
427     my $return_kind;
428     my $calling_convention;
429     my $refargument_kinds;
430     if($type eq "win16") {
431         $return_kind = $function->return_kind16 || "undef";
432         $calling_convention = $function->calling_convention16 || "undef";
433         $refargument_kinds = $function->argument_kinds16;
434     } elsif($type eq "win32") {
435         $return_kind = $function->return_kind32 || "undef";
436         $calling_convention = $function->calling_convention32 || "undef";
437         $refargument_kinds = $function->argument_kinds32;
438     }
439
440     if(defined($refargument_kinds)) {
441         my @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
442         print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
443     } else {
444         print OUT "$ordinal $calling_convention $external_name() $internal_name # FIXME: arguments undefined\n";
445     }
446 }
447
448 if($options->spec_files) {
449     foreach my $winapi (@winapis) {
450         my $type = $winapi->name;
451
452         if($type eq "win16" && !$options->win16) { next; }
453         if($type eq "win32" && !$options->win32) { next; }
454
455         foreach my $module ($winapi->all_modules) {
456             my $spec_file = $module2spec_file{$module};
457
458             if(!defined($spec_file) || !defined($type)) {
459                 $output->write("$module: doesn't exist\n");
460                 next;
461             }
462
463             $spec_file .= "2";
464
465             $output->progress("$spec_file");
466             open(OUT, "> $wine_dir/$spec_file");
467
468             if(exists($specifications{$module}{init})) {
469                 my $function = $specifications{$module}{init}{function};
470                 print OUT "init " . $function->internal_name . "\n";
471             }
472             print OUT "\n";
473
474             my %debug_channels;
475             if(exists($specifications{$module}{init})) {
476                 my $function = $specifications{$module}{init}{function};
477                 foreach my $debug_channel (@{$function->debug_channels}) {
478                     $debug_channels{$debug_channel}++;
479                 }
480             }
481             foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
482                 my $function = $specifications{$module}{fixed}{$ordinal}{function};
483                 foreach my $debug_channel (@{$function->debug_channels}) {
484                     $debug_channels{$debug_channel}++;
485                 }
486             }
487             foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
488                 my $function = $specifications{$module}{unfixed}{$name}{function};
489                 foreach my $debug_channel (@{$function->debug_channels}) {
490                     $debug_channels{$debug_channel}++;
491                 }
492             }
493             foreach my $name (sort(keys(%{$specifications{$module}{unknown}}))) {
494                 my $function = $specifications{$module}{unknown}{$name}{function};
495                 foreach my $debug_channel (@{$function->debug_channels}) {
496                     $debug_channels{$debug_channel}++;
497                 }
498             }
499
500             my @debug_channels = sort(keys(%debug_channels));
501             if($#debug_channels >= 0) {
502                 print OUT "debug_channels (" .  join(" ", @debug_channels) . ")\n";
503                 print OUT "\n";
504             }
505
506             my $empty = 1;
507
508             if(!$empty) {
509                 print OUT "\n";
510                 $empty = 1;
511             }
512             foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
513                 my $entry = $specifications{$module}{unknown}{$external_name};
514                 my $ordinal = $entry->{ordinal};
515                 my $function = $entry->{function};
516                 print OUT "# ";
517                 output_function(\*OUT, $type, $ordinal, $external_name, $function);
518                 $empty = 0;
519             }
520
521             if(!$empty) {
522                 print OUT "\n";
523                 $empty = 1;
524             }
525             foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
526                 my $entry = $specifications{$module}{fixed}{$ordinal};
527                 my $external_name = $entry->{external_name};
528                 my $function = $entry->{function};
529                 output_function(\*OUT, $type, $ordinal, $external_name, $function);
530                 $empty = 0;
531             }
532
533             if(!$empty) {
534                 print OUT "\n";
535                 $empty = 1;
536             }
537             foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
538                 my $entry = $specifications{$module}{unfixed}{$external_name};
539                 my $ordinal = $entry->{ordinal};
540                 my $function = $entry->{function};
541                 output_function(\*OUT, $type, $ordinal, $external_name, $function);
542                 $empty = 0;
543             }
544
545             close(OUT);
546         }
547     }
548 }
549
550 if($options->stub_statistics) {
551     foreach my $winapi (@winapis) {
552         my $type = $winapi->name;
553
554         if($type eq "win16" && !$options->win16) { next; }
555         if($type eq "win32" && !$options->win32) { next; }
556
557         my %module_counts;
558          foreach my $module ($winapi->all_modules) {
559              foreach my $external_name ($winapi->all_functions_in_module($module)) {
560                  my $external_calling_convention =
561                      $winapi->function_external_calling_convention_in_module($module, $external_name);
562                  if($external_calling_convention !~ /^forward|stub$/) {
563                      if($module_pseudo_stub{$module}{$external_name}) {
564                          $external_calling_convention = "pseudo_stub";
565                      }
566                  } elsif($external_calling_convention eq "forward") {
567                      (my $forward_module, my $forward_external_name) =
568                          $winapi->function_forward_final_destination($module, $external_name);
569
570                      my $forward_external_calling_convention =
571                          $winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
572
573                      if(!defined($forward_external_calling_convention)) {
574                          next;
575                      }
576
577                      if($forward_external_calling_convention ne "stub" &&
578                         $module_pseudo_stub{$forward_module}{$forward_external_name})
579                      {
580                          $forward_external_calling_convention = "pseudo_stub";
581                      }
582
583                      $external_calling_convention = "forward_$forward_external_calling_convention";
584                  }
585
586                  $module_counts{$module}{$external_calling_convention}++;
587              }
588          }
589
590         foreach my $module ($winapi->all_modules) {
591             my $pseudo_stubs = $module_counts{$module}{pseudo_stub} || 0;
592             my $real_stubs = $module_counts{$module}{stub} || 0;
593             my $forward_pseudo_stubs = $module_counts{$module}{forward_pseudo_stub} || 0;
594             my $forward_real_stubs = $module_counts{$module}{forward_stub} || 0;
595
596             my $forwards = 0;
597             my $total = 0;
598             foreach my $calling_convention (keys(%{$module_counts{$module}})) {
599                 my $count = $module_counts{$module}{$calling_convention};
600                 if($calling_convention =~ /^forward/) {
601                     $forwards += $count;
602                 }
603                 $total += $count;
604             }
605
606             if($total > 0) {
607                 my $stubs = $real_stubs + $pseudo_stubs;
608
609                 $output->write("*.c: $module: ");
610                 $output->write("$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo) " .
611                                "and $forwards are forwards\n");
612             }
613
614             if($forwards > 0) {
615                 my $forward_stubs = $forward_real_stubs + $forward_pseudo_stubs;
616
617                 $output->write("*.c: $module: ");
618                 $output->write("$forward_stubs of $forwards forwarded functions are stubs " .
619                                "($forward_real_stubs real, $forward_pseudo_stubs pseudo)\n");
620             }
621         }
622     }
623 }
624
625 if($options->winetest) {
626     foreach my $module ($win32api->all_modules) {
627         my $type = "win32";
628
629         my $package = $module;
630         $package =~ s/\.dll$//;
631         $package =~ s/\./_/g;
632
633         my @entries;
634
635         foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
636             my $entry = $specifications{$module}{unknown}{$external_name};
637             push @entries, $entry;
638         }
639
640         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
641             my $entry = $specifications{$module}{fixed}{$ordinal};
642             push @entries, $entry;
643         }
644
645         foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
646             my $entry = $specifications{$module}{unfixed}{$external_name};
647             push @entries, $entry;
648         }
649
650         my $n = 0;
651         foreach my $entry (@entries) {
652             my $external_name = $entry->{external_name};
653             my $ordinal = $entry->{ordinal};
654             my $function = $entry->{function};
655
656             my $return_kind = $function->return_kind32 || "undef";
657             my $calling_convention = $function->calling_convention32 || "undef";
658             my $refargument_kinds = $function->argument_kinds32;
659
660             my @argument_kinds;
661             if(defined($refargument_kinds)) {
662                 @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
663             }
664
665             next if $calling_convention ne "stdcall";
666             next if $external_name eq "\@";
667
668             if($n == 0) {
669                 open(OUT, "> $wine_dir/programs/winetest/include/${package}.pm");
670
671                 print OUT "package ${package};\n";
672                 print OUT "\n";
673
674                 print OUT "use strict;\n";
675                 print OUT "\n";
676
677                 print OUT "require Exporter;\n";
678                 print OUT "\n";
679
680                 print OUT "use wine;\n";
681                 print OUT "use vars qw(\@ISA \@EXPORT \@EXPORT_OK);\n";
682                 print OUT "\n";
683
684                 print OUT "\@ISA = qw(Exporter);\n";
685                 print OUT "\@EXPORT = qw();\n";
686                 print OUT "\@EXPORT_OK = qw();\n";
687                 print OUT "\n";
688
689                 print OUT "my \$module_declarations = {\n";
690             } elsif($n > 0) {
691                 print OUT ",\n";
692             }
693
694             print OUT "    \"\Q$external_name\E\" => [\"$return_kind\",  [";
695             my $m = 0;
696             foreach my $argument_kind (@argument_kinds) {
697                 if($m > 0) {
698                     print OUT ", ";
699                 }
700                 print OUT "\"$argument_kind\"";
701                 $m++;
702             }
703             print OUT "]]";
704             $n++;
705         }
706
707         if($n > 0) {
708             print OUT "\n";
709             print OUT "};\n";
710             print OUT "\n";
711             print OUT "&wine::declare(\"$module\",\%\$module_declarations);\n";
712             print OUT "push \@EXPORT, map { \"&\" . \$_; } sort(keys(\%\$module_declarations));\n";
713             print OUT "1;\n";
714             close(OUT);
715         }
716     }
717 }