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