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