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