git.oblomov.eu Git - wine/blob - tools/winapi/winapi_extract

   1 #!/usr/bin/perl -w
   2
   3 # Copyright 2001 Patrik Stridvall
   4
   5 use strict;
   6
   7 BEGIN {
   8     $0 =~ m%^(.*?/?tools)/winapi/winapi_extract$%;
   9     require "$1/winapi/setup.pm";
  10 }
  11
  12 use config qw(
  13     &file_type &files_skip &files_filter &get_spec_files
  14     $current_dir $wine_dir $winapi_dir $winapi_check_dir
  15 );
  16 use output qw($output);
  17 use winapi_extract_options qw($options);
  18
  19 use function;
  20 use type;
  21 use winapi_function;
  22 use winapi_parser;
  23 use winapi qw(@winapis);
  24
  25 my %module2spec_file;
  26 my %module2type;
  27 if($options->spec_files) {
  28     local $_;
  29
  30     foreach my $spec_file (get_spec_files("winelib")) {
  31         my $module;
  32         my $type;
  33
  34         open(IN, "< $wine_dir/$spec_file");
  35         while(<IN>) {
  36             s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begining and end of line
  37             s/^(.*?)\s*#.*$/$1/;  # remove comments
  38             /^$/ && next;         # skip empty lines
  39
  40             if(/^name\s+(.*?)$/) {
  41                 $module = $1;
  42                 $module2spec_file{$module} = $spec_file;
  43             } elsif(/^type\s+(.*?)$/) {
  44                 $type = $1;
  45                 $module2type{$module} = $type;
  46             }
  47         }
  48         close(IN);
  49     }
  50 }
  51
  52 my %specifications;
  53
  54 sub documentation_specifications {
  55     my $function = shift;
  56
  57     my @debug_channels = @{$function->debug_channels};
  58     my $documentation = $function->documentation;
  59     my $documentation_line = $function->documentation_line;
  60     my $return_type = $function->return_type;
  61     my $linkage = $function->linkage;
  62     my $internal_name = $function->internal_name;
  63
  64     if($linkage eq "static") {
  65         return;
  66     }
  67
  68     local $_;
  69     foreach (split(/\n/, $documentation)) {
  70         if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*(\S+)\s*[\)\]]/) {
  71             my $external_name = $1;
  72             my $module = lc($2);
  73             my $ordinal = $3;
  74
  75             if($ordinal eq "@") {
  76                 if(1 || !exists($specifications{$module}{unfixed}{$external_name})) {
  77                     $specifications{$module}{unfixed}{$external_name}{ordinal} = $ordinal;
  78                     $specifications{$module}{unfixed}{$external_name}{external_name} = $external_name;
  79                     $specifications{$module}{unfixed}{$external_name}{function} = $function;
  80                 } else {
  81                     $output->write("$external_name ($module.$ordinal) already exists\n");
  82                 }
  83             } elsif($ordinal =~ /^\d+$/) {
  84                 if(1 || !exists($specifications{$module}{fixed}{$ordinal})) {
  85                     $specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
  86                     $specifications{$module}{fixed}{$ordinal}{external_name} = $external_name;
  87                     $specifications{$module}{fixed}{$ordinal}{function} = $function;
  88                     } else {
  89                         $output->write("$external_name ($module.$ordinal) already exists\n");
  90                     }
  91             } elsif($ordinal eq "init") {
  92                 if(!exists($specifications{$module}{init})) {
  93                     $specifications{$module}{init}{function} = $function;
  94                 } else {
  95                     $output->write("$external_name ($module.$ordinal) already exists\n");
  96                 }
  97             } else {
  98                 if(!exists($specifications{$module}{unknown}{$external_name})) {
  99                     $specifications{$module}{unknown}{$external_name}{ordinal} = $ordinal;
 100                     $specifications{$module}{unknown}{$external_name}{external_name} = $external_name;
 101                     $specifications{$module}{unknown}{$external_name}{function} = $function;
 102                 } else {
 103                     $output->write("$external_name ($module.$ordinal) already exists\n");
 104                 }
 105             }
 106
 107             if($options->debug) {
 108                 $output->write("$external_name ($module.$ordinal)\n");
 109             }
 110         }
 111     }
 112 }
 113
 114 my %module_pseudo_stub_count16;
 115 my %module_pseudo_stub_count32;
 116
 117 sub statements_stub {
 118     my $function = shift;
 119
 120     my $statements = $function->statements;
 121     if(defined($statements) && $statements =~ /FIXME[^;]*stub/s) {
 122         if($options->win16) {
 123             foreach my $module16 ($function->modules16) {
 124                 $module_pseudo_stub_count16{$module16}++;
 125             }
 126         }
 127         if($options->win32) {
 128             foreach my $module32 ($function->modules32) {
 129                 $module_pseudo_stub_count32{$module32}++;
 130             }
 131         }
 132     }
 133 }
 134
 135 my @c_files = $options->c_files;
 136 @c_files = files_skip(@c_files);
 137 @c_files = files_filter("winelib", @c_files);
 138
 139 my $progress_output;
 140 my $progress_current = 0;
 141 my $progress_max = scalar(@c_files);
 142
 143 foreach my $file (@c_files) {
 144     my %functions;
 145
 146     $progress_current++;
 147     if($options->progress) {
 148         $output->progress("$file: file $progress_current of $progress_max");
 149     }
 150
 151     my $create_function = sub {
 152         if($options->stub_statistics) {
 153             return 'winapi_function'->new;
 154         } else {
 155             return 'function'->new;
 156         }
 157     };
 158
 159     my $found_function = sub {
 160         my $function = shift;
 161
 162         my $documentation_line = $function->documentation_line;
 163         my $documentation = $function->documentation;
 164         my $function_line = $function->function_line;
 165         my $linkage = $function->linkage;
 166         my $return_type = $function->return_type;
 167         my $calling_convention = $function->calling_convention;
 168         my $internal_name = $function->internal_name;
 169         my $statements = $function->statements;
 170
 171         $functions{$internal_name} = $function;
 172
 173         $output->prefix_callback(sub { return $function->prefix; });
 174
 175         if($options->spec_files) {
 176             documentation_specifications($function);
 177         }
 178
 179         if($options->stub_statistics) {
 180             statements_stub($function);
 181         }
 182
 183         $output->prefix("");
 184     };
 185
 186     my $create_type = sub {
 187         return 'type'->new;
 188     };
 189
 190     my $found_type = sub {
 191         my $type = shift;
 192     };
 193
 194     my $found_preprocessor = sub {
 195         my $directive = shift;
 196         my $argument = shift;
 197     };
 198
 199     &winapi_parser::parse_c_file($file, $create_function, $found_function, $create_type, $found_type, $found_preprocessor);
 200
 201     my @internal_names = keys(%functions);
 202     if($#internal_names < 0) {
 203         $output->write("$file: doesn't contain any functions\n");
 204     }
 205 }
 206
 207 sub output_function {
 208     local *OUT = shift;
 209     my $type = shift;
 210     my $ordinal = shift;
 211     my $external_name = shift;
 212     my $function = shift;
 213
 214     my $internal_name = $function->internal_name;
 215
 216     my $return_kind;
 217     my $calling_convention;
 218     my $refargument_kinds;
 219     if($type eq "win16") {
 220         $return_kind = $function->return_kind16 || "undef";
 221         $calling_convention = $function->calling_convention16 || "undef";
 222         $refargument_kinds = $function->argument_kinds16;
 223     } elsif($type eq "win32") {
 224         $return_kind = $function->return_kind32 || "undef";
 225         $calling_convention = $function->calling_convention32 || "undef";
 226         $refargument_kinds = $function->argument_kinds32;
 227     }
 228
 229     if(defined($refargument_kinds)) {
 230         my @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
 231         print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
 232     } else {
 233         print OUT "$ordinal $calling_convention $external_name() $internal_name # FIXME: arguments undefined\n";
 234     }
 235 }
 236
 237 if($options->spec_files) {
 238     foreach my $module (keys(%specifications)) {
 239         my $spec_file = $module2spec_file{$module};
 240         my $type = $module2type{$module};
 241
 242         if(!defined($spec_file) || !defined($type)) {
 243             $output->write("$module: doesn't exist\n");
 244             next;
 245         }
 246
 247         $spec_file .= "2";
 248
 249         $output->progress("$spec_file");
 250         open(OUT, "> $wine_dir/$spec_file");
 251
 252         print OUT "name $module\n";
 253         print OUT "type $type\n";
 254         if(exists($specifications{$module}{init})) {
 255             my $function = $specifications{$module}{init}{function};
 256             print OUT "init " . $function->internal_name . "\n";
 257         }
 258         print OUT "\n";
 259
 260         my %debug_channels;
 261         if(exists($specifications{$module}{init})) {
 262             my $function = $specifications{$module}{init}{function};
 263             foreach my $debug_channel (@{$function->debug_channels}) {
 264                 $debug_channels{$debug_channel}++;
 265             }
 266         }
 267         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 268             my $function = $specifications{$module}{fixed}{$ordinal}{function};
 269             foreach my $debug_channel (@{$function->debug_channels}) {
 270                 $debug_channels{$debug_channel}++;
 271             }
 272         }
 273         foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 274             my $function = $specifications{$module}{unfixed}{$name}{function};
 275             foreach my $debug_channel (@{$function->debug_channels}) {
 276                 $debug_channels{$debug_channel}++;
 277             }
 278         }
 279         foreach my $name (sort(keys(%{$specifications{$module}{unknown}}))) {
 280             my $function = $specifications{$module}{unknown}{$name}{function};
 281             foreach my $debug_channel (@{$function->debug_channels}) {
 282                 $debug_channels{$debug_channel}++;
 283             }
 284         }
 285
 286         my @debug_channels = sort(keys(%debug_channels));
 287         if($#debug_channels >= 0) {
 288             print OUT "debug_channels (" .  join(" ", @debug_channels) . ")\n";
 289             print OUT "\n";
 290         }
 291
 292         my $empty = 1;
 293
 294         if(!$empty) {
 295             print OUT "\n";
 296             $empty = 1;
 297         }
 298         foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
 299             my $entry = $specifications{$module}{unknown}{$external_name};
 300             my $ordinal = $entry->{ordinal};
 301             my $function = $entry->{function};
 302             print OUT "# ";
 303             output_function(\*OUT, $type, $ordinal, $external_name, $function);
 304             $empty = 0;
 305         }
 306
 307         if(!$empty) {
 308             print OUT "\n";
 309             $empty = 1;
 310         }
 311         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 312             my $entry = $specifications{$module}{fixed}{$ordinal};
 313             my $external_name = $entry->{external_name};
 314             my $function = $entry->{function};
 315             output_function(\*OUT, $type, $ordinal, $external_name, $function);
 316             $empty = 0;
 317         }
 318
 319         if(!$empty) {
 320             print OUT "\n";
 321             $empty = 1;
 322         }
 323         foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 324             my $entry = $specifications{$module}{unfixed}{$external_name};
 325             my $ordinal = $entry->{ordinal};
 326             my $function = $entry->{function};
 327             output_function(\*OUT, $type, $ordinal, $external_name, $function);
 328             $empty = 0;
 329         }
 330
 331         close(OUT);
 332     }
 333 }
 334
 335 if($options->stub_statistics) {
 336     foreach my $winapi (@winapis) {
 337         if($winapi->name eq "win16" && !$options->win16) { next; }
 338         if($winapi->name eq "win32" && !$options->win32) { next; }
 339
 340         my %module_stub_count;
 341         my %module_total_count;
 342
 343         foreach my $internal_name ($winapi->all_internal_functions,$winapi->all_functions_stub) {
 344             foreach my $module (split(/ \& /, $winapi->function_internal_module($internal_name))) {
 345                 if($winapi->is_function_stub_in_module($module, $internal_name)) {
 346                     $module_stub_count{$module}++;
 347                 }
 348                 $module_total_count{$module}++;
 349             }
 350         }
 351
 352         foreach my $module ($winapi->all_modules) {
 353             my $pseudo_stubs;
 354             if($winapi->name eq "win16") {
 355                 $pseudo_stubs = $module_pseudo_stub_count16{$module};
 356             } elsif($winapi->name eq "win32") {
 357                 $pseudo_stubs = $module_pseudo_stub_count32{$module};
 358             }
 359
 360             my $real_stubs = $module_stub_count{$module};
 361             my $total = $module_total_count{$module};
 362
 363             if(!defined($real_stubs)) { $real_stubs = 0; }
 364             if(!defined($pseudo_stubs)) { $pseudo_stubs = 0; }
 365             if(!defined($total)) { $total = 0;}
 366
 367             my $stubs = $real_stubs + $pseudo_stubs;
 368
 369             $output->write("*.c: $module: ");
 370             $output->write("$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo)\n");
 371         }
 372     }
 373 }
 374