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 &file_skip &files_skip &get_spec_files
  14     $current_dir $wine_dir $winapi_dir $winapi_check_dir
  15 );
  16 use output;
  17 use options;
  18 use winapi;
  19 use winapi_parser;
  20
  21 my $output = output->new;
  22
  23 my %options_long = (
  24     "debug" => { default => 0, description => "debug mode" },
  25     "help" => { default => 0, description => "help mode" },
  26     "verbose" => { default => 0, description => "verbose mode" },
  27
  28     "progress" => { default => 1, description => "show progress" },
  29
  30     "win16" => { default => 1, description => "Win16 extraction" },
  31     "win32" => { default => 1, description => "Win32 extraction" },
  32
  33     "local" =>  { default => 1, description => "local extraction" },
  34     "global" => { default => 1, description => "global extraction" },
  35
  36     "spec-files" => { default => 1, parent => "global", description => "spec files extraction" },
  37 );
  38
  39 my %options_short = (
  40     "d" => "debug",
  41     "?" => "help",
  42     "v" => "verbose"
  43 );
  44
  45 my $options_usage = "usage: winapi_extract [--help] [<files>]\n";
  46
  47 my $options = options->new(\%options_long, \%options_short, $options_usage);
  48
  49 my %module2spec_file;
  50 my %module2type;
  51 {
  52     local $_;
  53
  54     foreach my $spec_file (get_spec_files) {
  55         my $module;
  56         my $type;
  57
  58         open(IN, "< $wine_dir/$spec_file");
  59         while(<IN>) {
  60             s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begining and end of line
  61             s/^(.*?)\s*#.*$/$1/;  # remove comments
  62             /^$/ && next;         # skip empty lines
  63
  64             if(/^name\s+(.*?)$/) {
  65                 $module = $1;
  66                 $module2spec_file{$module} = $spec_file;
  67             } elsif(/^type\s+(.*?)$/) {
  68                 $type = $1;
  69                 $module2type{$module} = $type;
  70             }
  71         }
  72         close(IN);
  73     }
  74 }
  75
  76 my $win16api = winapi->new($options, $output, "win16", "$winapi_check_dir/win16");
  77 my $win32api = winapi->new($options, $output, "win32", "$winapi_check_dir/win32");
  78 my @winapis = ($win16api, $win32api);
  79
  80 my %specifications;
  81
  82 my @files = files_skip($options->c_files);
  83
  84 my $progress_output;
  85 my $progress_current = 0;
  86 my $progress_max = scalar(@files);
  87
  88 foreach my $file (@files) {
  89     my $functions = 0;
  90
  91     $progress_current++;
  92     if($options->progress) {
  93         output->progress("$file: file $progress_current of $progress_max");
  94     }
  95
  96     my $found_function = sub {
  97         my $line = shift;
  98         my $refdebug_channels = shift;
  99         my @debug_channels = @$refdebug_channels;
 100         my $documentation = shift;
 101         my $linkage = shift;
 102         my $return_type = shift;
 103         my $calling_convention = shift;
 104         my $internal_name = shift;
 105         my $refargument_types = shift;
 106         my @argument_types = @$refargument_types;
 107         my $refargument_names = shift;
 108         my @argument_names = @$refargument_names;
 109         my $refargument_documentations = shift;
 110         my @argument_documentations = @$refargument_documentations;
 111         my $statements = shift;
 112
 113         $functions++;
 114
 115         if($linkage eq "static") {
 116             return;
 117         }
 118
 119         local $_;
 120         foreach (split(/\n/, $documentation)) {
 121             if(/^\s*\*\s*(\w+|\@)\s*[\(\[]\s*(\w+)\s*\.\s*(\@|\d+)\s*[\)\]]/) {
 122                 my $external_name = $1;
 123                 my $module = lc($2);
 124                 my $ordinal = $3;
 125
 126                 if($ordinal eq "@") {
 127                     $specifications{$module}{unfixed}{$external_name}{debug_channels} = [@debug_channels];
 128                     $specifications{$module}{unfixed}{$external_name}{internal_name} = $internal_name;
 129                     $specifications{$module}{unfixed}{$external_name}{external_name} = $external_name;
 130                     $specifications{$module}{unfixed}{$external_name}{ordinal} = $ordinal;
 131                     $specifications{$module}{unfixed}{$external_name}{arguments} = [@argument_types];
 132                 } else {
 133                     $specifications{$module}{fixed}{$ordinal}{debug_channels} = [@debug_channels];
 134                     $specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
 135                     $specifications{$module}{fixed}{$ordinal}{internal_name} = $internal_name;
 136                     $specifications{$module}{fixed}{$ordinal}{external_name} = $external_name;
 137                     $specifications{$module}{fixed}{$ordinal}{arguments} = [@argument_types];
 138                 }
 139
 140                 if($options->debug) {
 141                     output->write("$file: $external_name ($module.$ordinal)\n");
 142                 }
 143             }
 144         }
 145     };
 146
 147
 148     my $found_preprocessor = sub {
 149         my $directive = shift;
 150         my $argument = shift;
 151     };
 152
 153     winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
 154
 155     if($functions == 0) {
 156         output->write("$file: doesn't contain any functions\n");
 157     }
 158 }
 159
 160 sub output_function {
 161     local *OUT = shift;
 162     my $type = shift;
 163     my $function = shift;
 164
 165     my $internal_name = $function->{internal_name};
 166     my $external_name = $function->{external_name};
 167     my $ordinal = $function->{ordinal};
 168     my @arguments = @{$function->{arguments}};
 169
 170     my @arguments2;
 171     foreach my $argument (@arguments) {
 172         my $argument2;
 173         if($type eq "win16") {
 174             $argument2 = $win16api->translate_argument($argument);
 175         } else {
 176             $argument2 = $win32api->translate_argument($argument);
 177         }
 178         if(!defined($argument2)) {
 179             $argument2 = "undef";
 180         }
 181
 182         if($argument2 eq "longlong") {
 183             push @arguments2, ("long", "long");
 184         } else {
 185             push @arguments2, $argument2;
 186         }
 187     }
 188
 189     if($type eq "win16") {
 190         print OUT "$ordinal pascal $external_name(@arguments2) $internal_name\n";
 191     } else {
 192         print OUT "$ordinal stdcall $external_name(@arguments2) $internal_name\n";
 193     }
 194 }
 195
 196 if($options->spec_files) {
 197     foreach my $module (keys(%specifications)) {
 198         my $spec_file = $module2spec_file{$module};
 199         my $type = $module2type{$module};
 200
 201         if(!defined($spec_file) || !defined($type)) {
 202             output->write("$module: doesn't exist\n");
 203             next;
 204         }
 205
 206         $spec_file .= "2";
 207
 208         output->progress("$spec_file");
 209         open(OUT, "> $wine_dir/$spec_file");
 210
 211         print OUT "name $module\n";
 212         print OUT "type $type\n";
 213         print OUT "\n";
 214
 215         my %debug_channels;
 216         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 217             my $function = $specifications{$module}{fixed}{$ordinal};
 218             foreach my $debug_channel (@{$function->{debug_channels}}) {
 219                 $debug_channels{$debug_channel}++;
 220             }
 221         }
 222         foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 223             my $function = $specifications{$module}{unfixed}{$name};
 224             foreach my $debug_channel (@{$function->{debug_channels}}) {
 225                 $debug_channels{$debug_channel}++;
 226             }
 227         }
 228
 229         my @debug_channels = sort(keys(%debug_channels));
 230         if($#debug_channels >= 0) {
 231             print OUT "debug_channels (" .  join(" ", @debug_channels) . ")\n";
 232             print OUT "\n";
 233         }
 234
 235         my $empty = 1;
 236         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 237             my $function = $specifications{$module}{fixed}{$ordinal};
 238             output_function(\*OUT, $type, $function);
 239             $empty = 0;
 240         }
 241
 242         foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 243             if(!$empty) {
 244                 print OUT "\n";
 245                 $empty = 1;
 246             }
 247             my $function = $specifications{$module}{unfixed}{$name};
 248             output_function(\*OUT, $type, $function);
 249         }
 250         close(OUT);
 251     }
 252 }
 253 output->hide_progress;