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