winapi_function.pm 11 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# 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
use base qw(function);
21 22 23

use strict;

24
use config qw($current_dir $wine_dir);
25
use util qw(normalize_set);
26 27 28

my $import = 0;
use vars qw($modules $win16api $win32api @winapis);
29 30 31 32 33

########################################################################
# constructor
#

34
sub new($) {
35 36 37 38 39
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

40 41 42 43 44 45 46 47 48
    if (!$import) {
	require modules;
	import modules qw($modules);
	
	require winapi;
	import winapi qw($win16api $win32api @winapis);

	$import = 1;
    }
49 50 51
    return $self;
}

52 53 54 55
########################################################################
# is_win
#

56 57
sub is_win16($) { my $self = shift; return defined($self->_module($win16api, @_)); }
sub is_win32($) { my $self = shift; return defined($self->_module($win32api, @_)); }
58

59
########################################################################
60
# external_name
61
#
62

63
sub _external_name($$) {
64
    my $self = shift;
65 66 67
    my $winapi = shift;

    my $file = $self->file;
68
    my $internal_name = $self->internal_name;
69

70 71
    my $external_name = $winapi->function_external_name($internal_name);
    my $module = $winapi->function_internal_module($internal_name);
72

73 74
    if(!defined($external_name) && !defined($module)) {
	return undef;
75
    }
76

77 78
    my @external_names = split(/\s*&\s*/, $external_name);
    my @modules = split(/\s*&\s*/, $module);
79

80 81 82 83 84 85 86 87
    my @external_names2;
    while(defined(my $external_name = shift @external_names) &&
	  defined(my $module = shift @modules))
    {
	if($modules->is_allowed_module_in_file($module, "$current_dir/$file")) {
	    push @external_names2, $external_name;
	}
    }
88

89
    return join(" & ", @external_names2);
90
}
91

92
sub _external_names($$) {
93
    my $self = shift;
94 95 96
    my $winapi = shift;

    my $external_name = $self->_external_name($winapi);
97

98 99
    if(defined($external_name)) {
	return split(/\s*&\s*/, $external_name);
100 101 102
    } else {
	return ();
    }
103 104
}

105
sub external_name($) {
106 107 108 109 110 111 112 113 114 115 116 117 118
    my $self = shift;

    foreach my $winapi (@winapis) {
	my $external_name = $self->_external_name($winapi, @_);

	if(defined($external_name)) {
	    return $external_name;
	}
    }

    return undef;
}

119 120
sub external_name16($) { my $self = shift; return $self->_external_name($win16api, @_); }
sub external_name32($) { my $self = shift; return $self->_external_name($win32api, @_); }
Patrik Stridvall's avatar
Patrik Stridvall committed
121

122 123
sub external_names16($) { my $self = shift; return $self->_external_names($win16api, @_); }
sub external_names32($) { my $self = shift; return $self->_external_names($win32api, @_); }
Patrik Stridvall's avatar
Patrik Stridvall committed
124

125
sub external_names($) { my $self = shift; return ($self->external_names16, $self->external_names32); }
Patrik Stridvall's avatar
Patrik Stridvall committed
126

127 128 129 130
########################################################################
# module
#

131
sub _module($$) {
132
    my $self = shift;
133 134 135
    my $winapi = shift;

    my $file = $self->file;
136
    my $internal_name = $self->internal_name;
137

138 139 140 141 142
    my $module = $winapi->function_internal_module($internal_name);
    if(!defined($module)) {
	return undef;
    }

Patrik Stridvall's avatar
Patrik Stridvall committed
143 144 145 146
    if(!defined($file)) {
	return undef;
    }

147 148 149 150 151 152 153 154
    my @modules;
    foreach my $module (split(/\s*&\s*/, $module)) {
	if($modules->is_allowed_module_in_file($module, "$current_dir/$file")) {
	    push @modules, $module;
	}
    }

    return join(" & ", @modules);
155
}
156

157
sub _modules($$) {
158
    my $self = shift;
159 160 161
    my $winapi = shift;

    my $module = $self->_module($winapi);
162

163 164
    if(defined($module)) {
	return split(/\s*&\s*/, $module);
165 166 167
    } else {
	return ();
    }
168 169
}

170 171
sub module16($) { my $self = shift; return $self->_module($win16api, @_); }
sub module32($) { my $self = shift; return $self->_module($win32api, @_); }
172

173
sub module($) { my $self = shift; return join (" & ", $self->modules); }
174

