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