tools/winapi_check/winapi_function.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 #
  18
  19 package winapi_function;
  20 use base qw(function);
  21
  22 use strict;
  23
  24 use config qw($current_dir $wine_dir);
  25 use util qw(&normalize_set);
  26
  27 my $import = 0;
  28 use vars qw($modules $win16api $win32api @winapis);
  29
  30 ########################################################################
  31 # constructor
  32 #
  33
  34 sub new {
  35     my $proto = shift;
  36     my $class = ref($proto) || $proto;
  37     my $self  = {};
  38     bless ($self, $class);
  39
  40     if (!$import) {
  41         require modules;
  42         import modules qw($modules);
  43
  44         require winapi;
  45         import winapi qw($win16api $win32api @winapis);
  46
  47         $import = 1;
  48     }
  49     return $self;
  50 }
  51
  52 ########################################################################
  53 # is_win
  54 #
  55
  56 sub is_win16 { my $self = shift; return defined($self->_module($win16api, @_)); }
  57 sub is_win32 { my $self = shift; return defined($self->_module($win32api, @_)); }
  58
  59 ########################################################################
  60 # external_name
  61 #
  62
  63 sub _external_name {
  64     my $self = shift;
  65     my $winapi = shift;
  66
  67     my $file = $self->file;
  68     my $internal_name = $self->internal_name;
  69
  70     my $external_name = $winapi->function_external_name($internal_name);
  71     my $module = $winapi->function_internal_module($internal_name);
  72
  73     if(!defined($external_name) && !defined($module)) {
  74         return undef;
  75     }
  76
  77     my @external_names = split(/\s*&\s*/, $external_name);
  78     my @modules = split(/\s*&\s*/, $module);
  79
  80     my @external_names2;
  81     while(defined(my $external_name = shift @external_names) &&
  82           defined(my $module = shift @modules))
  83     {
  84         if($modules->is_allowed_module_in_file($module, "$current_dir/$file")) {
  85             push @external_names2, $external_name;
  86         }
  87     }
  88
  89     return join(" & ", @external_names2);
  90 }
  91
  92 sub _external_names {
  93     my $self = shift;
  94     my $winapi = shift;
  95
  96     my $external_name = $self->_external_name($winapi);
  97
  98     if(defined($external_name)) {
  99         return split(/\s*&\s*/, $external_name);
 100     } else {
 101         return ();
 102     }
 103 }
 104
 105 sub external_name {
 106     my $self = shift;
 107
 108     foreach my $winapi (@winapis) {
 109         my $external_name = $self->_external_name($winapi, @_);
 110
 111         if(defined($external_name)) {
 112             return $external_name;
 113         }
 114     }
 115
 116     return undef;
 117 }
 118
 119 sub external_name16 { my $self = shift; return $self->_external_name($win16api, @_); }
 120 sub external_name32 { my $self = shift; return $self->_external_name($win32api, @_); }
 121
 122 sub external_names16 { my $self = shift; return $self->_external_names($win16api, @_); }
 123 sub external_names32 { my $self = shift; return $self->_external_names($win32api, @_); }
 124
 125 sub external_names { my $self = shift; return ($self->external_names16, $self->external_names32); }
 126
 127 ########################################################################
 128 # module
 129 #
 130
 131 sub _module {
 132     my $self = shift;
 133     my $winapi = shift;
 134
 135     my $file = $self->file;
 136     my $internal_name = $self->internal_name;
 137
 138     my $module = $winapi->function_internal_module($internal_name);
 139     if(!defined($module)) {
 140         return undef;
 141     }
 142
 143     my @modules;
 144     foreach my $module (split(/\s*&\s*/, $module)) {
 145         if($modules->is_allowed_module_in_file($module, "$current_dir/$file")) {
 146             push @modules, $module;
 147         }
 148     }
 149
 150     return join(" & ", @modules);
 151 }
 152
 153 sub _modules {
 154     my $self = shift;
 155     my $winapi = shift;
 156
 157     my $module = $self->_module($winapi);
 158
 159     if(defined($module)) {
 160         return split(/\s*&\s*/, $module);
 161     } else {
 162         return ();
 163     }
 164 }
 165
 166 sub module16 { my $self = shift; return $self->_module($win16api, @_); }
 167 sub module32 { my $self = shift; return $self->_module($win32api, @_); }
 168
 169 sub module { my $self = shift; return join (" & ", $self->modules); }
 170
 171 sub modules16 { my $self = shift; return $self->_modules($win16api, @_); }
 172 sub modules32 { my $self = shift; return $self->_modules($win32api, @_); }
 173
 174 sub modules { my $self = shift; return ($self->modules16, $self->modules32); }
 175
 176 ########################################################################
 177 # ordinal
 178 #
 179
 180 sub _ordinal {
 181     my $self = shift;
 182     my $winapi = shift;
 183
 184     my $file = $self->file;
 185     my $internal_name = $self->internal_name;
 186
 187     my $ordinal = $winapi->function_internal_ordinal($internal_name);
 188     my $module = $winapi->function_internal_module($internal_name);
 189
 190     if(!defined($ordinal) && !defined($module)) {
 191         return undef;
 192     }
 193
 194     my @ordinals = split(/\s*&\s*/, $ordinal);
 195     my @modules = split(/\s*&\s*/, $module);
 196
 197     my @ordinals2;
 198     while(defined(my $ordinal = shift @ordinals) &&
 199           defined(my $module = shift @modules))
 200     {
 201         if($modules->is_allowed_module_in_file($module, "$current_dir/$file")) {
 202             push @ordinals2, $ordinal;
 203         }
 204     }
 205
 206     return join(" & ", @ordinals2);
 207 }
 208
 209 sub _ordinals {
 210     my $self = shift;
 211     my $winapi = shift;
 212
 213     my $ordinal = $self->_ordinal($winapi);
 214
 215     if(defined($ordinal)) {
 216         return split(/\s*&\s*/, $ordinal);
 217     } else {
 218         return ();
 219     }
 220 }
 221
 222 sub ordinal16 { my $self = shift; return $self->_ordinal($win16api, @_); }
 223 sub ordinal32 { my $self = shift; return $self->_ordinal($win32api, @_); }
 224
 225 sub ordinal { my $self = shift; return join (" & ", $self->ordinals); }
 226
 227 sub ordinals16 { my $self = shift; return $self->_ordinals($win16api, @_); }
 228 sub ordinals32 { my $self = shift; return $self->_ordinals($win32api, @_); }
 229
 230 sub ordinals { my $self = shift; return ($self->ordinals16, $self->ordinals32); }
 231
 232 ########################################################################
 233 # prefix
 234 #
 235
 236 sub prefix {
 237     my $self = shift;
 238     my $module16 = $self->module16;
 239     my $module32 = $self->module32;
 240
 241     my $file = $self->file;
 242     my $function_line = $self->function_line;
 243     my $return_type = $self->return_type;
 244     my $internal_name = $self->internal_name;
 245     my $calling_convention = $self->calling_convention;
 246
 247     my $refargument_types = $self->argument_types;
 248     my @argument_types = ();
 249     if(defined($refargument_types)) {
 250         @argument_types = @$refargument_types;
 251         if($#argument_types < 0) {
 252             @argument_types = ("void");
 253         }
 254     }
 255
 256     my $prefix = "";
 257
 258     my @modules = ();
 259     my %used;
 260     foreach my $module ($self->modules) {
 261         if($used{$module}) { next; }
 262         push @modules, $module;
 263         $used{$module}++;
 264     }
 265     $prefix .= "$file:";
 266     if(defined($function_line)) {
 267         $prefix .= "$function_line: ";
 268     } else {
 269         $prefix .= "<>: ";
 270     }
 271     if($#modules >= 0) {
 272         $prefix .= join(" & ", @modules) . ": ";
 273     } else {
 274         $prefix .= "<>: ";
 275     }
 276     $prefix .= "$return_type ";
 277     $prefix .= "$calling_convention " if $calling_convention;
 278     $prefix .= "$internal_name(" . join(",", @argument_types) . "): ";
 279
 280     return $prefix;
 281 }
 282
 283 ########################################################################
 284 # calling_convention
 285 #
 286
 287 sub calling_convention16 {
 288     my $self = shift;
 289     my $return_kind16 = $self->return_kind16;
 290
 291     my $suffix;
 292     if(!defined($return_kind16)) {
 293         $suffix = undef;
 294     } elsif($return_kind16 =~ /^(?:void|s_word|word)$/) {
 295         $suffix = "16";
 296     } elsif($return_kind16 =~ /^(?:long|ptr|segptr|segstr|str|wstr)$/) {
 297         $suffix = "";
 298     } else {
 299         $suffix = undef;
 300     }
 301
 302     local $_ = $self->calling_convention;
 303     if(/^__cdecl$/) {
 304         return "cdecl";
 305     } elsif(/^VFWAPIV|WINAPIV$/) {
 306         if(!defined($suffix)) { return undef; }
 307         return "pascal$suffix"; # FIXME: Is this correct?
 308     } elsif(/^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
 309         if(!defined($suffix)) { return undef; }
 310         return "pascal$suffix";
 311     } elsif(/^__asm$/) {
 312         return "asm";
 313     } else {
 314         return "cdecl";
 315     }
 316 }
 317
 318 sub calling_convention32 {
 319     my $self = shift;
 320
 321     local $_ = $self->calling_convention;
 322     if(/^__cdecl$/) {
 323         return "cdecl";
 324     } elsif(/^VFWAPIV|WINAPIV$/) {
 325         return "varargs";
 326     } elsif(/^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
 327         return "stdcall";
 328     } elsif(/^__asm$/) {
 329         return "asm";
 330     } else {
 331         return "cdecl";
 332     }
 333 }
 334
 335 sub get_all_module_ordinal16 {
 336     my $self = shift;
 337     my $internal_name = $self->internal_name;
 338
 339     return winapi::get_all_module_internal_ordinal16($internal_name);
 340 }
 341
 342 sub get_all_module_ordinal32 {
 343     my $self = shift;
 344     my $internal_name = $self->internal_name;
 345
 346     return winapi::get_all_module_internal_ordinal32($internal_name);
 347 }
 348
 349 sub get_all_module_ordinal {
 350     my $self = shift;
 351     my $internal_name = $self->internal_name;
 352
 353     return winapi::get_all_module_internal_ordinal($internal_name);
 354 }
 355
 356 sub _return_kind {
 357     my $self = shift;
 358     my $winapi = shift;
 359     my $return_type = $self->return_type;
 360
 361     return $winapi->translate_argument($return_type);
 362 }
 363
 364 sub return_kind16 {
 365     my $self = shift; return $self->_return_kind($win16api, @_);
 366 }
 367
 368 sub return_kind32 {
 369     my $self = shift; return $self->_return_kind($win32api, @_);
 370 }
 371
 372 sub _argument_kinds {
 373     my $self = shift;
 374     my $winapi = shift;
 375     my $refargument_types = $self->argument_types;
 376
 377     if(!defined($refargument_types)) {
 378         return undef;
 379     }
 380
 381     my @argument_kinds;
 382     foreach my $argument_type (@$refargument_types) {
 383         my $argument_kind = $winapi->translate_argument($argument_type);
 384
 385         if(defined($argument_kind) && $argument_kind eq "longlong") {
 386             push @argument_kinds, ("long", "long");
 387         } else {
 388             push @argument_kinds, $argument_kind;
 389         }
 390     }
 391
 392     return [@argument_kinds];
 393 }
 394
 395 sub argument_kinds16 {
 396     my $self = shift; return $self->_argument_kinds($win16api, @_);
 397 }
 398
 399 sub argument_kinds32 {
 400     my $self = shift; return $self->_argument_kinds($win32api, @_);
 401 }
 402
 403 ##############################################################################
 404 # Accounting
 405 #
 406
 407 sub function_called {
 408     my $self = shift;
 409     my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}};
 410
 411     my $name = shift;
 412
 413     $$called_function_names{$name}++;
 414 }
 415
 416 sub function_called_by {
 417    my $self = shift;
 418    my $called_by_function_names = \%{$self->{CALLED_BY_FUNCTION_NAMES}};
 419
 420    my $name = shift;
 421
 422    $$called_by_function_names{$name}++;
 423 }
 424
 425 sub called_function_names {
 426     my $self = shift;
 427     my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}};
 428
 429     return sort(keys(%$called_function_names));
 430 }
 431
 432 sub called_by_function_names {
 433     my $self = shift;
 434     my $called_by_function_names = \%{$self->{CALLED_BY_FUNCTION_NAMES}};
 435
 436     return sort(keys(%$called_by_function_names));
 437 }
 438
 439
 440 1;