175 176
sub modules16($) { my $self = shift; return $self->_modules($win16api, @_); }
sub modules32($) { my $self = shift; return $self->_modules($win32api, @_); }
177

178
sub modules($) { my $self = shift; return ($self->modules16, $self->modules32); }
179 180 181 182 183

########################################################################
# ordinal
#

184
sub _ordinal($$) {
185
    my $self = shift;
186 187 188
    my $winapi = shift;

    my $file = $self->file;
189
    my $internal_name = $self->internal_name;
190

191 192
    my $ordinal = $winapi->function_internal_ordinal($internal_name);
    my $module = $winapi->function_internal_module($internal_name);
193

194 195 196 197 198 199
    if(!defined($ordinal) && !defined($module)) {
	return undef;
    }

    my @ordinals = split(/\s*&\s*/, $ordinal);
    my @modules = split(/\s*&\s*/, $module);
200

201 202 203 204 205 206 207
    my @ordinals2;
    while(defined(my $ordinal = shift @ordinals) &&
	  defined(my $module = shift @modules))
    {
	if($modules->is_allowed_module_in_file($module, "$current_dir/$file")) {
	    push @ordinals2, $ordinal;
	}
208
    }
209 210

    return join(" & ", @ordinals2);
211 212
}

213
sub _ordinals($$) {
214
    my $self = shift;
215
    my $winapi = shift;
216

217
    my $ordinal = $self->_ordinal($winapi);
218

219 220
    if(defined($ordinal)) {
	return split(/\s*&\s*/, $ordinal);
221
    } else {
222
	return ();
223
    }
Patrik Stridvall's avatar
Patrik Stridvall committed
224 225
}

226 227
sub ordinal16($) { my $self = shift; return $self->_ordinal($win16api, @_); }
sub ordinal32($) { my $self = shift; return $self->_ordinal($win32api, @_); }
Patrik Stridvall's avatar
Patrik Stridvall committed
228

229
sub ordinal($) { my $self = shift; return join (" & ", $self->ordinals); }
Patrik Stridvall's avatar
Patrik Stridvall committed
230

231 232
sub ordinals16($) { my $self = shift; return $self->_ordinals($win16api, @_); }
sub ordinals32($) { my $self = shift; return $self->_ordinals($win32api, @_); }
233

234
sub ordinals($) { my $self = shift; return ($self->ordinals16, $self->ordinals32); }
235 236 237 238

########################################################################
# prefix
#
Patrik Stridvall's avatar
Patrik Stridvall committed
239

240
sub prefix($) {
Patrik Stridvall's avatar
Patrik Stridvall committed
241
    my $self = shift;
242 243
    my $module16 = $self->module16;
    my $module32 = $self->module32;
Patrik Stridvall's avatar
Patrik Stridvall committed
244

245
    my $file = $self->file;
246
    my $function_line = $self->function_line;
247 248 249
    my $return_type = $self->return_type;
    my $internal_name = $self->internal_name;
    my $calling_convention = $self->calling_convention;
Patrik Stridvall's avatar
Patrik Stridvall committed
250

251 252 253 254 255 256 257
    my $refargument_types = $self->argument_types;
    my @argument_types = ();
    if(defined($refargument_types)) {
	@argument_types = @$refargument_types;
	if($#argument_types < 0) {
	    @argument_types = ("void");
	}
258 259 260
    }

    my $prefix = "";
261 262 263 264 265 266 267 268

    my @modules = ();
    my %used;
    foreach my $module ($self->modules) {
	if($used{$module}) { next; }
	push @modules, $module;
	$used{$module}++;
    }
269 270 271 272 273 274
    $prefix .= "$file:";
    if(defined($function_line)) {
	$prefix .= "$function_line: ";
    } else {
	$prefix .= "<>: ";
    }
275 276
    if($#modules >= 0) {
	$prefix .= join(" & ", @modules) . ": ";
277 278 279 280 281 282 283 284
    } else {
	$prefix .= "<>: ";
    }
    $prefix .= "$return_type ";
    $prefix .= "$calling_convention " if $calling_convention;
    $prefix .= "$internal_name(" . join(",", @argument_types) . "): ";

    return $prefix;
285 286
}

287 288 289 290
########################################################################
# calling_convention
#

