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 util qw(&normalize_set);
   7 use winapi qw($win16api $win32api @winapis);
   8
   9 ########################################################################
  10 # constructor
  11 #
  12
  13 sub new {
  14     my $proto = shift;
  15     my $class = ref($proto) || $proto;
  16     my $self  = {};
  17     bless ($self, $class);
  18
  19     return $self;
  20 }
  21
  22 ########################################################################
  23 # winapi
  24 #
  25
  26 sub external_name16 {
  27     my $self = shift;
  28     my $internal_name = $self->internal_name;
  29
  30     return $win16api->function_external_name($internal_name);
  31 }
  32
  33 sub external_names16 {
  34     my $self = shift;
  35     my $external_name16 = $self->external_name16;
  36
  37     if(defined($external_name16)) {
  38         return split(/\s*&\s*/, $external_name16);
  39     } else {
  40         return ();
  41     }
  42 }
  43
  44 sub external_name32 {
  45     my $self = shift;
  46     my $internal_name = $self->internal_name;
  47
  48     return $win32api->function_external_name($internal_name);
  49 }
  50
  51 sub external_names32 {
  52     my $self = shift;
  53     my $external_name32 = $self->external_name32;
  54
  55     if(defined($external_name32)) {
  56         return split(/\s*&\s*/, $external_name32);
  57     } else {
  58         return ();
  59     }
  60 }
  61
  62 sub external_names {
  63     my $self = shift;
  64
  65     my @external_names;
  66     push @external_names, $self->external_names16;
  67     push @external_names, $self->external_names32;
  68
  69     return @external_names;
  70 }
  71
  72 sub module16 {
  73     my $self = shift;
  74     my $internal_name = $self->internal_name;
  75
  76     return $win16api->function_internal_module($internal_name);
  77 }
  78
  79 sub modules16 {
  80     my $self = shift;
  81     my $module16 = $self->module16;
  82
  83     if(defined($module16)) {
  84         return split(/\s*&\s*/, $module16);
  85     } else {
  86         return ();
  87     }
  88 }
  89
  90 sub module32 {
  91     my $self = shift;
  92     my $internal_name = $self->internal_name;
  93
  94     return $win32api->function_internal_module($internal_name);
  95 }
  96
  97 sub modules32 {
  98     my $self = shift;
  99     my $module32 = $self->module32;
 100
 101     if(defined($module32)) {
 102         return split(/\s*&\s*/, $module32);
 103     } else {
 104         return ();
 105     }
 106 }
 107
 108 sub module {
 109     my $self = shift;
 110     my $module16 = $self->module16;
 111     my $module32 = $self->module32;
 112
 113     my $module;
 114     if(defined($module16) && defined($module32)) {
 115         $module = "$module16 & $module32";
 116     } elsif(defined($module16)) {
 117         $module = $module16;
 118     } elsif(defined($module32)) {
 119         $module = $module32;
 120     } else {
 121         $module = "";
 122     }
 123 }
 124
 125 sub modules {
 126     my $self = shift;
 127
 128     my @modules;
 129     push @modules, $self->modules16;
 130     push @modules, $self->modules32;
 131
 132     return @modules;
 133 }
 134
 135 sub prefix {
 136     my $self = shift;
 137     my $module16 = $self->module16;
 138     my $module32 = $self->module32;
 139
 140     my $return_type = $self->return_type;
 141     my $internal_name = $self->internal_name;
 142     my $calling_convention = $self->calling_convention;
 143     my @argument_types = @{$self->argument_types};
 144
 145     if($#argument_types < 0) {
 146         @argument_types = ("void");
 147     }
 148
 149     my $prefix = "";
 150     if(defined($module16) && !defined($module32)) {
 151         $prefix .= normalize_set($module16) . ": ";
 152     } elsif(!defined($module16) && defined($module32)) {
 153         $prefix .= normalize_set($module32) . ": ";
 154     } elsif(defined($module16) && defined($module32)) {
 155         $prefix .= normalize_set($module16) . " & " . normalize_set($module32) . ": ";
 156     } else {
 157         $prefix .= "<>: ";
 158     }
 159     $prefix .= "$return_type ";
 160     $prefix .= "$calling_convention " if $calling_convention;
 161     $prefix .= "$internal_name(" . join(",", @argument_types) . "): ";
 162
 163     return $prefix;
 164 }
 165
 166 sub calling_convention16 {
 167     my $self = shift;
 168     my $return_kind16 = $self->return_kind16;
 169
 170     my $suffix;
 171     if(!defined($return_kind16)) {
 172         $suffix = undef;
 173     } elsif($return_kind16 =~ /^(?:void|s_word|word)$/) {
 174         $suffix = "16";
 175     } elsif($return_kind16 =~ /^(?:long|ptr|segptr|segstr|str|wstr)$/) {
 176         $suffix = "";
 177     } else {
 178         $suffix = undef;
 179     }
 180
 181     local $_ = $self->calling_convention;
 182     if(/^__cdecl$/) {
 183         return "cdecl";
 184     } elsif(/^VFWAPIV|WINAPIV$/) {
 185         if(!defined($suffix)) { return undef; }
 186         return "pascal$suffix"; # FIXME: Is this correct?
 187     } elsif(/^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
 188         if(!defined($suffix)) { return undef; }
 189         return "pascal$suffix";
 190     } elsif(/^__asm$/) {
 191         return "asm";
 192     } else {
 193         return "cdecl";
 194     }
 195 }
 196
 197 sub calling_convention32 {
 198     my $self = shift;
 199
 200     local $_ = $self->calling_convention;
 201     if(/^__cdecl$/) {
 202         return "cdecl";
 203     } elsif(/^VFWAPIV|WINAPIV$/) {
 204         return "varargs";
 205     } elsif(/^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
 206         return "stdcall";
 207     } elsif(/^__asm$/) {
 208         return "asm";
 209     } else {
 210         return "cdecl";
 211     }
 212 }
 213
 214 sub get_all_module_ordinal16 {
 215     my $self = shift;
 216     my $internal_name = $self->internal_name;
 217
 218     return winapi::get_all_module_internal_ordinal16($internal_name);
 219 }
 220
 221 sub get_all_module_ordinal32 {
 222     my $self = shift;
 223     my $internal_name = $self->internal_name;
 224
 225     return winapi::get_all_module_internal_ordinal32($internal_name);
 226 }
 227
 228 sub get_all_module_ordinal {
 229     my $self = shift;
 230     my $internal_name = $self->internal_name;
 231
 232     return winapi::get_all_module_internal_ordinal($internal_name);
 233 }
 234
 235 sub _return_kind {
 236     my $self = shift;
 237     my $winapi = shift;
 238     my $return_type = $self->return_type;
 239
 240     return $winapi->translate_argument($return_type);
 241 }
 242
 243 sub return_kind16 {
 244     my $self = shift; return $self->_return_kind($win16api, @_);
 245 }
 246
 247 sub return_kind32 {
 248     my $self = shift; return $self->_return_kind($win32api, @_);
 249 }
 250
 251 sub _argument_kinds {
 252     my $self = shift;
 253     my $winapi = shift;
 254     my @argument_types = @{$self->argument_types};
 255
 256     my @argument_kinds;
 257     foreach my $argument_type (@argument_types) {
 258         my $argument_kind = $winapi->translate_argument($argument_type);
 259
 260         if(defined($argument_kind) && $argument_kind eq "longlong") {
 261             push @argument_kinds, ("long", "long");
 262         } else {
 263             push @argument_kinds, $argument_kind;
 264         }
 265     }
 266
 267     return [@argument_kinds];
 268 }
 269
 270 sub argument_kinds16 {
 271     my $self = shift; return $self->_argument_kinds($win16api, @_);
 272 }
 273
 274 sub argument_kinds32 {
 275     my $self = shift; return $self->_argument_kinds($win32api, @_);
 276 }
 277
 278 ##############################################################################
 279 # Accounting
 280 #
 281
 282 sub function_called {
 283     my $self = shift;
 284     my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}};
 285
 286     my $name = shift;
 287
 288     $$called_function_names{$name}++;
 289 }
 290
 291 sub function_called_by {
 292    my $self = shift;
 293    my $called_by_function_names = \%{$self->{CALLED_BY_FUNCTION_NAMES}};
 294
 295    my $name = shift;
 296
 297    $$called_by_function_names{$name}++;
 298 }
 299
 300 sub called_function_names {
 301     my $self = shift;
 302     my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}};
 303
 304     return sort(keys(%$called_function_names));
 305 }
 306
 307 sub called_by_function_names {
 308     my $self = shift;
 309     my $called_by_function_names = \%{$self->{CALLED_BY_FUNCTION_NAMES}};
 310
 311     return sort(keys(%$called_by_function_names));
 312 }
 313
 314
 315 1;