Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
W
wine-cw
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Registry
Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
wine
wine-cw
Commits
c3e8ac32
Commit
c3e8ac32
authored
Jul 11, 2001
by
Patrik Stridvall
Committed by
Alexandre Julliard
Jul 11, 2001
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Major reorganization and cleanup.
parent
d342ed2b
Show whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
890 additions
and
764 deletions
+890
-764
config.pm
tools/winapi/config.pm
+4
-35
function.pm
tools/winapi/function.pm
+157
-0
options.pm
tools/winapi/options.pm
+15
-13
util.pm
tools/winapi/util.pm
+44
-1
winapi_extract
tools/winapi/winapi_extract
+183
-125
winapi_fixup
tools/winapi/winapi_fixup
+70
-110
wow32.api
tools/winapi_check/win32/wow32.api
+1
-0
winapi.pm
tools/winapi_check/winapi.pm
+84
-7
winapi_check
tools/winapi_check/winapi_check
+71
-335
winapi_documentation.pm
tools/winapi_check/winapi_documentation.pm
+8
-5
winapi_function.pm
tools/winapi_check/winapi_function.pm
+190
-102
winapi_local.pm
tools/winapi_check/winapi_local.pm
+1
-1
winapi_options.pm
tools/winapi_check/winapi_options.pm
+0
-1
winapi_parser.pm
tools/winapi_check/winapi_parser.pm
+62
-29
No files found.
tools/winapi/config.pm
View file @
c3e8ac32
...
...
@@ -9,11 +9,10 @@ require Exporter;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw(
&file_absolutize &file_normalize
&file_type &files_filter
&file_skip &files_skip
&file_absolutize &file_normalize
&get_spec_files
&translate_calling_convention16 &translate_calling_convention32
)
;
@EXPORT_OK
=
qw(
$current_dir $wine_dir $winapi_dir $winapi_check_dir
...
...
@@ -21,6 +20,8 @@ require Exporter;
use
vars
qw($current_dir $wine_dir $winapi_dir $winapi_check_dir)
;
my
$output
=
"output"
;
sub
file_type
{
local
$_
=
shift
;
...
...
@@ -98,7 +99,7 @@ sub file_normalize {
}
sub
get_spec_files
{
output
->
progress
(
"$wine_dir: searching for *.spec"
);
$
output
->
progress
(
"$wine_dir: searching for *.spec"
);
my
@spec_files
=
map
{
s%^\./%%
;
...
...
@@ -113,36 +114,4 @@ sub get_spec_files {
return
@spec_files
;
}
sub
translate_calling_convention16
{
local
$_
=
shift
;
if
(
/^__cdecl$/
)
{
return
"cdecl"
;
}
elsif
(
/^VFWAPIV|WINAPIV$/
)
{
return
"pascal"
;
# FIXME: Is this correct?
}
elsif
(
/^__stdcall|VFWAPI|WINAPI|CALLBACK$/
)
{
return
"pascal"
;
}
elsif
(
/^__asm$/
)
{
return
"asm"
;
}
else
{
return
"cdecl"
;
}
}
sub
translate_calling_convention32
{
local
$_
=
shift
;
if
(
/^__cdecl$/
)
{
return
"cdecl"
;
}
elsif
(
/^VFWAPIV|WINAPIV$/
)
{
return
"varargs"
;
}
elsif
(
/^__stdcall|VFWAPI|WINAPI|CALLBACK$/
)
{
return
"stdcall"
;
}
elsif
(
/^__asm$/
)
{
return
"asm"
;
}
else
{
return
"cdecl"
;
}
}
1
;
tools/winapi/function.pm
0 → 100644
View file @
c3e8ac32
package
function
;
use
strict
;
sub
new
{
my
$proto
=
shift
;
my
$class
=
ref
(
$proto
)
||
$proto
;
my
$self
=
{};
bless
(
$self
,
$class
);
return
$self
;
}
sub
file
{
my
$self
=
shift
;
my
$file
=
\
$
{
$self
->
{
FILE
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$file
=
$_
;
}
return
$$file
;
}
sub
debug_channels
{
my
$self
=
shift
;
my
$debug_channels
=
\
$
{
$self
->
{
DEBUG_CHANNELS
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$debug_channels
=
$_
;
}
return
$$debug_channels
;
}
sub
documentation_line
{
my
$self
=
shift
;
my
$documentation_line
=
\
$
{
$self
->
{
DOCUMENTATION_LINE
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$documentation_line
=
$_
;
}
return
$$documentation_line
;
}
sub
documentation
{
my
$self
=
shift
;
my
$documentation
=
\
$
{
$self
->
{
DOCUMENTATION
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$documentation
=
$_
;
}
return
$$documentation
;
}
sub
function_line
{
my
$self
=
shift
;
my
$function_line
=
\
$
{
$self
->
{
FUNCTION_LINE
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$function_line
=
$_
;
}
return
$$function_line
;
}
sub
linkage
{
my
$self
=
shift
;
my
$linkage
=
\
$
{
$self
->
{
LINKAGE
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$linkage
=
$_
;
}
return
$$linkage
;
}
sub
return_type
{
my
$self
=
shift
;
my
$return_type
=
\
$
{
$self
->
{
RETURN_TYPE
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$return_type
=
$_
;
}
return
$$return_type
;
}
sub
calling_convention
{
my
$self
=
shift
;
my
$calling_convention
=
\
$
{
$self
->
{
CALLING_CONVENTION
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$calling_convention
=
$_
;
}
return
$$calling_convention
;
}
sub
internal_name
{
my
$self
=
shift
;
my
$internal_name
=
\
$
{
$self
->
{
INTERNAL_NAME
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$internal_name
=
$_
;
}
return
$$internal_name
;
}
sub
argument_types
{
my
$self
=
shift
;
my
$argument_types
=
\
$
{
$self
->
{
ARGUMENT_TYPES
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$argument_types
=
$_
;
}
return
$$argument_types
;
}
sub
argument_names
{
my
$self
=
shift
;
my
$argument_names
=
\
$
{
$self
->
{
ARGUMENT_NAMES
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$argument_names
=
$_
;
}
return
$$argument_names
;
}
sub
argument_documentations
{
my
$self
=
shift
;
my
$argument_documentations
=
\
$
{
$self
->
{
ARGUMENT_DOCUMENTATIONS
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$argument_documentations
=
$_
;
}
return
$$argument_documentations
;
}
sub
statements
{
my
$self
=
shift
;
my
$statements
=
\
$
{
$self
->
{
STATEMENTS
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$statements
=
$_
;
}
return
$$statements
;
}
1
;
tools/winapi/options.pm
View file @
c3e8ac32
...
...
@@ -9,6 +9,8 @@ require Exporter;
@EXPORT
=
qw(&parse_comma_list)
;
@EXPORT_OK
=
qw()
;
my
$output
=
"output"
;
sub
parse_comma_list
{
my
$prefix
=
shift
;
my
$value
=
shift
;
...
...
@@ -94,7 +96,7 @@ sub new {
$name
=
$1
;
$prefix
=
"no"
;
if
(
defined
(
$value
))
{
output
->
write
(
"options with prefix 'no' can't take parameters\n"
);
$
output
->
write
(
"options with prefix 'no' can't take parameters\n"
);
return
undef
;
}
...
...
@@ -156,12 +158,12 @@ sub new {
}
if
(
/^-(.*)$/
)
{
output
->
write
(
"unknown option: $_\n"
);
output
->
write
(
$$options_usage
);
$
output
->
write
(
"unknown option: $_\n"
);
$
output
->
write
(
$$options_usage
);
exit
1
;
}
else
{
if
(
!-
e
$_
)
{
output
->
write
(
"$_: no such file or directory\n"
);
$
output
->
write
(
"$_: no such file or directory\n"
);
exit
1
;
}
...
...
@@ -170,7 +172,7 @@ sub new {
}
if
(
$self
->
help
)
{
output
->
write
(
$$options_usage
);
$
output
->
write
(
$$options_usage
);
$self
->
show_help
;
exit
0
;
}
...
...
@@ -300,25 +302,25 @@ sub show_help {
}
}
output
->
write
(
$command
);
for
(
0
..
((
$maxname
-
length
(
$name
)
+
17
)
-
(
length
(
$command
)
-
length
(
$name
)
+
1
)))
{
output
->
write
(
" "
);
}
$
output
->
write
(
$command
);
for
(
0
..
((
$maxname
-
length
(
$name
)
+
17
)
-
(
length
(
$command
)
-
length
(
$name
)
+
1
)))
{
$
output
->
write
(
" "
);
}
if
(
ref
(
$value
)
ne
"HASH"
)
{
if
(
$value
)
{
output
->
write
(
"Disable "
);
$
output
->
write
(
"Disable "
);
}
else
{
output
->
write
(
"Enable "
);
$
output
->
write
(
"Enable "
);
}
}
else
{
if
(
$value
->
{
active
})
{
output
->
write
(
"(Disable) "
);
$
output
->
write
(
"(Disable) "
);
}
else
{
output
->
write
(
"Enable "
);
$
output
->
write
(
"Enable "
);
}
}
if
(
$default
==
$current
)
{
output
->
write
(
"$description (default)\n"
);
$
output
->
write
(
"$description (default)\n"
);
}
else
{
output
->
write
(
"$description\n"
);
$
output
->
write
(
"$description\n"
);
}
}
}
...
...
tools/winapi/util.pm
View file @
c3e8ac32
...
...
@@ -6,7 +6,10 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require
Exporter
;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw(append_file edit_file read_file replace_file)
;
@EXPORT
=
qw(
&append_file &edit_file &read_file &replace_file
&normalize_set &is_subset
)
;
@EXPORT_OK
=
qw()
;
%
EXPORT_TAGS
=
();
...
...
@@ -86,4 +89,44 @@ sub replace_file {
return
$result
;
}
########################################################################
# normalize_set
sub
normalize_set
{
local
$_
=
shift
;
if
(
!
defined
(
$_
))
{
return
undef
;
}
my
%
hash
=
();
foreach
my
$key
(
split
(
/\s*&\s*/
))
{
$hash
{
$key
}
++
;
}
return
join
(
" & "
,
sort
(
keys
(
%
hash
)));
}
########################################################################
# is_subset
sub
is_subset
{
my
$subset
=
shift
;
my
$set
=
shift
;
foreach
my
$subitem
(
split
(
/ & /
,
$subset
))
{
my
$match
=
0
;
foreach
my
$item
(
split
(
/ & /
,
$set
))
{
if
(
$subitem
eq
$item
)
{
$match
=
1
;
last
;
}
}
if
(
!
$match
)
{
return
0
;
}
}
return
1
;
}
1
;
tools/winapi/winapi_extract
View file @
c3e8ac32
...
...
@@ -13,12 +13,14 @@ use config qw(
&file_type &file_skip &files_skip &get_spec_files
$current_dir $wine_dir $winapi_dir $winapi_check_dir
)
;
use
modules
;
use
output
;
use
options
;
use
winapi
;
use
winapi_function
;
use
winapi_parser
;
my
$output
=
output
->
new
;
my
$output
=
'output'
->
new
;
my
%
options_long
=
(
"debug"
=>
{
default
=>
0
,
description
=>
"debug mode"
},
...
...
@@ -34,6 +36,7 @@ my %options_long = (
"global"
=>
{
default
=>
1
,
description
=>
"global extraction"
},
"spec-files"
=>
{
default
=>
1
,
parent
=>
"global"
,
description
=>
"spec files extraction"
},
"stub-statistics"
=>
{
default
=>
0
,
parent
=>
"global"
,
description
=>
"stub statistics"
},
);
my
%
options_short
=
(
...
...
@@ -44,7 +47,7 @@ my %options_short = (
my
$options_usage
=
"usage: winapi_extract [--help] [<files>]\n"
;
my
$options
=
options
->
new
(
\%
options_long
,
\%
options_short
,
$options_usage
);
my
$options
=
'options'
->
new
(
\%
options_long
,
\%
options_short
,
$options_usage
);
my
%
module2spec_file
;
my
%
module2type
;
...
...
@@ -73,44 +76,31 @@ my %module2type;
}
}
my
$win16api
=
winapi
->
new
(
$options
,
$output
,
"win16"
,
"$winapi_check_dir/win16"
);
my
$win32api
=
winapi
->
new
(
$options
,
$output
,
"win32"
,
"$winapi_check_dir/win32"
);
my
@winapis
=
(
$win16api
,
$win32api
);
my
%
specifications
;
my
$modules
=
'modules'
->
new
(
$options
,
$output
,
$wine_dir
,
$current_dir
,
\&
file_type
,
"$winapi_check_dir/modules.dat"
);
my
@files
=
files_skip
(
$options
->
c_files
);
my
$win16api
=
'winapi'
->
new
(
$options
,
$output
,
"win16"
,
"$winapi_check_dir/win16"
);
my
$win32api
=
'winapi'
->
new
(
$options
,
$output
,
"win32"
,
"$winapi_check_dir/win32"
);
my
@winapis
=
(
$win16api
,
$win32api
);
my
$progress_output
;
my
$progress_current
=
0
;
my
$progress_max
=
scalar
(
@files
);
if
(
$wine_dir
eq
"."
)
{
'winapi'
->
read_all_spec_files
(
$modules
,
$wine_dir
,
$current_dir
,
\&
file_type
,
$win16api
,
$win32api
);
}
else
{
my
@spec_files
=
$modules
->
allowed_spec_files
(
$wine_dir
,
$current_dir
);
'winapi'
->
read_spec_files
(
$modules
,
$wine_dir
,
$current_dir
,
\
@spec_files
,
$win16api
,
$win32api
);
}
foreach
my
$file
(
@files
)
{
my
$functions
=
0
;
my
%
specifications
;
$progress_current
++
;
if
(
$options
->
progress
)
{
output
->
progress
(
"$file: file $progress_current of $progress_max"
);
}
sub
documentation_specifications
{
my
$function
=
shift
;
my
$found_function
=
sub
{
my
$line
=
shift
;
my
$refdebug_channels
=
shift
;
my
@debug_channels
=
@$refdebug_channels
;
my
$documentation
=
shift
;
my
$linkage
=
shift
;
my
$return_type
=
shift
;
my
$calling_convention
=
shift
;
my
$internal_name
=
shift
;
my
$refargument_types
=
shift
;
my
@argument_types
=
@$refargument_types
;
my
$refargument_names
=
shift
;
my
@argument_names
=
@$refargument_names
;
my
$refargument_documentations
=
shift
;
my
@argument_documentations
=
@$refargument_documentations
;
my
$statements
=
shift
;
$functions
++
;
my
@debug_channels
=
@
{
$function
->
debug_channels
};
my
$documentation
=
$function
->
documentation
;
my
$documentation_line
=
$function
->
documentation_line
;
my
$return_type
=
$function
->
return_type
;
my
$linkage
=
$function
->
linkage
;
my
$internal_name
=
$function
->
internal_name
;
my
@argument_types
=
@
{
$function
->
argument_types
};
if
(
$linkage
eq
"static"
)
{
return
;
...
...
@@ -125,56 +115,107 @@ foreach my $file (@files) {
if
(
$ordinal
eq
"@"
)
{
if
(
1
||
!
exists
(
$specifications
{
$module
}{
unfixed
}{
$external_name
}))
{
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
debug_channels
}
=
[
@debug_channels
];
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
internal_name
}
=
$internal_name
;
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
external_name
}
=
$external_name
;
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
ordinal
}
=
$ordinal
;
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
return_type
}
=
$return_typ
e
;
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
argument_types
}
=
[
@argument_types
]
;
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
external_name
}
=
$external_nam
e
;
$specifications
{
$module
}{
unfixed
}{
$external_name
}{
function
}
=
$function
;
}
else
{
output
->
write
(
"$file:
$external_name ($module.$ordinal) already exists\n"
);
$output
->
write
(
"
$external_name ($module.$ordinal) already exists\n"
);
}
}
elsif
(
$ordinal
=~
/^\d+$/
)
{
if
(
1
||
!
exists
(
$specifications
{
$module
}{
fixed
}{
$ordinal
}))
{
$specifications
{
$module
}{
fixed
}{
$ordinal
}{
debug_channels
}
=
[
@debug_channels
];
$specifications
{
$module
}{
fixed
}{
$ordinal
}{
ordinal
}
=
$ordinal
;
$specifications
{
$module
}{
fixed
}{
$ordinal
}{
internal_name
}
=
$internal_name
;
$specifications
{
$module
}{
fixed
}{
$ordinal
}{
external_name
}
=
$external_name
;
$specifications
{
$module
}{
fixed
}{
$ordinal
}{
return_type
}
=
$return_type
;
$specifications
{
$module
}{
fixed
}{
$ordinal
}{
argument_types
}
=
[
@argument_types
];
$specifications
{
$module
}{
fixed
}{
$ordinal
}{
function
}
=
$function
;
}
else
{
output
->
write
(
"$file:
$external_name ($module.$ordinal) already exists\n"
);
$output
->
write
(
"
$external_name ($module.$ordinal) already exists\n"
);
}
}
elsif
(
$ordinal
eq
"init"
)
{
if
(
!
exists
(
$specifications
{
$module
}{
init
}))
{
$specifications
{
$module
}{
init
}{
debug_channels
}
=
[
@debug_channels
];
$specifications
{
$module
}{
init
}{
external_name
}
=
$external_name
;
$specifications
{
$module
}{
init
}{
internal_name
}
=
$internal_name
;
$specifications
{
$module
}{
init
}{
return_type
}
=
$return_type
;
$specifications
{
$module
}{
init
}{
argument_types
}
=
[
@argument_types
];
$specifications
{
$module
}{
init
}{
function
}
=
$function
;
}
else
{
output
->
write
(
"$file:
$external_name ($module.$ordinal) already exists\n"
);
$output
->
write
(
"
$external_name ($module.$ordinal) already exists\n"
);
}
}
else
{
if
(
!
exists
(
$specifications
{
$module
}{
unknown
}{
$external_name
}))
{
$specifications
{
$module
}{
unknown
}{
$external_name
}{
debug_channels
}
=
[
@debug_channels
];
$specifications
{
$module
}{
unknown
}{
$external_name
}{
internal_name
}
=
$internal_name
;
$specifications
{
$module
}{
unknown
}{
$external_name
}{
external_name
}
=
$external_name
;
$specifications
{
$module
}{
unknown
}{
$external_name
}{
ordinal
}
=
$ordinal
;
$specifications
{
$module
}{
unknown
}{
$external_name
}{
return_type
}
=
$return_typ
e
;
$specifications
{
$module
}{
unknown
}{
$external_name
}{
argument_types
}
=
[
@argument_types
]
;
$specifications
{
$module
}{
unknown
}{
$external_name
}{
external_name
}
=
$external_nam
e
;
$specifications
{
$module
}{
unknown
}{
$external_name
}{
function
}
=
$function
;
}
else
{
output
->
write
(
"$file:
$external_name ($module.$ordinal) already exists\n"
);
$output
->
write
(
"
$external_name ($module.$ordinal) already exists\n"
);
}
}
if
(
$options
->
debug
)
{
output
->
write
(
"$file:
$external_name ($module.$ordinal)\n"
);
$output
->
write
(
"
$external_name ($module.$ordinal)\n"
);
}
}
}
};
}
my
%
module_pseudo_stub_count16
;
my
%
module_pseudo_stub_count32
;
sub
statements_stub
{
my
$function
=
shift
;
my
$statements
=
$function
->
statements
;
if
(
defined
(
$statements
)
&&
$statements
=~
/FIXME[^;]*stub/s
)
{
if
(
$options
->
win16
)
{
foreach
my
$module16
(
$function
->
modules16
)
{
$module_pseudo_stub_count16
{
$module16
}
++
;
}
}
if
(
$options
->
win32
)
{
foreach
my
$module32
(
$function
->
modules32
)
{
$module_pseudo_stub_count32
{
$module32
}
++
;
}
}
}
}
my
@files
=
files_skip
(
$options
->
c_files
);
my
$progress_output
;
my
$progress_current
=
0
;
my
$progress_max
=
scalar
(
@files
);
foreach
my
$file
(
@files
)
{
my
%
functions
;
$progress_current
++
;
if
(
$options
->
progress
)
{
$output
->
progress
(
"$file: file $progress_current of $progress_max"
);
}
my
$found_function
=
sub
{
my
$function
=
shift
;
my
$documentation_line
=
$function
->
documentation_line
;
my
$documentation
=
$function
->
documentation
;
my
$function_line
=
$function
->
function_line
;
my
$linkage
=
$function
->
linkage
;
my
$return_type
=
$function
->
return_type
;
my
$calling_convention
=
$function
->
calling_convention
;
my
$internal_name
=
$function
->
internal_name
;
my
@argument_types
=
@
{
$function
->
argument_types
};
my
@argument_names
=
@
{
$function
->
argument_names
};
my
@argument_documentations
=
@
{
$function
->
argument_documentations
};
my
$statements
=
$function
->
statements
;
$functions
{
$internal_name
}
=
$function
;
$output
->
prefix
(
"$file: "
.
$function
->
prefix
);
if
(
$options
->
spec_files
)
{
documentation_specifications
(
$function
);
}
if
(
$options
->
stub_statistics
)
{
statements_stub
(
$function
);
}
$output
->
prefix
(
""
);
};
my
$found_preprocessor
=
sub
{
my
$directive
=
shift
;
...
...
@@ -183,62 +224,32 @@ foreach my $file (@files) {
winapi_parser::
parse_c_file
$options
,
$output
,
$file
,
$found_function
,
$found_preprocessor
;
if
(
$functions
==
0
)
{
output
->
write
(
"$file: doesn't contain any functions\n"
);
my
@internal_names
=
keys
(
%
functions
);
if
(
$#internal_names
<
0
)
{
$output
->
write
(
"$file: doesn't contain any functions\n"
);
}
}
sub
output_function
{
local
*
OUT
=
shift
;
my
$type
=
shift
;
my
$ordinal
=
shift
;
my
$external_name
=
shift
;
my
$function
=
shift
;
my
$internal_name
=
$function
->
{
internal_name
};
my
$external_name
=
$function
->
{
external_name
};
my
$ordinal
=
$function
->
{
ordinal
};
my
$return_type
=
$function
->
{
return_type
};
my
@argument_types
=
@
{
$function
->
{
argument_types
}};
my
$internal_name
=
$function
->
internal_name
;
my
$return_kind
;
if
(
$type
eq
"win16"
)
{
$return_kind
=
$win16api
->
translate_argument
(
$return_type
);
}
else
{
$return_kind
=
$win32api
->
translate_argument
(
$return_type
);
}
if
(
!
defined
(
$return_kind
))
{
$return_kind
=
"undef"
;
}
my
@argument_kinds
;
foreach
my
$argument_kind
(
@argument_kinds
)
{
my
$argument_kind
;
if
(
$type
eq
"win16"
)
{
$argument_kind
=
$win16api
->
translate_argument
(
$argument_kind
);
}
else
{
$argument_kind
=
$win32api
->
translate_argument
(
$argument_kind
);
}
if
(
!
defined
(
$argument_kind
))
{
$argument_kind
=
"undef"
;
}
if
(
$argument_kind
eq
"longlong"
)
{
push
@argument_kinds
,
(
"long"
,
"long"
);
}
else
{
push
@argument_kinds
,
$argument_kind
;
}
}
my
$calling_convention
;
my
@argument_kinds
;
if
(
$type
eq
"win16"
)
{
if
(
$return_kind
=~
/^(?:void|s_word|word)$/
)
{
$calling_convention
=
"pascal16"
;
}
elsif
(
$return_kind
=~
/^(?:long|ptr|segptr|segstr|str|wstr)$/
)
{
$calling_convention
=
"pascal"
;
}
else
{
$calling_convention
=
"undef"
;
}
}
else
{
$calling_convention
=
"stdcall"
;
$return_kind
=
$function
->
return_kind16
||
"undef"
;
$calling_convention
=
$function
->
calling_convention16
||
"undef"
;
@argument_kinds
=
map
{
$_
||
"undef"
;
}
@
{
$function
->
argument_kinds16
};
}
elsif
(
$type
eq
"win32"
)
{
$return_kind
=
$function
->
return_kind32
||
"undef"
;
$calling_convention
=
$function
->
calling_convention32
||
"undef"
;
@argument_kinds
=
map
{
$_
||
"undef"
;
}
@
{
$function
->
argument_kinds32
};
}
print
OUT
"$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n"
;
...
...
@@ -250,45 +261,45 @@ if($options->spec_files) {
my
$type
=
$module2type
{
$module
};
if
(
!
defined
(
$spec_file
)
||
!
defined
(
$type
))
{
output
->
write
(
"$module: doesn't exist\n"
);
$
output
->
write
(
"$module: doesn't exist\n"
);
next
;
}
$spec_file
.=
"2"
;
output
->
progress
(
"$spec_file"
);
$
output
->
progress
(
"$spec_file"
);
open
(
OUT
,
"> $wine_dir/$spec_file"
);
print
OUT
"name $module\n"
;
print
OUT
"type $type\n"
;
if
(
exists
(
$specifications
{
$module
}{
init
}))
{
my
$
init
=
$specifications
{
$module
}{
init
}{
internal_name
};
print
OUT
"init
$init
\n"
;
my
$
function
=
$specifications
{
$module
}{
init
}{
function
};
print
OUT
"init
"
.
$function
->
internal_name
.
"
\n"
;
}
print
OUT
"\n"
;
my
%
debug_channels
;
if
(
exists
(
$specifications
{
$module
}{
init
}))
{
my
$function
=
$specifications
{
$module
}{
init
};
foreach
my
$debug_channel
(
@
{
$function
->
{
debug_channels
}
})
{
my
$function
=
$specifications
{
$module
}{
init
}
{
function
}
;
foreach
my
$debug_channel
(
@
{
$function
->
debug_channels
})
{
$debug_channels
{
$debug_channel
}
++
;
}
}
foreach
my
$ordinal
(
sort
{
$a
<=>
$b
}
keys
(
%
{
$specifications
{
$module
}{
fixed
}}))
{
my
$function
=
$specifications
{
$module
}{
fixed
}{
$ordinal
};
foreach
my
$debug_channel
(
@
{
$function
->
{
debug_channels
}
})
{
my
$function
=
$specifications
{
$module
}{
fixed
}{
$ordinal
}
{
function
}
;
foreach
my
$debug_channel
(
@
{
$function
->
debug_channels
})
{
$debug_channels
{
$debug_channel
}
++
;
}
}
foreach
my
$name
(
sort
(
keys
(
%
{
$specifications
{
$module
}{
unfixed
}})))
{
my
$function
=
$specifications
{
$module
}{
unfixed
}{
$name
};
foreach
my
$debug_channel
(
@
{
$function
->
{
debug_channels
}
})
{
my
$function
=
$specifications
{
$module
}{
unfixed
}{
$name
}
{
function
}
;
foreach
my
$debug_channel
(
@
{
$function
->
debug_channels
})
{
$debug_channels
{
$debug_channel
}
++
;
}
}
foreach
my
$name
(
sort
(
keys
(
%
{
$specifications
{
$module
}{
unknown
}})))
{
my
$function
=
$specifications
{
$module
}{
unknown
}{
$name
}
;
foreach
my
$debug_channel
(
@
{
$function
->
{
debug_channels
}
})
{
my
$function
=
$specifications
{
$module
}{
unknown
}{
$name
}
{
function
};
foreach
my
$debug_channel
(
@
{
$function
->
debug_channels
})
{
$debug_channels
{
$debug_channel
}
++
;
}
}
...
...
@@ -305,10 +316,12 @@ if($options->spec_files) {
print
OUT
"\n"
;
$empty
=
1
;
}
foreach
my
$name
(
sort
(
keys
(
%
{
$specifications
{
$module
}{
unknown
}})))
{
my
$function
=
$specifications
{
$module
}{
unknown
}{
$name
};
foreach
my
$external_name
(
sort
(
keys
(
%
{
$specifications
{
$module
}{
unknown
}})))
{
my
$entry
=
$specifications
{
$module
}{
unknown
}{
$external_name
};
my
$ordinal
=
$entry
->
{
ordinal
};
my
$function
=
$entry
->
{
function
};
print
OUT
"# "
;
output_function
(
\*
OUT
,
$type
,
$function
);
output_function
(
\*
OUT
,
$type
,
$
ordinal
,
$external_name
,
$
function
);
$empty
=
0
;
}
...
...
@@ -317,8 +330,10 @@ if($options->spec_files) {
$empty
=
1
;
}
foreach
my
$ordinal
(
sort
{
$a
<=>
$b
}
keys
(
%
{
$specifications
{
$module
}{
fixed
}}))
{
my
$function
=
$specifications
{
$module
}{
fixed
}{
$ordinal
};
output_function
(
\*
OUT
,
$type
,
$function
);
my
$entry
=
$specifications
{
$module
}{
fixed
}{
$ordinal
};
my
$external_name
=
$entry
->
{
external_name
};
my
$function
=
$entry
->
{
function
};
output_function
(
\*
OUT
,
$type
,
$ordinal
,
$external_name
,
$function
);
$empty
=
0
;
}
...
...
@@ -326,13 +341,56 @@ if($options->spec_files) {
print
OUT
"\n"
;
$empty
=
1
;
}
foreach
my
$name
(
sort
(
keys
(
%
{
$specifications
{
$module
}{
unfixed
}})))
{
my
$function
=
$specifications
{
$module
}{
unfixed
}{
$name
};
output_function
(
\*
OUT
,
$type
,
$function
);
foreach
my
$external_name
(
sort
(
keys
(
%
{
$specifications
{
$module
}{
unfixed
}})))
{
my
$entry
=
$specifications
{
$module
}{
unfixed
}{
$external_name
};
my
$ordinal
=
$entry
->
{
ordinal
};
my
$function
=
$entry
->
{
function
};
output_function
(
\*
OUT
,
$type
,
$ordinal
,
$external_name
,
$function
);
$empty
=
0
;
}
close
(
OUT
);
}
}
output
->
hide_progress
;
if
(
$options
->
stub_statistics
)
{
foreach
my
$winapi
(
@winapis
)
{
if
(
$winapi
->
name
eq
"win16"
&&
!
$options
->
win16
)
{
next
;
}
if
(
$winapi
->
name
eq
"win32"
&&
!
$options
->
win32
)
{
next
;
}
my
%
module_stub_count
;
my
%
module_total_count
;
foreach
my
$internal_name
(
$winapi
->
all_internal_functions
,
$winapi
->
all_functions_stub
)
{
foreach
my
$module
(
split
(
/ \& /
,
$winapi
->
function_internal_module
(
$internal_name
)))
{
if
(
$winapi
->
function_stub
(
$internal_name
))
{
$module_stub_count
{
$module
}
++
;
}
$module_total_count
{
$module
}
++
;
}
}
foreach
my
$module
(
$winapi
->
all_modules
)
{
my
$pseudo_stubs
;
if
(
$winapi
->
name
eq
"win16"
)
{
$pseudo_stubs
=
$module_pseudo_stub_count16
{
$module
};
}
elsif
(
$winapi
->
name
eq
"win32"
)
{
$pseudo_stubs
=
$module_pseudo_stub_count32
{
$module
};
}
my
$real_stubs
=
$module_stub_count
{
$module
};
my
$total
=
$module_total_count
{
$module
};
if
(
!
defined
(
$real_stubs
))
{
$real_stubs
=
0
;
}
if
(
!
defined
(
$pseudo_stubs
))
{
$pseudo_stubs
=
0
;
}
if
(
!
defined
(
$total
))
{
$total
=
0
;}
my
$stubs
=
$real_stubs
+
$pseudo_stubs
;
$output
->
write
(
"*.c: $module: "
);
$output
->
write
(
"$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo)\n"
);
}
}
}
$output
->
hide_progress
;
tools/winapi/winapi_fixup
View file @
c3e8ac32
...
...
@@ -14,7 +14,6 @@ use config qw(
&file_skip &files_skip
&file_normalize
&get_spec_files
&translate_calling_convention16 &translate_calling_convention32
$current_dir $wine_dir $winapi_dir $winapi_check_dir
)
;
use
output
;
...
...
@@ -24,7 +23,7 @@ use util;
use
winapi
;
use
winapi_parser
;
my
$output
=
output
->
new
;
my
$output
=
'output'
->
new
;
my
%
options_long
=
(
"debug"
=>
{
default
=>
0
,
description
=>
"debug mode"
},
...
...
@@ -57,37 +56,22 @@ my %options_short = (
my
$options_usage
=
"usage: winapi_fixup [--help] [<files>]\n"
;
my
$options
=
options
->
new
(
\%
options_long
,
\%
options_short
,
$options_usage
);
my
$options
=
'options'
->
new
(
\%
options_long
,
\%
options_short
,
$options_usage
);
my
$modules
=
modules
->
new
(
$options
,
$output
,
$wine_dir
,
$current_dir
,
\&
file_type
,
"$winapi_check_dir/modules.dat"
);
my
$modules
=
'modules'
->
new
(
$options
,
$output
,
$wine_dir
,
$current_dir
,
\&
file_type
,
"$winapi_check_dir/modules.dat"
);
my
$win16api
=
winapi
->
new
(
$options
,
$output
,
"win16"
,
"$winapi_check_dir/win16"
);
my
$win32api
=
winapi
->
new
(
$options
,
$output
,
"win32"
,
"$winapi_check_dir/win32"
);
my
$win16api
=
'winapi'
->
new
(
$options
,
$output
,
"win16"
,
"$winapi_check_dir/win16"
);
my
$win32api
=
'winapi'
->
new
(
$options
,
$output
,
"win32"
,
"$winapi_check_dir/win32"
);
my
@winapis
=
(
$win16api
,
$win32api
);
if
(
$wine_dir
eq
"."
)
{
winapi
->
read_all_spec_files
(
$modules
,
$wine_dir
,
$current_dir
,
\&
file_type
,
$win16api
,
$win32api
);
'winapi'
->
read_all_spec_files
(
$modules
,
$wine_dir
,
$current_dir
,
\&
file_type
,
$win16api
,
$win32api
);
}
else
{
my
@spec_files
=
$modules
->
allowed_spec_files
(
$wine_dir
,
$current_dir
);
winapi
->
read_spec_files
(
$modules
,
$wine_dir
,
$current_dir
,
\
@spec_files
,
$win16api
,
$win32api
);
'winapi'
->
read_spec_files
(
$modules
,
$wine_dir
,
$current_dir
,
\
@spec_files
,
$win16api
,
$win32api
);
}
sub
normalize_set
{
local
$_
=
shift
;
if
(
!
defined
(
$_
))
{
return
undef
;
}
my
%
hash
=
();
foreach
my
$key
(
split
(
/\s*&\s*/
))
{
$hash
{
$key
}
++
;
}
return
join
(
" & "
,
sort
(
keys
(
%
hash
)));
}
my
@c_files
=
options
->
c_files
;
my
@c_files
=
$options
->
c_files
;
@c_files
=
files_skip
(
@c_files
);
@c_files
=
files_filter
(
"winelib"
,
@c_files
);
...
...
@@ -103,68 +87,44 @@ foreach my $file (@c_files) {
my
%
spec_file
;
$progress_current
++
;
if
(
options
->
progress
)
{
output
->
progress
(
"$file: file $progress_current of $progress_max"
);
if
(
$
options
->
progress
)
{
$
output
->
progress
(
"$file: file $progress_current of $progress_max"
);
}
my
$found_function
=
sub
{
my
$line
=
shift
;
my
$refdebug_channels
=
shift
;
my
@debug_channels
=
@$refdebug_channels
;
my
$documentation
=
shift
;
my
$linkage
=
shift
;
my
$return_type
=
shift
;
my
$calling_convention
=
shift
;
my
$internal_name
=
shift
;
my
$refargument_types
=
shift
;
my
@argument_types
=
@$refargument_types
;
my
$refargument_names
=
shift
;
my
@argument_names
=
@$refargument_names
;
my
$refargument_documentations
=
shift
;
my
@argument_documentations
=
@$refargument_documentations
;
my
$statements
=
shift
;
my
$function
=
shift
;
my
$documentation_line
=
$function
->
documentation_line
;
my
$documentation
=
$function
->
documentation
;
my
$function_line
=
$function
->
function_line
;
my
$linkage
=
$function
->
linkage
;
my
$return_type
=
$function
->
return_type
;
my
$calling_convention
=
$function
->
calling_convention
;
my
$internal_name
=
$function
->
internal_name
;
my
@argument_types
=
@
{
$function
->
argument_types
};
my
@argument_names
=
@
{
$function
->
argument_names
};
my
@argument_documentations
=
@
{
$function
->
argument_documentations
};
my
$statements
=
$function
->
statements
;
if
(
$linkage
eq
"static"
||
$linkage
eq
"extern"
||
!
defined
(
$statements
))
{
return
;
}
my
@external_names
=
();
foreach
my
$winapi
(
@winapis
)
{
my
$external_names
=
$winapi
->
function_external_name
(
$internal_name
);
if
(
defined
(
$external_names
))
{
push
@external_names
,
split
(
/\s*&\s*/
,
$external_names
);
}
}
my
@external_names
=
$function
->
external_names
;
if
(
$#external_names
<
0
)
{
return
;
}
my
$module16
=
$win16api
->
function_internal_module
(
$internal_name
);
my
$module32
=
$win32api
->
function_internal_module
(
$internal_name
);
$output
->
prefix
(
"$file: "
.
$function
->
prefix
);
my
$prefix
=
""
;
$prefix
.=
"$file: "
;
if
(
defined
(
$module16
)
&&
!
defined
(
$module32
))
{
$prefix
.=
normalize_set
(
$module16
)
.
": "
;
}
elsif
(
!
defined
(
$module16
)
&&
defined
(
$module32
))
{
$prefix
.=
normalize_set
(
$module32
)
.
": "
;
}
elsif
(
defined
(
$module16
)
&&
defined
(
$module32
))
{
$prefix
.=
normalize_set
(
$module16
)
.
" & "
.
normalize_set
(
$module32
)
.
": "
;
}
else
{
$prefix
.=
"<>: "
;
}
$prefix
.=
"$return_type "
;
$prefix
.=
"$calling_convention "
if
$calling_convention
;
$prefix
.=
"$internal_name("
.
join
(
","
,
@argument_types
)
.
"): "
;
$output
->
prefix
(
$prefix
);
my
$calling_convention16
=
translate_calling_convention16
(
$calling_convention
);
my
$calling_convention32
=
translate_calling_convention32
(
$calling_convention
);
my
@module_ordinal_entries
=
$function
->
get_all_module_ordinal
;
my
$spec_modified
=
0
;
if
(
options
->
stub
&&
$documentation
)
{
if
(
$options
->
stub
&&
$documentation
)
{
my
$calling_convention16
=
$function
->
calling_convention16
;
my
$calling_convention32
=
$function
->
calling_convention32
;
foreach
my
$winapi
(
@winapis
)
{
my
@entries
=
();
if
(
$winapi
->
function_stub
(
$internal_name
))
{
...
...
@@ -206,7 +166,7 @@ foreach my $file (@c_files) {
my
$type
=
$_
;
my
$kind
;
if
(
$type
ne
"..."
&&
!
defined
(
$kind
=
$winapi
->
translate_argument
(
$type
)))
{
output
->
write
(
"no translation defined: "
.
$type
.
"\n"
);
$
output
->
write
(
"no translation defined: "
.
$type
.
"\n"
);
}
# FIXME: Kludge
...
...
@@ -260,8 +220,8 @@ foreach my $file (@c_files) {
if
(
!
$spec_modified
&&
(
$documentation
&&
!
$documentation_modified
)
&&
(
options
->
documentation_name
||
options
->
documentation_ordinal
||
options
->
documentation_missing
))
(
$options
->
documentation_name
||
$
options
->
documentation_ordinal
||
$
options
->
documentation_missing
))
{
local
$_
;
...
...
@@ -270,7 +230,7 @@ foreach my $file (@c_files) {
my
$replace
;
my
$count
=
0
;
my
$line2
=
$line
-
1
;
my
$line2
=
$
documentation_
line
-
1
;
foreach
(
split
(
/\n/
,
$documentation
))
{
$line2
++
;
if
(
/^(\s*\*\s*(\S+)\s*)((?:\s*[\(\[]\s*\w+(?:\s*\.\s*[^\s\)\]]*\s*)?[\)\]])+)(.*?)$/
)
{
...
...
@@ -304,10 +264,10 @@ foreach my $file (@c_files) {
my
$part12
=
$part1
;
(
my
$part32
,
my
$module
,
my
$ordinal
)
=
@$entry
;
foreach
my
$entry2
(
winapi::
get_all_module_internal_ordinal
(
$internal_name
)
)
{
foreach
my
$entry2
(
@module_ordinal_entries
)
{
(
my
$external_name2
,
my
$module2
,
my
$ordinal2
)
=
@$entry2
;
if
(
options
->
documentation_name
&&
lc
(
$module
)
eq
$module2
&&
if
(
$
options
->
documentation_name
&&
lc
(
$module
)
eq
$module2
&&
$external_name
ne
$external_name2
)
{
if
(
!
$found
&&
$part12
=~
s/\b\Q$external_name\E\b/$external_name2/
)
{
...
...
@@ -316,7 +276,7 @@ foreach my $file (@c_files) {
}
}
if
(
options
->
documentation_ordinal
&&
if
(
$
options
->
documentation_ordinal
&&
$external_name
eq
$external_name2
&&
lc
(
$module
)
eq
$module2
&&
(
$#entries
>
0
||
!
defined
(
$ordinal
)
||
(
$ordinal
ne
$ordinal2
)))
...
...
@@ -348,7 +308,7 @@ foreach my $file (@c_files) {
my
$external_name
=
$2
;
if
(
$internal_name
=~
/^(?:\S+_)?\Q$external_name\E(?:16)?$/
)
{
foreach
my
$entry
(
winapi::
get_all_module_internal_ordinal
(
$internal_name
)
)
{
foreach
my
$entry
(
@module_ordinal_entries
)
{
(
my
$external_name2
,
my
$module
,
my
$ordinal
)
=
@$entry
;
$line3
=
$line2
;
...
...
@@ -362,9 +322,9 @@ foreach my $file (@c_files) {
if
(
defined
(
$line3
)
&&
defined
(
$search
)
&&
defined
(
$replace
))
{
if
(
$count
>
1
||
$#external_names
>=
1
)
{
output
->
write
(
"multiple entries (fixup not supported)\n"
);
# output->write("s/$search/$replace/\n");
# output->write("@external_names\n");
$
output
->
write
(
"multiple entries (fixup not supported)\n"
);
#
$
output->write("s/$search/$replace/\n");
#
$
output->write("@external_names\n");
}
else
{
$documentation_modified
=
1
;
$substitute_line
{
$line3
}{
search
}
=
$search
;
...
...
@@ -375,7 +335,7 @@ foreach my $file (@c_files) {
}
if
(
!
$spec_modified
&&
!
$documentation_modified
&&
options
->
documentation_missing
&&
$documentation
)
$
options
->
documentation_missing
&&
$documentation
)
{
my
$part1
;
my
$part2
;
...
...
@@ -383,7 +343,7 @@ foreach my $file (@c_files) {
my
$part4
;
my
$line3
=
0
;
my
$line2
=
$line
-
1
;
my
$line2
=
$
documentation_
line
-
1
;
foreach
(
split
(
/\n/
,
$documentation
))
{
$line2
++
;
if
(
/^(\s*\*\s*)(\S+\s*)([\(\[])\s*\w+\s*\.\s*[^\s\)\]]*\s*([\)\]]).*?$/
)
{
...
...
@@ -398,7 +358,7 @@ foreach my $file (@c_files) {
}
}
foreach
my
$entry2
(
winapi::
get_all_module_internal_ordinal
(
$internal_name
)
)
{
foreach
my
$entry2
(
@module_ordinal_entries
)
{
(
my
$external_name2
,
my
$module2
,
my
$ordinal2
)
=
@$entry2
;
my
$found
=
0
;
...
...
@@ -418,16 +378,16 @@ foreach my $file (@c_files) {
$part2
=
$external_name2
.
" "
x
(
length
(
$part2
)
-
length
(
$external_name2
));
$insert_line
{
$line3
}
=
"$part1$part2$part3\U$module2\E.$ordinal2$part4\n"
;
}
else
{
output
->
write
(
"$external_name2 (\U$module2\E.$ordinal2) missing (fixup not supported)\n"
);
$
output
->
write
(
"$external_name2 (\U$module2\E.$ordinal2) missing (fixup not supported)\n"
);
}
}
}
}
if
(
!
$documentation_modified
&&
options
->
documentation_wrong
)
$
options
->
documentation_wrong
)
{
my
$line2
=
$line
-
1
;
my
$line2
=
$
documentation_
line
-
1
;
foreach
(
split
(
/\n/
,
$documentation
))
{
$line2
++
;
if
(
/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/
)
{
...
...
@@ -436,7 +396,7 @@ foreach my $file (@c_files) {
my
$ordinal
=
$3
;
my
$found
=
0
;
foreach
my
$entry2
(
winapi::
get_all_module_internal_ordinal
(
$internal_name
)
)
{
foreach
my
$entry2
(
@module_ordinal_entries
)
{
(
my
$external_name2
,
my
$module2
,
my
$ordinal2
)
=
@$entry2
;
if
(
$external_name
eq
$external_name2
&&
...
...
@@ -450,7 +410,7 @@ foreach my $file (@c_files) {
if
(
1
)
{
$delete_line
{
$line2
}
=
"^\Q$_\E\$"
;
}
else
{
output
->
write
(
"$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n"
);
$
output
->
write
(
"$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n"
);
};
}
}
...
...
@@ -472,7 +432,7 @@ foreach my $file (@c_files) {
}
if
(
defined
(
$external_name
)
&&
defined
(
$module
)
&&
defined
(
$ordinal
))
{
$insert_line
{
$line
}
=
$insert_line
{
$
function_
line
}
=
"/"
.
"*"
x
71
.
"\n"
.
" *\t\t$external_name (\U$module\E.$ordinal)\n"
.
" */\n"
;
...
...
@@ -501,19 +461,19 @@ foreach my $file (@c_files) {
$line
=
$insert_line
{
$.
};
if
(
defined
(
$line
))
{
if
(
options
->
modify
)
{
if
(
$
options
->
modify
)
{
$_
=
"$line$_"
;
$modified
=
1
;
}
else
{
my
$line2
=
$line
;
chomp
(
$line2
);
my
@line2
=
split
(
/\n/
,
$line2
);
if
(
$#line2
>
0
)
{
output
->
write
(
"$file: $.: insert: \\\n"
);
$
output
->
write
(
"$file: $.: insert: \\\n"
);
foreach
my
$line2
(
@line2
)
{
output
->
write
(
"'$line2'\n"
);
$
output
->
write
(
"'$line2'\n"
);
}
}
else
{
output
->
write
(
"$file: $.: insert: '$line2'\n"
);
$
output
->
write
(
"$file: $.: insert: '$line2'\n"
);
}
}
}
...
...
@@ -524,13 +484,13 @@ foreach my $file (@c_files) {
if
(
defined
(
$search
)
&&
defined
(
$replace
))
{
my
$modified2
=
0
;
if
(
s/$search/$replace/
)
{
if
(
options
->
modify
)
{
if
(
$
options
->
modify
)
{
$modified
=
1
;
}
$modified2
=
1
;
}
if
(
!
options
->
modify
||
!
$modified2
)
{
if
(
!
$
options
->
modify
||
!
$modified2
)
{
my
$search2
;
my
$replace2
;
if
(
!
$modified2
)
{
...
...
@@ -540,16 +500,16 @@ foreach my $file (@c_files) {
$search2
=
"search"
;
$replace2
=
"replace"
;
}
output
->
write
(
"$file: $.: $search2 : '$search'\n"
);
$
output
->
write
(
"$file: $.: $search2 : '$search'\n"
);
my
@replace2
=
split
(
/\n/
,
$replace
);
if
(
$#replace2
>
0
)
{
output
->
write
(
"$file: $.: $replace2: \\\n"
);
$
output
->
write
(
"$file: $.: $replace2: \\\n"
);
foreach
my
$replace2
(
@replace2
)
{
output
->
write
(
"'$replace2'\n"
);
$
output
->
write
(
"'$replace2'\n"
);
}
}
else
{
output
->
write
(
"$file: $.: $replace2: '$replace'\n"
);
$
output
->
write
(
"$file: $.: $replace2: '$replace'\n"
);
}
}
}
...
...
@@ -557,14 +517,14 @@ foreach my $file (@c_files) {
$line
=
$delete_line
{
$.
};
if
(
defined
(
$line
))
{
if
(
/$line/
)
{
if
(
options
->
modify
)
{
if
(
$
options
->
modify
)
{
$modified
=
1
;
next
;
}
else
{
output
->
write
(
"$file: $.: delete: '$line'\n"
);
$
output
->
write
(
"$file: $.: delete: '$line'\n"
);
}
}
else
{
output
->
write
(
"$file: $.: unmatched delete: '$line'\n"
);
$
output
->
write
(
"$file: $.: unmatched delete: '$line'\n"
);
}
}
...
...
@@ -608,11 +568,11 @@ foreach my $file (@c_files) {
my
$replace
=
$substitute
->
{
replace
};
if
(
s/$search/$replace/
)
{
if
(
options
->
modify
)
{
if
(
$
options
->
modify
)
{
$modified
=
1
;
}
else
{
output
->
write
(
"$file: search : '$search'\n"
);
output
->
write
(
"$file: replace: '$replace'\n"
);
$
output
->
write
(
"$file: search : '$search'\n"
);
$
output
->
write
(
"$file: replace: '$replace'\n"
);
}
next
;
}
else
{
...
...
@@ -630,7 +590,7 @@ foreach my $file (@c_files) {
if
(
defined
(
$file
))
{
edit_file
(
$file
,
$editor
);
}
else
{
output
->
write
(
"$module: doesn't have any spec file\n"
);
$
output
->
write
(
"$module: doesn't have any spec file\n"
);
}
if
(
$#substitutes
>=
0
)
{
...
...
@@ -638,14 +598,14 @@ foreach my $file (@c_files) {
my
$search
=
$substitute
->
{
search
};
my
$replace
=
$substitute
->
{
replace
};
output
->
write
(
"$file: unmatched search : '$search'\n"
);
output
->
write
(
"$file: unmatched replace: '$replace'\n"
);
$
output
->
write
(
"$file: unmatched search : '$search'\n"
);
$
output
->
write
(
"$file: unmatched replace: '$replace'\n"
);
}
}
}
}
output
->
hide_progress
;
$
output
->
hide_progress
;
tools/winapi_check/win32/wow32.api
View file @
c3e8ac32
tools/winapi_check/winapi.pm
View file @
c3e8ac32
...
...
@@ -2,7 +2,14 @@ package winapi;
use
strict
;
my
@winapis
;
use
vars
qw($VERSION @ISA @EXPORT @EXPORT_OK)
;
require
Exporter
;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw()
;
@EXPORT_OK
=
qw($win16api $win32api @winapis)
;
use
vars
qw($win16api $win32api @winapis)
;
sub
new
{
my
$proto
=
shift
;
...
...
@@ -30,11 +37,25 @@ sub new {
$self
->
parse_api_file
(
$file
,
$module
);
}
if
(
$$name
eq
"win16"
)
{
$win16api
=
$self
;
}
elsif
(
$$name
eq
"win32"
)
{
$win32api
=
$self
;
}
push
@winapis
,
$self
;
return
$self
;
}
sub
win16api
{
return
$win16api
;
}
sub
win32api
{
return
$win32api
;
}
sub
parse_api_file
{
my
$self
=
shift
;
...
...
@@ -202,6 +223,17 @@ sub read_spec_files {
}
}
}
for
my
$internal_name
(
$win32api
->
all_internal_functions
)
{
my
$module16
=
$win16api
->
function_internal_module
(
$internal_name
);
if
(
defined
(
$module16
)
&&
!
$win16api
->
function_stub
(
$internal_name
)
&&
!
$win32api
->
function_stub
(
$internal_name
))
{
$win16api
->
found_shared_internal_function
(
$internal_name
);
$win32api
->
found_shared_internal_function
(
$internal_name
);
}
}
}
sub
read_all_spec_files
{
...
...
@@ -733,7 +765,14 @@ sub is_function {
return
$$function_internal_calling_convention
{
$name
};
}
sub
is_shared_function
{
sub
all_shared_internal_functions
{
my
$self
=
shift
;
my
$function_shared
=
\%
{
$self
->
{
FUNCTION_SHARED
}};
return
sort
(
keys
(
%
$function_shared
));
}
sub
is_shared_internal_function
{
my
$self
=
shift
;
my
$function_shared
=
\%
{
$self
->
{
FUNCTION_SHARED
}};
...
...
@@ -742,7 +781,7 @@ sub is_shared_function {
return
$$function_shared
{
$name
};
}
sub
found_shared_function
{
sub
found_shared_
internal_
function
{
my
$self
=
shift
;
my
$function_shared
=
\%
{
$self
->
{
FUNCTION_SHARED
}};
...
...
@@ -818,23 +857,26 @@ sub internal_function_found {
# class methods
#
sub
get_all_module_internal_ordinal
{
sub
_get_all_module_internal_ordinal
{
my
$winapi
=
shift
;
my
$internal_name
=
shift
;
my
@entries
=
();
foreach
my
$winapi
(
@winapis
)
{
my
@name
=
();
{
my
$name
=
$winapi
->
function_external_name
(
$internal_name
);
if
(
defined
(
$name
))
{
@name
=
split
(
/ & /
,
$name
);
}
}
my
@module
=
();
{
my
$module
=
$winapi
->
function_internal_module
(
$internal_name
);
if
(
defined
(
$module
))
{
@module
=
split
(
/ & /
,
$module
);
}
}
my
@ordinal
=
();
{
my
$ordinal
=
$winapi
->
function_internal_ordinal
(
$internal_name
);
if
(
defined
(
$ordinal
))
{
...
...
@@ -851,28 +893,47 @@ sub get_all_module_internal_ordinal {
{
push
@entries
,
[
$name
,
$module
,
$ordinal
];
}
return
@entries
;
}
sub
get_all_module_internal_ordinal16
{
return
_get_all_module_internal_ordinal
(
$win16api
,
@_
);
}
sub
get_all_module_internal_ordinal32
{
return
_get_all_module_internal_ordinal
(
$win32api
,
@_
);
}
sub
get_all_module_internal_ordinal
{
my
@entries
=
();
foreach
my
$winapi
(
@winapis
)
{
push
@entries
,
_get_all_module_internal_ordinal
(
$winapi
,
@_
);
}
return
@entries
;
}
sub
get_all_module_external_ordinal
{
sub
_get_all_module_external_ordinal
{
my
$winapi
=
shift
;
my
$external_name
=
shift
;
my
@entries
=
();
foreach
my
$winapi
(
@winapis
)
{
my
@name
=
();
{
my
$name
=
$winapi
->
function_internal_name
(
$external_name
);
if
(
defined
(
$name
))
{
@name
=
split
(
/ & /
,
$name
);
}
}
my
@module
=
();
{
my
$module
=
$winapi
->
function_external_module
(
$external_name
);
if
(
defined
(
$module
))
{
@module
=
split
(
/ & /
,
$module
);
}
}
my
@ordinal
=
();
{
my
$ordinal
=
$winapi
->
function_external_ordinal
(
$external_name
);
if
(
defined
(
$ordinal
))
{
...
...
@@ -889,6 +950,22 @@ sub get_all_module_external_ordinal {
{
push
@entries
,
[
$name
,
$module
,
$ordinal
];
}
return
@entries
;
}
sub
get_all_module_external_ordinal16
{
return
_get_all_module_external_ordinal
(
$win16api
,
@_
);
}
sub
get_all_module_external_ordinal32
{
return
_get_all_module_external_ordinal
(
$win32api
,
@_
);
}
sub
get_all_module_external_ordinal
{
my
@entries
=
();
foreach
my
$winapi
(
@winapis
)
{
push
@entries
,
_get_all_module_external_ordinal
(
$winapi
,
@_
);
}
return
@entries
;
...
...
tools/winapi_check/winapi_check
View file @
c3e8ac32
...
...
@@ -14,71 +14,30 @@
use
strict
;
my
$wine_dir
;
my
$winapi_dir
;
my
$winapi_check_dir
;
my
$tool
;
BEGIN
{
if
(
$0
=~
m%^((.*?)/?tools/([^/]+))/winapi_check$%
)
{
$winapi_dir
=
$1
;
$winapi_check_dir
=
$1
;
$tool
=
$3
;
if
(
defined
(
$2
)
&&
$2
ne
""
)
{
$wine_dir
=
$2
;
}
else
{
$wine_dir
=
"."
;
}
$winapi_dir
=~
s%^\./%%
;
$winapi_dir
=~
s/$tool/winapi/
;
$winapi_check_dir
=~
s%^\./%%
;
}
else
{
print
STDERR
"$tool: You must run this tool in the main Wine directory or a sub directory\n"
;
exit
1
;
}
@INC
=
(
$winapi_check_dir
,
$winapi_dir
);
require
"modules.pm"
;
require
"nativeapi.pm"
;
require
"output.pm"
;
require
"preprocessor.pm"
;
require
"winapi.pm"
;
require
"winapi_documentation.pm"
;
require
"winapi_function.pm"
;
require
"winapi_local.pm"
;
require
"winapi_global.pm"
;
require
"winapi_options.pm"
;
require
"winapi_parser.pm"
;
import
modules
;
import
nativeapi
;
import
output
;
import
preprocessor
;
import
winapi
;
import
winapi_documentation
;
import
winapi_function
;
import
winapi_local
;
import
winapi_global
;
import
winapi_options
;
import
winapi_parser
;
$0
=~
m%^(.*?/?tools)/winapi_check/winapi_check$%
;
require
"$1/winapi/setup.pm"
;
}
my
$current_dir
=
"."
;
if
(
length
(
$wine_dir
)
!=
1
)
{
my
$pwd
;
chomp
(
$pwd
=
`pwd`
);
foreach
my
$n
(
1
..
((
length
(
$wine_dir
)
+
1
)
/
3
))
{
$pwd
=~
s/\/([^\/]*)$//
;
$current_dir
=
"$1/$current_dir"
;
}
$current_dir
=~
s%/\.$%%
;
$current_dir
=~
s%^\./%%
;
}
use
config
qw(
&file_absolutize &file_normalize
&file_type &files_filter
&file_skip &files_skip
&get_spec_files
$current_dir $wine_dir $winapi_dir $winapi_check_dir
)
;
use
modules
;
use
nativeapi
;
use
output
;
use
preprocessor
;
use
util
qw(&is_subset)
;
use
winapi
;
use
winapi_documentation
;
use
winapi_function
;
use
winapi_local
;
use
winapi_global
;
use
winapi_options
;
use
winapi_parser
;
my
$output
=
'output'
->
new
;
...
...
@@ -92,69 +51,6 @@ if(!defined($options)) {
exit
;
}
sub
file_absolutize
{
local
$_
=
shift
;
$_
=
file_normalize
(
$_
);
if
(
!
s%^$wine_dir/%%
)
{
$_
=
"$current_dir/$_"
;
}
s%^\./%%
;
return
$_
;
}
sub
file_normalize
{
local
$_
=
shift
;
foreach
my
$dir
(
split
(
m%/%
,
$current_dir
))
{
s%^(\.\./)*\.\./$dir/%%
;
if
(
defined
(
$1
))
{
$_
=
"$1$_"
;
}
}
return
$_
;
}
sub
file_type
{
local
$_
=
shift
;
$_
=
file_absolutize
(
$_
);
m%^(?:libtest|rc|server|tests|tools)/%
&&
return
""
;
m%^(?:programs|debugger|miscemu)/%
&&
return
"wineapp"
;
m%^(?:library|tsx11|unicode)/%
&&
return
"library"
;
m%^windows/x11drv/wineclipsrv.c%
&&
return
"application"
;
return
"winelib"
;
}
sub
file_skip
{
local
$_
=
shift
;
$_
=
file_absolutize
(
$_
);
m%^(?:libtest|programs|rc|server|tests|tools)/%
&&
return
1
;
m%^(?:debugger|miscemu|tsx11|unicode)/%
&&
return
1
;
m%^dlls/wineps/data/%
&&
return
1
;
m%^windows/x11drv/wineclipsrv.c%
&&
return
1
;
m%^dlls/winmm/wineoss/midipatch.c%
&&
return
1
;
return
0
;
}
sub
files_skip
{
my
@files
;
foreach
my
$file
(
@_
)
{
if
(
!
file_skip
(
$file
))
{
push
@files
,
$file
;
}
}
return
@files
;
}
my
$modules
=
'modules'
->
new
(
$options
,
$output
,
$wine_dir
,
$current_dir
,
\&
file_type
,
"$winapi_check_dir/modules.dat"
);
my
$win16api
=
'winapi'
->
new
(
$options
,
$output
,
"win16"
,
"$winapi_check_dir/win16"
);
...
...
@@ -170,20 +66,6 @@ if($options->global) {
my
$nativeapi
=
'nativeapi'
->
new
(
$options
,
$output
,
"$winapi_check_dir/nativeapi.dat"
,
"$wine_dir/configure.in"
,
"$wine_dir/include/config.h.in"
);
for
my
$internal_name
(
$win32api
->
all_internal_functions
)
{
my
$module16
=
$win16api
->
function_internal_module
(
$internal_name
);
my
$module32
=
$win32api
->
function_internal_module
(
$internal_name
);
if
(
defined
(
$module16
))
{
$win16api
->
found_shared_function
(
$internal_name
);
$win32api
->
found_shared_function
(
$internal_name
);
if
(
$options
->
shared
)
{
$output
->
write
(
"*.spec: $internal_name: is shared between $module16 (Win16) and $module32 (Win32)\n"
);
}
}
}
my
%
includes
;
{
my
@files
=
map
{
...
...
@@ -245,21 +127,19 @@ if($options->headers) {
}
my
$found_function
=
sub
{
my
$line
=
shift
;
my
$refdebug_channels
=
shift
;
my
@debug_channels
=
@$refdebug_channels
;
my
$documentation
=
shift
;
my
$linkage
=
shift
;
my
$return_type
=
shift
;
my
$calling_convention
=
shift
;
my
$internal_name
=
shift
;
my
$refargument_types
=
shift
;
my
@argument_types
=
@$refargument_types
;
my
$refargument_names
=
shift
;
my
@argument_names
=
@$refargument_names
;
my
$refargument_documentations
=
shift
;
my
@argument_documentations
=
@$refargument_documentations
;
my
$statements
=
shift
;
my
$function
=
shift
;
my
$documentation_line
=
$function
->
documentation_line
;
my
$documentation
=
$function
->
documentation
;
my
$function_line
=
$function
->
function_line
;
my
$linkage
=
$function
->
linkage
;
my
$return_type
=
$function
->
return_type
;
my
$calling_convention
=
$function
->
calling_convention
;
my
$internal_name
=
$function
->
internal_name
;
my
@argument_types
=
@
{
$function
->
argument_types
};
my
@argument_names
=
@
{
$function
->
argument_names
};
my
@argument_documentations
=
@
{
$function
->
argument_documentations
};
my
$statements
=
$function
->
statements
;
foreach
my
$winapi
(
@winapis
)
{
my
$module
=
$winapi
->
function_internal_module
(
$internal_name
);
...
...
@@ -314,9 +194,6 @@ if($options->headers) {
}
}
my
%
module_pseudo_stub_count16
;
my
%
module_pseudo_stub_count32
;
foreach
my
$file
(
@c_files
)
{
my
%
functions
=
();
...
...
@@ -336,26 +213,23 @@ foreach my $file (@c_files) {
my
$file_type
=
file_type
(
$file
);
my
$found_function
=
sub
{
my
$line
=
shift
;
my
$refdebug_channels
=
shift
;
my
@debug_channels
=
@$refdebug_channels
;
my
$documentation
=
shift
;
my
$linkage
=
shift
;
my
$return_type
=
shift
;
my
$calling_convention
=
shift
;
my
$internal_name
=
shift
;
my
$refargument_types
=
shift
;
my
@argument_types
=
@$refargument_types
;
my
$refargument_names
=
shift
;
my
@argument_names
=
@$refargument_names
;
my
$refargument_documentations
=
shift
;
my
@argument_documentations
=
@$refargument_documentations
;
my
$statements
=
shift
;
my
$documentation_line
=
$line
;
my
$external_name16
=
$win16api
->
function_external_name
(
$internal_name
);
my
$external_name32
=
$win32api
->
function_external_name
(
$internal_name
);
my
$function
=
shift
;
my
$internal_name
=
$function
->
internal_name
;
$functions
{
$internal_name
}
=
$function
;
my
$documentation_line
=
$function
->
documentation_line
;
my
$documentation
=
$function
->
documentation
;
my
$linkage
=
$function
->
linkage
;
my
$return_type
=
$function
->
return_type
;
my
$calling_convention
=
$function
->
calling_convention
;
my
@argument_types
=
@
{
$function
->
argument_types
};
my
@argument_names
=
@
{
$function
->
argument_names
};
my
@argument_documentations
=
@
{
$function
->
argument_documentations
};
my
$statements
=
$function
->
statements
;
my
$external_name16
=
$function
->
external_name16
;
my
$external_name32
=
$function
->
external_name32
;
if
(
$options
->
global
)
{
$win16api
->
found_type
(
$return_type
)
if
$options
->
win16
;
...
...
@@ -370,59 +244,22 @@ foreach my $file (@c_files) {
}
if
(
$file_type
eq
"winelib"
)
{
my
$module16
=
$
win16api
->
function_internal_module
(
$internal_name
)
;
my
$module32
=
$
win32api
->
function_internal_module
(
$internal_name
)
;
my
$module16
=
$
function
->
module16
;
my
$module32
=
$
function
->
module32
;
if
(
defined
(
$module16
))
{
foreach
my
$module
(
split
(
/ & /
,
$module16
))
{
$modules
->
found_module_in_dir
(
$module
,
$file_dir
);
}
}
if
(
defined
(
$module32
))
{
foreach
my
$module
(
split
(
/ & /
,
$module32
))
{
foreach
my
$module
(
$function
->
modules
)
{
$modules
->
found_module_in_dir
(
$module
,
$file_dir
);
}
}
my
$previous_function
;
if
(
defined
(
$functions
{
$internal_name
}))
{
$previous_function
=
$functions
{
$internal_name
};
}
my
$function
=
'winapi_function'
->
new
;
$functions
{
$internal_name
}
=
$function
;
$output
->
prefix
(
"$file: "
.
$function
->
prefix
);
$function
->
documentation
(
$documentation
);
$function
->
documentation_line
(
$documentation_line
);
$function
->
linkage
(
$linkage
);
$function
->
file
(
$file
);
$function
->
return_type
(
$return_type
);
$function
->
calling_convention
(
$calling_convention
);
$function
->
external_name16
(
$external_name16
);
$function
->
external_name32
(
$external_name32
);
$function
->
internal_name
(
$internal_name
);
$function
->
argument_types
([
@argument_types
]);
$function
->
argument_names
([
@argument_names
]);
$function
->
argument_documentations
([
@argument_documentations
]);
$function
->
statements
(
$statements
);
$function
->
module16
(
$module16
);
$function
->
module32
(
$module32
);
my
$prefix
=
""
;
$prefix
.=
"$file: "
;
if
(
defined
(
$module16
)
&&
!
defined
(
$module32
))
{
$prefix
.=
"$module16: "
;
}
elsif
(
!
defined
(
$module16
)
&&
defined
(
$module32
))
{
$prefix
.=
"$module32: "
;
}
elsif
(
defined
(
$module16
)
&&
defined
(
$module32
))
{
$prefix
.=
"$module16 & $module32: "
;
}
else
{
$prefix
.=
"<>: "
;
if
(
$options
->
shared
)
{
if
(
$win16api
->
is_shared_internal_function
(
$internal_name
)
||
$win32api
->
is_shared_internal_function
(
$internal_name
))
{
$output
->
write
(
"is shared between Win16 and Win32\n"
);
}
}
$prefix
.=
"$return_type "
;
$prefix
.=
"$calling_convention "
if
$calling_convention
;
$prefix
.=
"$internal_name("
.
join
(
","
,
@argument_types
)
.
"): "
;
$output
->
prefix
(
$prefix
);
# FIXME: Not correct
if
(
defined
(
$external_name16
))
{
...
...
@@ -437,44 +274,25 @@ foreach my $file (@c_files) {
if
(
$options
->
local
&&
$options
->
misplaced
&&
$linkage
ne
"extern"
&&
defined
(
$statements
))
{
if
(
$options
->
win16
&&
$options
->
report_module
(
$module16
))
{
foreach
my
$module
(
split
(
/ & /
,
$module16
))
{
my
$match
=
0
;
foreach
my
$file_module
(
split
(
/ & /
,
$file_module16
))
{
if
(
$module
eq
$file_module
)
{
$match
=
1
;
}
}
if
(
!
$match
)
{
if
(
$options
->
win16
&&
$options
->
report_module
(
$module16
))
{
if
(
$file
ne
"library/port.c"
&&
!
$nativeapi
->
is_function
(
$internal_name
)
&&
!
$win16api
->
function_stub
(
$internal_name
))
!
$win16api
->
function_stub
(
$internal_name
)
&&
!
is_subset
(
$module16
,
$file_module16
))
{
$output
->
write
(
"is misplaced ($module)
\n"
);
$output
->
write
(
"is misplaced
\n"
);
}
last
;
}
}
}
if
(
$options
->
win32
&&
$options
->
report_module
(
$module32
))
{
foreach
my
$module
(
split
(
/ & /
,
$module32
))
{
my
$match
=
0
;
foreach
my
$file_module
(
split
(
/ & /
,
$file_module32
))
{
if
(
$module
eq
$file_module
)
{
$match
=
1
;
}
}
if
(
!
$match
)
{
if
(
$options
->
win32
&&
$options
->
report_module
(
$module32
))
{
if
(
$file
ne
"library/port.c"
&&
!
$nativeapi
->
is_function
(
$internal_name
)
&&
!
$win32api
->
function_stub
(
$internal_name
))
!
$win32api
->
function_stub
(
$internal_name
)
&&
!
is_subset
(
$module32
,
$file_module32
))
{
$output
->
write
(
"is misplaced ($module)\n"
);
}
last
;
}
$output
->
write
(
"is misplaced\n"
);
}
}
}
...
...
@@ -529,23 +347,7 @@ foreach my $file (@c_files) {
}
}
if
(
$options
->
stubs
)
{
if
(
defined
(
$statements
)
&&
$statements
=~
/FIXME[^;]*stub/
)
{
if
(
$options
->
win16
&&
$options
->
report_module
(
$module16
))
{
foreach
my
$module
(
split
(
/ \& /
,
$module16
))
{
$module_pseudo_stub_count16
{
$module
}
++
;
}
}
if
(
$options
->
win32
&&
$options
->
report_module
(
$module32
))
{
foreach
my
$module
(
split
(
/ \& /
,
$module32
))
{
$module_pseudo_stub_count32
{
$module
}
++
;
}
}
}
}
if
(
$options
->
local
&&
$options
->
documentation
&&
!
defined
(
$previous_function
)
&&
(
defined
(
$module16
)
||
defined
(
$module32
))
&&
$linkage
ne
"extern"
&&
defined
(
$statements
))
{
...
...
@@ -683,72 +485,6 @@ $output->hide_progress;
if
(
$options
->
global
)
{
winapi_documentation::
report_documentation
$options
,
$output
;
if
(
$options
->
stubs
)
{
if
(
$options
->
win16
)
{
my
%
module_stub_count16
;
my
%
module_total_count16
;
foreach
my
$internal_name
(
$win16api
->
all_internal_functions
,
$win16api
->
all_functions_stub
)
{
foreach
my
$module
(
split
(
/ \& /
,
$win16api
->
function_internal_module
(
$internal_name
)))
{
if
(
$win16api
->
function_stub
(
$internal_name
))
{
$module_stub_count16
{
$module
}
++
;
}
$module_total_count16
{
$module
}
++
;
}
}
foreach
my
$module
(
$win16api
->
all_modules
)
{
if
(
$options
->
report_module
(
$module
))
{
my
$real_stubs
=
$module_stub_count16
{
$module
};
my
$pseudo_stubs
=
$module_pseudo_stub_count16
{
$module
};
if
(
!
defined
(
$real_stubs
))
{
$real_stubs
=
0
;
}
if
(
!
defined
(
$pseudo_stubs
))
{
$pseudo_stubs
=
0
;
}
my
$stubs
=
$real_stubs
+
$pseudo_stubs
;
my
$total
=
$module_total_count16
{
$module
};
if
(
!
defined
(
$total
))
{
$total
=
0
;}
$output
->
write
(
"*.c: $module: "
);
$output
->
write
(
"$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo)\n"
);
}
}
}
if
(
$options
->
win32
)
{
my
%
module_stub_count32
;
my
%
module_total_count32
;
foreach
my
$internal_name
(
$win32api
->
all_internal_functions
,
$win32api
->
all_functions_stub
)
{
foreach
my
$module
(
split
(
/ \& /
,
$win32api
->
function_internal_module
(
$internal_name
)))
{
if
(
$win32api
->
function_stub
(
$internal_name
))
{
$module_stub_count32
{
$module
}
++
;
}
$module_total_count32
{
$module
}
++
;
}
}
foreach
my
$module
(
$win32api
->
all_modules
)
{
if
(
$options
->
report_module
(
$module
))
{
my
$real_stubs
=
$module_stub_count32
{
$module
};
my
$pseudo_stubs
=
$module_pseudo_stub_count32
{
$module
};
if
(
!
defined
(
$real_stubs
))
{
$real_stubs
=
0
;
}
if
(
!
defined
(
$pseudo_stubs
))
{
$pseudo_stubs
=
0
;
}
my
$stubs
=
$real_stubs
+
$pseudo_stubs
;
my
$total
=
$module_total_count32
{
$module
};
if
(
!
defined
(
$total
))
{
$total
=
0
;}
$output
->
write
(
"*.c: $module: "
);
$output
->
write
(
"$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo)\n"
);
}
}
}
}
if
(
$options
->
headers
)
{
foreach
my
$name
(
sort
(
keys
(
%
includes
)))
{
if
(
!
$includes
{
$name
}{
used
})
{
...
...
tools/winapi_check/winapi_documentation.pm
View file @
c3e8ac32
...
...
@@ -24,6 +24,8 @@ sub check_documentation {
my
$documentation_line
=
$function
->
documentation_line
;
my
@argument_documentations
=
@
{
$function
->
argument_documentations
};
my
$documentation_error
=
0
;
my
$documentation_warning
=
0
;
if
(
$options
->
documentation_name
||
$options
->
documentation_ordinal
||
$options
->
documentation_pedantic
)
...
...
@@ -74,17 +76,19 @@ sub check_documentation {
if
((
$options
->
documentation_name
&&
!
$found_name
)
||
(
$options
->
documentation_ordinal
&&
!
$found_ordinal
))
{
$documentation_error
=
1
;
$output
->
write
(
"documentation: expected $external_name (\U$module\E.$ordinal): \\\n$documentation\n"
);
}
}
if
(
$options
->
documentation_pedantic
&&
$pedantic_failed
)
{
$documentation_warning
=
1
;
$output
->
write
(
"documentation: pedantic failed: \\\n$documentation\n"
);
}
}
}
if
(
$options
->
documentation_wrong
)
{
if
(
!
$documentation_error
&&
$options
->
documentation_wrong
)
{
foreach
(
split
(
/\n/
,
$documentation
))
{
if
(
/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/
)
{
my
$external_name
=
$1
;
...
...
@@ -110,11 +114,10 @@ sub check_documentation {
}
if
(
$options
->
documentation_comment_indent
)
{
if
(
$documentation
=~
/^ \*(\s*)\w+(\s*)([\(\[])\s*\w+\.\s*(?:\@|\d+)\s*([\)\]])/m
)
{
foreach
(
split
(
/\n/
,
$documentation
))
{
if
(
/^\s*\*(\s*)\S+(\s*)[\(\[]\s*\w+\s*\.\s*[^\s\)\]]*\s*[\)\]].*?$/
)
{
my
$indent
=
$1
;
my
$spacing
=
$2
;
my
$left
=
$3
;
my
$right
=
$4
;
$indent
=~
s/\t/ /g
;
$indent
=
length
(
$indent
);
...
...
@@ -126,10 +129,10 @@ sub check_documentation {
if
(
$indent
>=
20
)
{
$output
->
write
(
"documentation: comment indent is $indent\n"
);
}
$comment_spacing
{
$spacing
}
++
;
}
}
}
if
(
$options
->
documentation_comment_width
)
{
if
(
$documentation
=~
/(^\/\*\*+)/
)
{
...
...
tools/winapi_check/winapi_function.pm
View file @
c3e8ac32
package
winapi_function
;
use
base
qw(function)
;
use
strict
;
use
util
qw(&normalize_set)
;
use
winapi
qw($win16api $win32api @winapis)
;
########################################################################
# constructor
#
sub
new
{
my
$proto
=
shift
;
my
$class
=
ref
(
$proto
)
||
$proto
;
...
...
@@ -11,186 +19,266 @@ sub new {
return
$self
;
}
sub
file
{
my
$self
=
shift
;
my
$file
=
\
$
{
$self
->
{
FILE
}};
########################################################################
# winapi
#
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$file
=
$_
;
}
sub
external_name16
{
my
$self
=
shift
;
my
$internal_name
=
$self
->
internal_name
;
return
$
$file
;
return
$
win16api
->
function_external_name
(
$internal_name
)
;
}
sub
documentation
{
sub
external_names16
{
my
$self
=
shift
;
my
$documentation
=
\
$
{
$self
->
{
DOCUMENTATION
}};
local
$_
=
shift
;
my
$external_name16
=
$self
->
external_name16
;
if
(
defined
(
$_
))
{
$$documentation
=
$_
;
}
return
$$documentation
;
if
(
defined
(
$external_name16
))
{
return
split
(
/\s*&\s*/
,
$external_name16
);
}
else
{
return
();
}
}
sub
documentation_line
{
sub
external_name32
{
my
$self
=
shift
;
my
$documentation_line
=
\
$
{
$self
->
{
DOCUMENTATION_LINE
}};
local
$_
=
shift
;
my
$internal_name
=
$self
->
internal_name
;
if
(
defined
(
$_
))
{
$$documentation_line
=
$_
;
}
return
$$documentation_line
;
return
$win32api
->
function_external_name
(
$internal_name
);
}
sub
linkage
{
sub
external_names32
{
my
$self
=
shift
;
my
$linkage
=
\
$
{
$self
->
{
LINKAGE
}};
local
$_
=
shift
;
my
$external_name32
=
$self
->
external_name32
;
if
(
defined
(
$_
))
{
$$linkage
=
$_
;
}
return
$$linkage
;
if
(
defined
(
$external_name32
))
{
return
split
(
/\s*&\s*/
,
$external_name32
);
}
else
{
return
();
}
}
sub
return_type
{
sub
external_names
{
my
$self
=
shift
;
my
$return_type
=
\
$
{
$self
->
{
RETURN_TYPE
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$return_type
=
$_
;
}
my
@external_names
;
push
@external_names
,
$self
->
external_names16
;
push
@external_names
,
$self
->
external_names32
;
return
$$return_type
;
return
@external_names
;
}
sub
calling_convention
{
sub
module16
{
my
$self
=
shift
;
my
$calling_convention
=
\
$
{
$self
->
{
CALLING_CONVENTION
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$calling_convention
=
$_
;
}
my
$internal_name
=
$self
->
internal_name
;
return
$
$calling_convention
;
return
$
win16api
->
function_internal_module
(
$internal_name
)
;
}
sub
external_name
16
{
sub
modules
16
{
my
$self
=
shift
;
my
$
external_name16
=
\
$
{
$self
->
{
EXTERNAL_NAME16
}}
;
my
$
module16
=
$self
->
module16
;
local
$_
=
shift
;
if
(
defined
(
$module16
))
{
return
split
(
/\s*&\s*/
,
$module16
);
}
else
{
return
();
}
}
if
(
defined
(
$_
))
{
$$external_name16
=
$_
;
}
sub
module32
{
my
$self
=
shift
;
my
$internal_name
=
$self
->
internal_name
;
return
$
$external_name16
;
return
$
win32api
->
function_internal_module
(
$internal_name
)
;
}
sub
external_name
32
{
sub
modules
32
{
my
$self
=
shift
;
my
$
external_name32
=
\
$
{
$self
->
{
EXTERNAL_NAME32
}}
;
my
$
module32
=
$self
->
module32
;
local
$_
=
shift
;
if
(
defined
(
$module32
))
{
return
split
(
/\s*&\s*/
,
$module32
);
}
else
{
return
();
}
}
if
(
defined
(
$_
))
{
$$external_name32
=
$_
;
}
sub
module
{
my
$self
=
shift
;
my
$module16
=
$self
->
module16
;
my
$module32
=
$self
->
module32
;
return
$$external_name32
;
my
$module
;
if
(
defined
(
$module16
)
&&
defined
(
$module32
))
{
$module
=
"$module16 & $module32"
;
}
elsif
(
defined
(
$module16
))
{
$module
=
$module16
;
}
elsif
(
defined
(
$module32
))
{
$module
=
$module32
;
}
else
{
$module
=
""
;
}
}
sub
internal_name
{
sub
modules
{
my
$self
=
shift
;
my
$internal_name
=
\
$
{
$self
->
{
INTERNAL_NAME
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$internal_name
=
$_
;
}
my
@modules
;
push
@modules
,
$self
->
modules16
;
push
@modules
,
$self
->
modules32
;
return
$$internal_name
;
return
@modules
;
}
sub
argument_types
{
sub
prefix
{
my
$self
=
shift
;
my
$argument_types
=
\
$
{
$self
->
{
ARGUMENT_TYPES
}};
my
$module16
=
$self
->
module16
;
my
$module32
=
$self
->
module32
;
local
$_
=
shift
;
my
$return_type
=
$self
->
return_type
;
my
$internal_name
=
$self
->
internal_name
;
my
$calling_convention
=
$self
->
calling_convention
;
my
@argument_types
=
@
{
$self
->
argument_types
};
if
(
defined
(
$_
))
{
$$argument_types
=
$_
;
}
if
(
$#argument_types
<
0
)
{
@argument_types
=
(
"void"
);
}
return
$$argument_types
;
my
$prefix
=
""
;
if
(
defined
(
$module16
)
&&
!
defined
(
$module32
))
{
$prefix
.=
normalize_set
(
$module16
)
.
": "
;
}
elsif
(
!
defined
(
$module16
)
&&
defined
(
$module32
))
{
$prefix
.=
normalize_set
(
$module32
)
.
": "
;
}
elsif
(
defined
(
$module16
)
&&
defined
(
$module32
))
{
$prefix
.=
normalize_set
(
$module16
)
.
" & "
.
normalize_set
(
$module32
)
.
": "
;
}
else
{
$prefix
.=
"<>: "
;
}
$prefix
.=
"$return_type "
;
$prefix
.=
"$calling_convention "
if
$calling_convention
;
$prefix
.=
"$internal_name("
.
join
(
","
,
@argument_types
)
.
"): "
;
return
$prefix
;
}
sub
argument_names
{
sub
calling_convention16
{
my
$self
=
shift
;
my
$argument_names
=
\
$
{
$self
->
{
ARGUMENT_NAMES
}};
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$argument_names
=
$_
;
}
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
;
}
return
$$argument_names
;
local
$_
=
$self
->
calling_convention
;
if
(
/^__cdecl$/
)
{
return
"cdecl"
;
}
elsif
(
/^VFWAPIV|WINAPIV$/
)
{
if
(
!
defined
(
$suffix
))
{
return
undef
;
}
return
"pascal$suffix"
;
# FIXME: Is this correct?
}
elsif
(
/^__stdcall|VFWAPI|WINAPI|CALLBACK$/
)
{
if
(
!
defined
(
$suffix
))
{
return
undef
;
}
return
"pascal$suffix"
;
}
elsif
(
/^__asm$/
)
{
return
"asm"
;
}
else
{
return
"cdecl"
;
}
}
sub
argument_documentations
{
sub
calling_convention32
{
my
$self
=
shift
;
my
$argument_documentations
=
\
$
{
$self
->
{
ARGUMENT_DOCUMENTATIONS
}};
local
$_
=
shift
;
local
$_
=
$self
->
calling_convention
;
if
(
/^__cdecl$/
)
{
return
"cdecl"
;
}
elsif
(
/^VFWAPIV|WINAPIV$/
)
{
return
"varargs"
;
}
elsif
(
/^__stdcall|VFWAPI|WINAPI|CALLBACK$/
)
{
return
"stdcall"
;
}
elsif
(
/^__asm$/
)
{
return
"asm"
;
}
else
{
return
"cdecl"
;
}
}
if
(
defined
(
$_
))
{
$$argument_documentations
=
$_
;
}
sub
get_all_module_ordinal16
{
my
$self
=
shift
;
my
$internal_name
=
$self
->
internal_name
;
return
$$argument_documentations
;
return
winapi::
get_all_module_internal_ordinal16
(
$internal_name
)
;
}
sub
module16
{
sub
get_all_module_ordinal32
{
my
$self
=
shift
;
my
$module16
=
\
$
{
$self
->
{
MODULE16
}};
local
$_
=
shift
;
my
$internal_name
=
$self
->
internal_name
;
if
(
defined
(
$_
))
{
$$module16
=
$_
;
}
return
$$module16
;
return
winapi::
get_all_module_internal_ordinal32
(
$internal_name
);
}
sub
module32
{
sub
get_all_module_ordinal
{
my
$self
=
shift
;
my
$
module32
=
\
$
{
$self
->
{
MODULE32
}}
;
my
$
internal_name
=
$self
->
internal_name
;
local
$_
=
shift
;
if
(
defined
(
$_
))
{
$$module32
=
$_
;
}
return
$$module32
;
return
winapi::
get_all_module_internal_ordinal
(
$internal_name
);
}
sub
statements
{
sub
_return_kind
{
my
$self
=
shift
;
my
$statements
=
\
$
{
$self
->
{
STATEMENTS
}};
my
$winapi
=
shift
;
my
$return_type
=
$self
->
return_type
;
local
$_
=
shift
;
return
$winapi
->
translate_argument
(
$return_type
);
}
if
(
defined
(
$_
))
{
$$statements
=
$_
;
}
sub
return_kind16
{
my
$self
=
shift
;
return
$self
->
_return_kind
(
$win16api
,
@_
);
}
return
$$statements
;
sub
return_kind32
{
my
$self
=
shift
;
return
$self
->
_return_kind
(
$win32api
,
@_
);
}
sub
module
{
sub
_argument_kinds
{
my
$self
=
shift
;
my
$
module16
=
\
$
{
$self
->
{
MODULE16
}}
;
my
$module32
=
\
$
{
$self
->
{
MODULE32
}
};
my
$
winapi
=
shift
;
my
@argument_types
=
@
{
$self
->
argument_types
};
my
$module
;
if
(
defined
(
$$module16
)
&&
defined
(
$$module32
))
{
$module
=
"$$module16 & $$module32"
;
}
elsif
(
defined
(
$$module16
))
{
$module
=
$$module16
;
}
elsif
(
defined
(
$$module32
))
{
$module
=
$$module32
;
my
@argument_kinds
;
foreach
my
$argument_type
(
@argument_types
)
{
my
$argument_kind
=
$winapi
->
translate_argument
(
$argument_type
);
if
(
defined
(
$argument_kind
)
&&
$argument_kind
eq
"longlong"
)
{
push
@argument_kinds
,
(
"long"
,
"long"
);
}
else
{
$module
=
""
;
push
@argument_kinds
,
$argument_kind
;
}
}
return
[
@argument_kinds
];
}
sub
argument_kinds16
{
my
$self
=
shift
;
return
$self
->
_argument_kinds
(
$win16api
,
@_
);
}
sub
argument_kinds32
{
my
$self
=
shift
;
return
$self
->
_argument_kinds
(
$win32api
,
@_
);
}
##############################################################################
# Accounting
#
sub
function_called
{
my
$self
=
shift
;
my
$called_function_names
=
\%
{
$self
->
{
CALLED_FUNCTION_NAMES
}};
...
...
tools/winapi_check/winapi_local.pm
View file @
c3e8ac32
...
...
@@ -206,7 +206,7 @@ sub check_function {
}
if
(
$segmented
&&
$options
->
shared_segmented
&&
$winapi
->
is_shared_function
(
$internal_name
))
{
if
(
$segmented
&&
$options
->
shared_segmented
&&
$winapi
->
is_shared_
internal_
function
(
$internal_name
))
{
$output
->
write
(
"function using segmented pointers shared between Win16 och Win32\n"
);
}
}
...
...
tools/winapi_check/winapi_options.pm
View file @
c3e8ac32
...
...
@@ -121,7 +121,6 @@ my %options = (
"headers"
=>
{
default
=>
0
,
parent
=>
"global"
,
description
=>
"headers checking"
},
"headers-duplicated"
=>
{
default
=>
0
,
parent
=>
"headers"
,
description
=>
"duplicated function declarations checking"
},
"headers-misplaced"
=>
{
default
=>
0
,
parent
=>
"headers"
,
description
=>
"misplaced function declarations checking"
},
"stubs"
=>
{
default
=>
0
,
parent
=>
"global"
,
description
=>
"stubs checking"
}
);
my
%
short_options
=
(
...
...
tools/winapi_check/winapi_parser.pm
View file @
c3e8ac32
...
...
@@ -2,6 +2,8 @@ package winapi_parser;
use
strict
;
use
winapi_function
;
sub
parse_c_file
{
my
$options
=
shift
;
my
$output
=
shift
;
...
...
@@ -13,23 +15,26 @@ sub parse_c_file {
my
$debug_channels
=
[]
;
# local
my
$
line_number
=
0
;
my
$
documentation_line
;
my
$documentation
;
my
$function_line
;
my
$linkage
;
my
$return_type
;
my
$calling_convention
;
my
$
function
=
""
;
my
$
internal_name
=
""
;
my
$argument_types
;
my
$argument_names
;
my
$argument_documentations
;
my
$statements
;
my
$function_begin
=
sub
{
$documentation_line
=
shift
;
$documentation
=
shift
;
$function_line
=
shift
;
$linkage
=
shift
;
$return_type
=
shift
;
$calling_convention
=
shift
;
$
function
=
shift
;
$
internal_name
=
shift
;
$argument_types
=
shift
;
$argument_names
=
shift
;
$argument_documentations
=
shift
;
...
...
@@ -49,10 +54,23 @@ sub parse_c_file {
$statements
=
undef
;
};
my
$function_end
=
sub
{
&
$function_found_callback
(
$line_number
,
$debug_channels
,
$documentation
,
$linkage
,
$return_type
,
$calling_convention
,
$function
,
$argument_types
,
$argument_names
,
$argument_documentations
,
$statements
);
$function
=
""
;
my
$function
=
'winapi_function'
->
new
;
$function
->
debug_channels
([
@$debug_channels
]);
$function
->
documentation
(
$documentation
);
$function
->
documentation_line
(
$documentation_line
);
$function
->
linkage
(
$linkage
);
$function
->
file
(
$file
);
$function
->
return_type
(
$return_type
);
$function
->
calling_convention
(
$calling_convention
);
$function
->
internal_name
(
$internal_name
);
$function
->
argument_types
([
@$argument_types
]);
$function
->
argument_names
([
@$argument_names
]);
$function
->
argument_documentations
([
@$argument_documentations
]);
$function
->
statements
(
$statements
);
&
$function_found_callback
(
$function
);
$internal_name
=
""
;
};
my
%
regs_entrypoints
;
my
@comment_lines
=
();
...
...
@@ -85,7 +103,7 @@ sub parse_c_file {
$again
=
0
;
}
#
M
erge conflicts in file?
#
CVS m
erge conflicts in file?
if
(
/^(<<<<<<<|=======|>>>>>>>)/
)
{
$output
->
write
(
"$file: merge conflicts in file\n"
);
last
;
...
...
@@ -230,7 +248,7 @@ sub parse_c_file {
$statements
.=
"$line\n"
;
}
if
(
$
function
&&
$level
==
0
)
{
if
(
$
internal_name
&&
$level
==
0
)
{
&
$function_end
;
}
next
;
...
...
@@ -241,9 +259,6 @@ sub parse_c_file {
my
@lines
=
split
(
/\n/
,
$&
);
my
$function_line
=
$.
-
scalar
(
@lines
)
+
1
;
# FIXME: Should be separate for documentation and function
$line_number
=
$documentation_line
;
$_
=
$'
;
$again
=
1
;
if
(
$11
eq
"{"
)
{
...
...
@@ -324,19 +339,23 @@ sub parse_c_file {
print
"$file: $return_type $calling_convention $name("
.
join
(
","
,
@arguments
)
.
")\n"
;
}
&
$function_begin
(
$documentation
,
$linkage
,
$return_type
,
$calling_convention
,
$name
,
\
@argument_types
,
\
@argument_names
,
\
@argument_documentations
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
$linkage
,
$return_type
,
$calling_convention
,
$name
,
\
@argument_types
,
\
@argument_names
,
\
@argument_documentations
);
if
(
$level
==
0
)
{
&
$function_end
;
}
}
elsif
(
/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s
)
{
$_
=
$'
;
$again
=
1
;
my
@arguments
=
();
&
$function_begin
(
$documentation
,
""
,
"void"
,
"__asm"
,
$1
,
\
@arguments
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"void"
,
"__asm"
,
$1
,
\
@arguments
);
&
$function_end
;
}
elsif
(
/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s
)
{
$_
=
$'
;
$again
=
1
;
my
@arguments
=
(
"HDC16"
);
&
$function_begin
(
$documentation
,
""
,
$2
,
"WINAPI"
,
$3
,
\
@arguments
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
$2
,
"WINAPI"
,
$3
,
\
@arguments
);
&
$function_end
;
}
elsif
(
/DC_(GET_VAL)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s
)
{
$_
=
$'
;
$again
=
1
;
...
...
@@ -349,57 +368,71 @@ sub parse_c_file {
if
(
$name16
eq
"COLORREF16"
)
{
$name16
=
"COLORREF"
;
}
&
$function_begin
(
$documentation
,
""
,
$name16
,
"WINAPI"
,
$return16
,
\
@arguments16
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
$name16
,
"WINAPI"
,
$return16
,
\
@arguments16
);
&
$function_end
;
&
$function_begin
(
$documentation
,
""
,
$name32
,
"WINAPI"
,
$return32
,
\
@arguments32
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
$name32
,
"WINAPI"
,
$return32
,
\
@arguments32
);
&
$function_end
;
}
elsif
(
/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s
)
{
$_
=
$'
;
$again
=
1
;
my
@arguments16
=
(
"HDC16"
,
"LP"
.
$5
.
"16"
);
my
@arguments32
=
(
"HDC"
,
"LP"
.
$5
);
&
$function_begin
(
$documentation
,
""
,
"BOOL16"
,
"WINAPI"
,
$2
.
"16"
,
\
@arguments16
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"BOOL16"
,
"WINAPI"
,
$2
.
"16"
,
\
@arguments16
);
&
$function_end
;
&
$function_begin
(
$documentation
,
""
,
"BOOL"
,
"WINAPI"
,
$2
,
\
@arguments32
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"BOOL"
,
"WINAPI"
,
$2
,
\
@arguments32
);
&
$function_end
;
}
elsif
(
/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s
)
{
$_
=
$'
;
$again
=
1
;
my
@arguments16
=
(
"HDC16"
,
"INT16"
);
my
@arguments32
=
(
"HDC"
,
"INT"
);
&
$function_begin
(
$documentation
,
""
,
"INT16"
,
"WINAPI"
,
$2
.
"16"
,
\
@arguments16
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"INT16"
,
"WINAPI"
,
$2
.
"16"
,
\
@arguments16
);
&
$function_end
;
&
$function_begin
(
$documentation
,
""
,
"INT"
,
"WINAPI"
,
$2
,
\
@arguments32
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"INT"
,
"WINAPI"
,
$2
,
\
@arguments32
);
&
$function_end
;
}
elsif
(
/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s
)
{
$_
=
$'
;
$again
=
1
;
my
@arguments16
=
(
"HWAVEIN16"
);
my
@arguments32
=
(
"HWAVEIN"
);
&
$function_begin
(
$documentation
,
""
,
"UINT16"
,
"WINAPI"
,
"waveIn"
.
$1
.
"16"
,
\
@arguments16
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT16"
,
"WINAPI"
,
"waveIn"
.
$1
.
"16"
,
\
@arguments16
);
&
$function_end
;
&
$function_begin
(
$documentation
,
""
,
"UINT"
,
"WINAPI"
,
"waveIn"
.
$1
,
\
@arguments32
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT"
,
"WINAPI"
,
"waveIn"
.
$1
,
\
@arguments32
);
&
$function_end
;
}
elsif
(
/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s
)
{
$_
=
$'
;
$again
=
1
;
my
@arguments16
=
(
"HWAVEOUT16"
);
my
@arguments32
=
(
"HWAVEOUT"
);
&
$function_begin
(
$documentation
,
""
,
"UINT16"
,
"WINAPI"
,
"waveOut"
.
$1
.
"16"
,
\
@arguments16
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT16"
,
"WINAPI"
,
"waveOut"
.
$1
.
"16"
,
\
@arguments16
);
&
$function_end
;
&
$function_begin
(
$documentation
,
""
,
"UINT"
,
"WINAPI"
,
"waveOut"
.
$1
,
\
@arguments32
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT"
,
"WINAPI"
,
"waveOut"
.
$1
,
\
@arguments32
);
&
$function_end
;
}
elsif
(
/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s
)
{
$_
=
$'
;
$again
=
1
;
if
(
$1
eq
"1"
)
{
my
@arguments16
=
(
"HWAVEOUT16"
,
$4
);
my
@arguments32
=
(
"HWAVEOUT"
,
$4
);
&
$function_begin
(
$documentation
,
""
,
"UINT16"
,
"WINAPI"
,
"waveOut"
.
$2
.
"16"
,
\
@arguments16
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT16"
,
"WINAPI"
,
"waveOut"
.
$2
.
"16"
,
\
@arguments16
);
&
$function_end
;
&
$function_begin
(
$documentation
,
""
,
"UINT"
,
"WINAPI"
,
"waveOut"
.
$2
,
\
@arguments32
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT"
,
"WINAPI"
,
"waveOut"
.
$2
,
\
@arguments32
);
&
$function_end
;
}
elsif
(
$1
eq
2
)
{
my
@arguments16
=
(
"UINT16"
,
$4
);
my
@arguments32
=
(
"UINT"
,
$4
);
&
$function_begin
(
$documentation
,
""
,
"UINT16"
,
"WINAPI"
,
"waveOut"
.
$2
.
"16"
,
\
@arguments16
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT16"
,
"WINAPI"
,
"waveOut"
.
$2
.
"16"
,
\
@arguments16
);
&
$function_end
;
&
$function_begin
(
$documentation
,
""
,
"UINT"
,
"WINAPI"
,
"waveOut"
.
$2
,
\
@arguments32
);
&
$function_begin
(
$documentation_line
,
$documentation
,
$function_line
,
""
,
"UINT"
,
"WINAPI"
,
"waveOut"
.
$2
,
\
@arguments32
);
&
$function_end
;
}
}
elsif
(
/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s
)
{
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment