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 }
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.