291
sub calling_convention16($) {
292
    my $self = shift;
293 294 295 296 297 298 299 300 301 302 303 304
    my $return_kind16 = $self->return_kind16;

    my $suffix;
    if(!defined($return_kind16)) {
	$suffix = undef;
    } elsif($return_kind16 =~ /^(?:void|s_word|word)$/) {
	$suffix = "16";
    } elsif($return_kind16 =~ /^(?:long|ptr|segptr|segstr|str|wstr)$/) {
	$suffix = "";
    } else {
	$suffix = undef;
    }
305

306
    local $_ = $self->calling_convention;
307
    if($_ eq "__cdecl") {
308
	return "cdecl";
309
    } elsif(/^(?:VFWAPIV|WINAPIV)$/) {
310 311
	if(!defined($suffix)) { return undef; }
	return "pascal$suffix"; # FIXME: Is this correct?
312
    } elsif(/^(?:__stdcall|__RPC_STUB|__RPC_USER|NET_API_FUNCTION|RPC_ENTRY|VFWAPI|WINAPI|CALLBACK)$/) {
313 314
	if(!defined($suffix)) { return undef; }
	return "pascal$suffix";
315
    } elsif($_ eq "__asm") {
316 317 318 319
	return "asm";
    } else {
	return "cdecl";
    }
320 321
}

322
sub calling_convention32($) {
323 324
    my $self = shift;

325
    local $_ = $self->calling_convention;
326
    if($_ eq "__cdecl") {
327
	return "cdecl";
328
    } elsif(/^(?:VFWAPIV|WINAPIV)$/) {
329
	return "varargs";
330
    } elsif(/^(?:__stdcall|__RPC_STUB|__RPC_USER|NET_API_FUNCTION|RPC_ENTRY|VFWAPI|WINAPI|CALLBACK)$/) {
331
	return "stdcall";
332
    } elsif($_ eq "__asm") {
333 334 335 336
	return "asm";
    } else {
	return "cdecl";
    }
337 338
}

339
sub get_all_module_ordinal16($) {
340
    my $self = shift;
341
    my $internal_name = $self->internal_name;
342

343
    return winapi::get_all_module_internal_ordinal16($internal_name);
344 345
}

346
sub get_all_module_ordinal32($) {
347
    my $self = shift;
348
    my $internal_name = $self->internal_name;
349

350
    return winapi::get_all_module_internal_ordinal32($internal_name);
351 352
}

353
sub get_all_module_ordinal($) {
354
    my $self = shift;
355
    my $internal_name = $self->internal_name;
356

357
    return winapi::get_all_module_internal_ordinal($internal_name);
358 359
}

360
sub _return_kind($$) {
361
    my $self = shift;
362 363
    my $winapi = shift;
    my $return_type = $self->return_type;
364

365 366
    return $winapi->translate_argument($return_type);
}
367

368
sub return_kind16($) {
369
    my $self = shift; return $self->_return_kind($win16api, @_);
370 371
}

372
sub return_kind32($) {
373 374
    my $self = shift; return $self->_return_kind($win32api, @_);
}
375

376
sub _argument_kinds($$) {
377 378
    my $self = shift;
    my $winapi = shift;
379 380 381 382 383
    my $refargument_types = $self->argument_types;

    if(!defined($refargument_types)) {
	return undef;
    }
384 385

    my @argument_kinds;
386
    foreach my $argument_type (@$refargument_types) {
387 388 389
	my $argument_kind = $winapi->translate_argument($argument_type);

	if(defined($argument_kind) && $argument_kind eq "longlong") {
390
	    push @argument_kinds, "double";
391 392 393
	} else {
	    push @argument_kinds, $argument_kind;
	}
394
    }
395 396

    return [@argument_kinds];
397 398
}

399
sub argument_kinds16($) {
400 401 402
    my $self = shift; return $self->_argument_kinds($win16api, @_);
}

403
sub argument_kinds32($) {
404 405 406 407 408 409 410
    my $self = shift; return $self->_argument_kinds($win32api, @_);
}

##############################################################################
# Accounting
#

411
sub function_called($$) {
412 413 414 415 416 417 418 419
    my $self = shift;
    my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}};

    my $name = shift;

    $$called_function_names{$name}++;
}

420
sub function_called_by($$) {
421 422 423 424 425 426 427 428
   my $self = shift;
   my $called_by_function_names = \%{$self->{CALLED_BY_FUNCTION_NAMES}};

   my $name = shift;

   $$called_by_function_names{$name}++;
}

429
sub called_function_names($) {
430 431 432 433 434 435
    my $self = shift;
    my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}};

    return sort(keys(%$called_function_names));
}

436
sub called_by_function_names($) {
437 438 439 440 441 442 443 444
    my $self = shift;
    my $called_by_function_names = \%{$self->{CALLED_BY_FUNCTION_NAMES}};

    return sort(keys(%$called_by_function_names));
}


1;