git.oblomov.eu Git - wine/blob - tools/winapi_check/winapi.pm

   1 package winapi;
   2
   3 use strict;
   4
   5 sub new {
   6     my $proto = shift;
   7     my $class = ref($proto) || $proto;
   8     my $self  = {};
   9     bless ($self, $class);
  10
  11     my $output = \${$self->{OUTPUT}};
  12     my $name = \${$self->{NAME}};
  13
  14     $$output = shift;
  15     $$name = shift;
  16     my $file = shift;
  17     my $path = shift;
  18
  19     $file =~ s/^.\/(.*)$/$1/;
  20     $self->parse_api_file($file);
  21
  22     my @files = map {
  23         s/^.\/(.*)$/$1/;
  24         $_;
  25     } split(/\n/, `find $path -name \\*.api`);
  26
  27     foreach my $file (@files) {
  28         my $module = $file;
  29         $module =~ s/.*?\/([^\/]*?)\.api$/$1/;
  30         $self->parse_api_file($file,$module);
  31     }
  32
  33     return $self;
  34 }
  35
  36 sub parse_api_file {
  37     my $self = shift;
  38     my $output = \${$self->{OUTPUT}};
  39     my $allowed_kind = \%{$self->{ALLOWED_KIND}};
  40     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
  41     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
  42     my $allowed_modules_unlimited = \%{$self->{ALLOWED_MODULES_UNLIMITED}};
  43     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
  44
  45     my $file = shift;
  46     my $module = shift;
  47
  48     my $kind;
  49     my $forbidden = 0;
  50
  51     $$output->progress("$file");
  52
  53     open(IN, "< $file") || die "$file: $!\n";
  54     $/ = "\n";
  55     while(<IN>) {
  56         s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begin and end of line
  57         s/^(.*?)\s*#.*$/$1/;  # remove comments
  58         /^$/ && next;         # skip empty lines
  59
  60         if(s/^%(\S+)\s*//) {
  61             $kind = $1;
  62             $forbidden = 0;
  63
  64             $$allowed_kind{$kind} = 1;
  65             if(/^--forbidden/) {
  66                 $forbidden = 1;
  67             }
  68         } elsif(defined($kind)) {
  69             my $type = $_;
  70             if(!$forbidden) {
  71                 if(defined($module)) {
  72                     if($$allowed_modules_unlimited{$type}) {
  73                         $$output->write("$file: type ($type) already specificed as an unlimited type\n");
  74                     } elsif(!$$allowed_modules{$type}{$module}) {
  75                         $$allowed_modules{$type}{$module} = 1;
  76                         $$allowed_modules_limited{$type} = 1;
  77                     } else {
  78                         $$output->write("$file: type ($type) already specificed\n");
  79                     }
  80                 } else {
  81                     $$allowed_modules_unlimited{$type} = 1;
  82                 }
  83             } else {
  84                 $$allowed_modules_limited{$type} = 1;
  85             }
  86             if(defined($$translate_argument{$type}) && $$translate_argument{$type} ne $kind) {
  87                 $$output->write("$file: type ($type) respecified as different kind ($kind != $$translate_argument{$type})\n");
  88             } else {
  89                 $$translate_argument{$type} = $kind;
  90             }
  91         } else {
  92             $$output->write("$file: file must begin with %<type> statement\n");
  93             exit 1;
  94         }
  95     }
  96     close(IN);
  97 }
  98
  99 sub get_spec_file_type {
 100     my $proto = shift;
 101     my $class = ref($proto) || $proto;
 102
 103     my $file = shift;
 104
 105     my $type;
 106
 107     open(IN, "< $file") || die "$file: $!\n";
 108     $/ = "\n";
 109     while(<IN>) {
 110         if(/^type\s*(\w+)/) {
 111             $type = $1;
 112             last;
 113         }
 114     }
 115     close(IN);
 116
 117     return $type;
 118 }
 119
 120 sub read_spec_files {
 121     my $proto = shift;
 122     my $class = ref($proto) || $proto;
 123
 124     my $path = shift;
 125     my $win16api = shift;
 126     my $win32api = shift;
 127
 128     my @files = map {
 129         s/^.\/(.*)$/$1/;
 130         $_;
 131     } split(/\n/, `find $path -name \\*.spec`);
 132
 133     foreach my $file (@files) {
 134         my $type = 'winapi'->get_spec_file_type($file);
 135         if($type eq "win16") {
 136             $win16api->parse_spec_file($file);
 137         } elsif($type eq "win32") {
 138             $win32api->parse_spec_file($file);
 139         }
 140     }
 141 }
 142
 143 sub parse_spec_file {
 144     my $self = shift;
 145
 146     my $output = \${$self->{OUTPUT}};
 147     my $function_arguments = \%{$self->{FUNCTION_ARGUMENTS}};
 148     my $function_calling_convention = \%{$self->{FUNCTION_CALLING_CONVENTION}};
 149     my $function_stub = \%{$self->{FUNCTION_STUB}};
 150     my $function_module = \%{$self->{FUNCTION_MODULE}};
 151
 152
 153     my $file = shift;
 154
 155     my %ordinals;
 156     my $type;
 157     my $module;
 158
 159     $$output->progress("$file");
 160
 161     open(IN, "< $file") || die "$file: $!\n";
 162     $/ = "\n";
 163     my $header = 1;
 164     my $lookahead = 0;
 165     while($lookahead || defined($_ = <IN>)) {
 166         $lookahead = 0;
 167         s/^\s*(.*?)\s*$/$1/;
 168         s/^(.*?)\s*#.*$/$1/;
 169         /^$/ && next;
 170
 171         if($header)  {
 172             if(/^name\s*(\S*)/) { $module = $1; }
 173             if(/^\d+/) { $header = 0 };
 174             next;
 175         }
 176
 177         my $ordinal;
 178         if(/^(\d+)\s+(pascal|pascal16|stdcall|cdecl|register|interrupt|varargs)\s+(\S+)\s*\(\s*(.*?)\s*\)\s*(\S+)$/) {
 179             my $calling_convention = $2;
 180             my $external_name = $3;
 181             my $arguments = $4;
 182             my $internal_name = $5;
 183
 184             $ordinal = $1;
 185
 186             # FIXME: Internal name existing more than once not handled properly
 187             $$function_arguments{$internal_name} = $arguments;
 188             $$function_calling_convention{$internal_name} = $calling_convention;
 189             $$function_module{$internal_name} = "$module";
 190         } elsif(/^(\d+)\s+stub\s+(\S+)$/) {
 191             my $external_name = $2;
 192
 193             $ordinal = $1;
 194
 195             $$function_stub{$external_name} = 1;
 196             $$function_module{$external_name} = $module;
 197         } elsif(/^\d+\s+(equate|long|word|extern|forward)/) {
 198             # ignore
 199         } else {
 200             my $next_line = <IN>;
 201             if($next_line =~ /^\d/) {
 202                 die "$file: $.: syntax error: '$_'\n";
 203             } else {
 204                 $_ .= $next_line;
 205                 $lookahead = 1;
 206             }
 207         }
 208
 209         if(defined($ordinal)) {
 210             if($ordinals{$ordinal}) {
 211                 $$output->write("$file: ordinal redefined: $_\n");
 212             }
 213             $ordinals{$ordinal}++;
 214         }
 215     }
 216     close(IN);
 217 }
 218
 219 sub name {
 220     my $self = shift;
 221     my $name = \${$self->{NAME}};
 222
 223     return $$name;
 224 }
 225
 226 sub is_allowed_kind {
 227     my $self = shift;
 228     my $allowed_kind = \%{$self->{ALLOWED_KIND}};
 229
 230     my $kind = shift;
 231     if(defined($kind)) {
 232         return $$allowed_kind{$kind};
 233     } else {
 234         return 0;
 235     }
 236 }
 237
 238 sub is_limited_type {
 239     my $self = shift;
 240     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
 241
 242     my $type = shift;
 243
 244     return $$allowed_modules_limited{$type};
 245 }
 246
 247 sub allowed_type_in_module {
 248     my $self = shift;
 249     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 250     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
 251
 252     my $type = shift;
 253     my $module = shift;
 254
 255     return !$$allowed_modules_limited{$type} || $$allowed_modules{$type}{$module};
 256 }
 257
 258 sub type_used_in_module {
 259     my $self = shift;
 260     my $used_modules = \%{$self->{USED_MODULES}};
 261
 262     my $type = shift;
 263     my $module = shift;
 264
 265     $$used_modules{$type}{$module} = 1;
 266
 267     return ();
 268 }
 269
 270 sub types_not_used {
 271     my $self = shift;
 272     my $used_modules = \%{$self->{USED_MODULES}};
 273     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 274
 275     my $not_used;
 276     foreach my $type (sort(keys(%$allowed_modules))) {
 277         foreach my $module (sort(keys(%{$$allowed_modules{$type}}))) {
 278             if(!$$used_modules{$type}{$module}) {
 279                 $$not_used{$module}{$type} = 1;
 280             }
 281         }
 282     }
 283     return $not_used;
 284 }
 285
 286 sub translate_argument {
 287     my $self = shift;
 288     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 289
 290     my $argument = shift;
 291
 292     return $$translate_argument{$argument};
 293 }
 294
 295 sub all_declared_types {
 296     my $self = shift;
 297     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 298
 299     return sort(keys(%$translate_argument));
 300 }
 301
 302 sub found_type {
 303     my $self = shift;
 304     my $type_found = \%{$self->{TYPE_FOUND}};
 305
 306     my $name = shift;
 307
 308     $$type_found{$name}++;
 309 }
 310
 311 sub type_found {
 312     my $self = shift;
 313     my $type_found= \%{$self->{TYPE_FOUND}};
 314
 315     my $name = shift;
 316
 317     return $$type_found{$name};
 318 }
 319
 320 sub all_functions {
 321     my $self = shift;
 322     my $function_calling_convention = \%{$self->{FUNCTION_CALLING_CONVENTION}};
 323
 324     return sort(keys(%$function_calling_convention));
 325 }
 326
 327 sub all_functions_found {
 328     my $self = shift;
 329     my $function_found = \%{$self->{FUNCTION_FOUND}};
 330
 331     return sort(keys(%$function_found));
 332 }
 333
 334 sub function_calling_convention {
 335     my $self = shift;
 336     my $function_calling_convention = \%{$self->{FUNCTION_CALLING_CONVENTION}};
 337
 338     my $name = shift;
 339
 340     return $$function_calling_convention{$name};
 341 }
 342
 343 sub is_function {
 344     my $self = shift;
 345     my $function_calling_convention = \%{$self->{FUNCTION_CALLING_CONVENTION}};
 346
 347     my $name = shift;
 348
 349     return $$function_calling_convention{$name};
 350 }
 351
 352 sub is_shared_function {
 353     my $self = shift;
 354     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 355
 356     my $name = shift;
 357
 358     return $$function_shared{$name};
 359 }
 360
 361 sub found_shared_function {
 362     my $self = shift;
 363     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 364
 365     my $name = shift;
 366
 367     $$function_shared{$name} = 1;
 368 }
 369
 370 sub function_arguments {
 371     my $self = shift;
 372     my $function_arguments = \%{$self->{FUNCTION_ARGUMENTS}};
 373
 374     my $name = shift;
 375
 376     return $$function_arguments{$name};
 377 }
 378
 379 sub function_module {
 380     my $self = shift;
 381     my $function_module = \%{$self->{FUNCTION_MODULE}};
 382
 383     my $name = shift;
 384
 385     return $$function_module{$name};
 386 }
 387
 388 sub function_stub {
 389     my $self = shift;
 390     my $function_stub = \%{$self->{FUNCTION_STUB}};
 391
 392     my $name = shift;
 393
 394     return $$function_stub{$name};
 395 }
 396
 397 sub found_function {
 398     my $self = shift;
 399     my $function_found = \%{$self->{FUNCTION_FOUND}};
 400
 401     my $name = shift;
 402
 403     $$function_found{$name}++;
 404 }
 405
 406 sub function_found {
 407     my $self = shift;
 408     my $function_found = \%{$self->{FUNCTION_FOUND}};
 409
 410     my $name = shift;
 411
 412     return $$function_found{$name};
 413 }
 414
 415 1;