tools/winapi_check/winapi_function.pm

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