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