Commit c3e8ac32 authored by Patrik Stridvall's avatar Patrik Stridvall Committed by Alexandre Julliard

Major reorganization and cleanup.

parent d342ed2b
...@@ -9,11 +9,10 @@ require Exporter; ...@@ -9,11 +9,10 @@ require Exporter;
@ISA = qw(Exporter); @ISA = qw(Exporter);
@EXPORT = qw( @EXPORT = qw(
&file_absolutize &file_normalize
&file_type &files_filter &file_type &files_filter
&file_skip &files_skip &file_skip &files_skip
&file_absolutize &file_normalize
&get_spec_files &get_spec_files
&translate_calling_convention16 &translate_calling_convention32
); );
@EXPORT_OK = qw( @EXPORT_OK = qw(
$current_dir $wine_dir $winapi_dir $winapi_check_dir $current_dir $wine_dir $winapi_dir $winapi_check_dir
...@@ -21,6 +20,8 @@ require Exporter; ...@@ -21,6 +20,8 @@ require Exporter;
use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir); use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
my $output = "output";
sub file_type { sub file_type {
local $_ = shift; local $_ = shift;
...@@ -98,7 +99,7 @@ sub file_normalize { ...@@ -98,7 +99,7 @@ sub file_normalize {
} }
sub get_spec_files { sub get_spec_files {
output->progress("$wine_dir: searching for *.spec"); $output->progress("$wine_dir: searching for *.spec");
my @spec_files = map { my @spec_files = map {
s%^\./%%; s%^\./%%;
...@@ -113,36 +114,4 @@ sub get_spec_files { ...@@ -113,36 +114,4 @@ sub get_spec_files {
return @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; 1;
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;
...@@ -9,6 +9,8 @@ require Exporter; ...@@ -9,6 +9,8 @@ require Exporter;
@EXPORT = qw(&parse_comma_list); @EXPORT = qw(&parse_comma_list);
@EXPORT_OK = qw(); @EXPORT_OK = qw();
my $output = "output";
sub parse_comma_list { sub parse_comma_list {
my $prefix = shift; my $prefix = shift;
my $value = shift; my $value = shift;
...@@ -94,7 +96,7 @@ sub new { ...@@ -94,7 +96,7 @@ sub new {
$name = $1; $name = $1;
$prefix = "no"; $prefix = "no";
if(defined($value)) { 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; return undef;
} }
...@@ -156,12 +158,12 @@ sub new { ...@@ -156,12 +158,12 @@ sub new {
} }
if(/^-(.*)$/) { if(/^-(.*)$/) {
output->write("unknown option: $_\n"); $output->write("unknown option: $_\n");
output->write($$options_usage); $output->write($$options_usage);
exit 1; exit 1;
} else { } else {
if(!-e $_) { if(!-e $_) {
output->write("$_: no such file or directory\n"); $output->write("$_: no such file or directory\n");
exit 1; exit 1;
} }
...@@ -170,7 +172,7 @@ sub new { ...@@ -170,7 +172,7 @@ sub new {
} }
if($self->help) { if($self->help) {
output->write($$options_usage); $output->write($$options_usage);
$self->show_help; $self->show_help;
exit 0; exit 0;
} }
...@@ -300,25 +302,25 @@ sub show_help { ...@@ -300,25 +302,25 @@ sub show_help {
} }
} }
output->write($command); $output->write($command);
for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { output->write(" "); } for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { $output->write(" "); }
if(ref($value) ne "HASH") { if(ref($value) ne "HASH") {
if($value) { if($value) {
output->write("Disable "); $output->write("Disable ");
} else { } else {
output->write("Enable "); $output->write("Enable ");
} }
} else { } else {
if($value->{active}) { if($value->{active}) {
output->write("(Disable) "); $output->write("(Disable) ");
} else { } else {
output->write("Enable "); $output->write("Enable ");
} }
} }
if($default == $current) { if($default == $current) {
output->write("$description (default)\n"); $output->write("$description (default)\n");
} else { } else {
output->write("$description\n"); $output->write("$description\n");
} }
} }
} }
......
...@@ -6,7 +6,10 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); ...@@ -6,7 +6,10 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require Exporter; require Exporter;
@ISA = qw(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_OK = qw();
%EXPORT_TAGS = (); %EXPORT_TAGS = ();
...@@ -86,4 +89,44 @@ sub replace_file { ...@@ -86,4 +89,44 @@ sub replace_file {
return $result; 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; 1;
...@@ -2,7 +2,14 @@ package winapi; ...@@ -2,7 +2,14 @@ package winapi;
use strict; 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 { sub new {
my $proto = shift; my $proto = shift;
...@@ -30,11 +37,25 @@ sub new { ...@@ -30,11 +37,25 @@ sub new {
$self->parse_api_file($file,$module); $self->parse_api_file($file,$module);
} }
if($$name eq "win16") {
$win16api = $self;
} elsif($$name eq "win32") {
$win32api = $self;
}
push @winapis, $self; push @winapis, $self;
return $self; return $self;
} }
sub win16api {
return $win16api;
}
sub win32api {
return $win32api;
}
sub parse_api_file { sub parse_api_file {
my $self = shift; my $self = shift;
...@@ -202,6 +223,17 @@ sub read_spec_files { ...@@ -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 { sub read_all_spec_files {
...@@ -733,7 +765,14 @@ sub is_function { ...@@ -733,7 +765,14 @@ sub is_function {
return $$function_internal_calling_convention{$name}; 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 $self = shift;
my $function_shared = \%{$self->{FUNCTION_SHARED}}; my $function_shared = \%{$self->{FUNCTION_SHARED}};
...@@ -742,7 +781,7 @@ sub is_shared_function { ...@@ -742,7 +781,7 @@ sub is_shared_function {
return $$function_shared{$name}; return $$function_shared{$name};
} }
sub found_shared_function { sub found_shared_internal_function {
my $self = shift; my $self = shift;
my $function_shared = \%{$self->{FUNCTION_SHARED}}; my $function_shared = \%{$self->{FUNCTION_SHARED}};
...@@ -818,23 +857,26 @@ sub internal_function_found { ...@@ -818,23 +857,26 @@ sub internal_function_found {
# class methods # class methods
# #
sub get_all_module_internal_ordinal { sub _get_all_module_internal_ordinal {
my $winapi = shift;
my $internal_name = shift; my $internal_name = shift;
my @entries = (); my @entries = ();
foreach my $winapi (@winapis) {
my @name = (); { my @name = (); {
my $name = $winapi->function_external_name($internal_name); my $name = $winapi->function_external_name($internal_name);
if(defined($name)) { if(defined($name)) {
@name = split(/ & /, $name); @name = split(/ & /, $name);
} }
} }
my @module = (); { my @module = (); {
my $module = $winapi->function_internal_module($internal_name); my $module = $winapi->function_internal_module($internal_name);
if(defined($module)) { if(defined($module)) {
@module = split(/ & /, $module); @module = split(/ & /, $module);
} }
} }
my @ordinal = (); { my @ordinal = (); {
my $ordinal = $winapi->function_internal_ordinal($internal_name); my $ordinal = $winapi->function_internal_ordinal($internal_name);
if(defined($ordinal)) { if(defined($ordinal)) {
...@@ -851,28 +893,47 @@ sub get_all_module_internal_ordinal { ...@@ -851,28 +893,47 @@ sub get_all_module_internal_ordinal {
{ {
push @entries, [$name, $module, $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; return @entries;
} }
sub get_all_module_external_ordinal { sub _get_all_module_external_ordinal {
my $winapi = shift;
my $external_name = shift; my $external_name = shift;
my @entries = (); my @entries = ();
foreach my $winapi (@winapis) {
my @name = (); { my @name = (); {
my $name = $winapi->function_internal_name($external_name); my $name = $winapi->function_internal_name($external_name);
if(defined($name)) { if(defined($name)) {
@name = split(/ & /, $name); @name = split(/ & /, $name);
} }
} }
my @module = (); { my @module = (); {
my $module = $winapi->function_external_module($external_name); my $module = $winapi->function_external_module($external_name);
if(defined($module)) { if(defined($module)) {
@module = split(/ & /, $module); @module = split(/ & /, $module);
} }
} }
my @ordinal = (); { my @ordinal = (); {
my $ordinal = $winapi->function_external_ordinal($external_name); my $ordinal = $winapi->function_external_ordinal($external_name);
if(defined($ordinal)) { if(defined($ordinal)) {
...@@ -889,6 +950,22 @@ sub get_all_module_external_ordinal { ...@@ -889,6 +950,22 @@ sub get_all_module_external_ordinal {
{ {
push @entries, [$name, $module, $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; return @entries;
......
...@@ -24,6 +24,8 @@ sub check_documentation { ...@@ -24,6 +24,8 @@ sub check_documentation {
my $documentation_line = $function->documentation_line; my $documentation_line = $function->documentation_line;
my @argument_documentations = @{$function->argument_documentations}; my @argument_documentations = @{$function->argument_documentations};
my $documentation_error = 0;
my $documentation_warning = 0;
if($options->documentation_name || if($options->documentation_name ||
$options->documentation_ordinal || $options->documentation_ordinal ||
$options->documentation_pedantic) $options->documentation_pedantic)
...@@ -74,17 +76,19 @@ sub check_documentation { ...@@ -74,17 +76,19 @@ sub check_documentation {
if(($options->documentation_name && !$found_name) || if(($options->documentation_name && !$found_name) ||
($options->documentation_ordinal && !$found_ordinal)) ($options->documentation_ordinal && !$found_ordinal))
{ {
$documentation_error = 1;
$output->write("documentation: expected $external_name (\U$module\E.$ordinal): \\\n$documentation\n"); $output->write("documentation: expected $external_name (\U$module\E.$ordinal): \\\n$documentation\n");
} }
} }
if($options->documentation_pedantic && $pedantic_failed) { if($options->documentation_pedantic && $pedantic_failed) {
$documentation_warning = 1;
$output->write("documentation: pedantic failed: \\\n$documentation\n"); $output->write("documentation: pedantic failed: \\\n$documentation\n");
} }
} }
} }
if($options->documentation_wrong) { if(!$documentation_error && $options->documentation_wrong) {
foreach (split(/\n/, $documentation)) { foreach (split(/\n/, $documentation)) {
if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) { if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
my $external_name = $1; my $external_name = $1;
...@@ -110,11 +114,10 @@ sub check_documentation { ...@@ -110,11 +114,10 @@ sub check_documentation {
} }
if($options->documentation_comment_indent) { 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 $indent = $1;
my $spacing = $2; my $spacing = $2;
my $left = $3;
my $right = $4;
$indent =~ s/\t/ /g; $indent =~ s/\t/ /g;
$indent = length($indent); $indent = length($indent);
...@@ -126,10 +129,10 @@ sub check_documentation { ...@@ -126,10 +129,10 @@ sub check_documentation {
if($indent >= 20) { if($indent >= 20) {
$output->write("documentation: comment indent is $indent\n"); $output->write("documentation: comment indent is $indent\n");
} }
$comment_spacing{$spacing}++; $comment_spacing{$spacing}++;
} }
} }
}
if($options->documentation_comment_width) { if($options->documentation_comment_width) {
if($documentation =~ /(^\/\*\*+)/) { if($documentation =~ /(^\/\*\*+)/) {
......
package winapi_function; package winapi_function;
use base qw(function);
use strict; use strict;
use util qw(&normalize_set);
use winapi qw($win16api $win32api @winapis);
########################################################################
# constructor
#
sub new { sub new {
my $proto = shift; my $proto = shift;
my $class = ref($proto) || $proto; my $class = ref($proto) || $proto;
...@@ -11,186 +19,266 @@ sub new { ...@@ -11,186 +19,266 @@ sub new {
return $self; return $self;
} }
sub file { ########################################################################
my $self = shift; # winapi
my $file = \${$self->{FILE}}; #
local $_ = shift; sub external_name16 {
my $self = shift;
if(defined($_)) { $$file = $_; } my $internal_name = $self->internal_name;
return $$file; return $win16api->function_external_name($internal_name);
} }
sub documentation { sub external_names16 {
my $self = shift; my $self = shift;
my $documentation = \${$self->{DOCUMENTATION}}; my $external_name16 = $self->external_name16;
local $_ = shift;
if(defined($_)) { $$documentation = $_; } if(defined($external_name16)) {
return split(/\s*&\s*/, $external_name16);
return $$documentation; } else {
return ();
}
} }
sub documentation_line { sub external_name32 {
my $self = shift; my $self = shift;
my $documentation_line = \${$self->{DOCUMENTATION_LINE}}; my $internal_name = $self->internal_name;
local $_ = shift;
if(defined($_)) { $$documentation_line = $_; } return $win32api->function_external_name($internal_name);
return $$documentation_line;
} }
sub linkage { sub external_names32 {
my $self = shift; my $self = shift;
my $linkage = \${$self->{LINKAGE}}; my $external_name32 = $self->external_name32;
local $_ = shift;
if(defined($_)) { $$linkage = $_; } if(defined($external_name32)) {
return split(/\s*&\s*/, $external_name32);
return $$linkage; } else {
return ();
}
} }
sub return_type { sub external_names {
my $self = shift; 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 $self = shift;
my $calling_convention = \${$self->{CALLING_CONVENTION}}; my $internal_name = $self->internal_name;
local $_ = shift;
if(defined($_)) { $$calling_convention = $_; }
return $$calling_convention; return $win16api->function_internal_module($internal_name);
} }
sub external_name16 { sub modules16 {
my $self = shift; 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_name32 { sub modules32 {
my $self = shift; 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 $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 $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 $self = shift;
my $argument_names = \${$self->{ARGUMENT_NAMES}}; my $return_kind16 = $self->return_kind16;
local $_ = shift; my $suffix;
if(!defined($return_kind16)) {
if(defined($_)) { $$argument_names = $_; } $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 $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 $self = shift;
my $module16 = \${$self->{MODULE16}}; my $internal_name = $self->internal_name;
local $_ = shift;
if(defined($_)) { $$module16 = $_; } return winapi::get_all_module_internal_ordinal32($internal_name);
return $$module16;
} }
sub module32 { sub get_all_module_ordinal {
my $self = shift; my $self = shift;
my $module32 = \${$self->{MODULE32}}; my $internal_name = $self->internal_name;
local $_ = shift; return winapi::get_all_module_internal_ordinal($internal_name);
if(defined($_)) { $$module32 = $_; }
return $$module32;
} }
sub statements { sub _return_kind {
my $self = shift; 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 $self = shift;
my $module16 = \${$self->{MODULE16}}; my $winapi = shift;
my $module32 = \${$self->{MODULE32}}; my @argument_types = @{$self->argument_types};
my $module; my @argument_kinds;
if(defined($$module16) && defined($$module32)) { foreach my $argument_type (@argument_types) {
$module = "$$module16 & $$module32"; my $argument_kind = $winapi->translate_argument($argument_type);
} elsif(defined($$module16)) {
$module = $$module16; if(defined($argument_kind) && $argument_kind eq "longlong") {
} elsif(defined($$module32)) { push @argument_kinds, ("long", "long");
$module = $$module32;
} else { } 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 { sub function_called {
my $self = shift; my $self = shift;
my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}}; my $called_function_names = \%{$self->{CALLED_FUNCTION_NAMES}};
......
...@@ -206,7 +206,7 @@ sub check_function { ...@@ -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"); $output->write("function using segmented pointers shared between Win16 och Win32\n");
} }
} }
......
...@@ -121,7 +121,6 @@ my %options = ( ...@@ -121,7 +121,6 @@ my %options = (
"headers" => { default => 0, parent => "global", description => "headers checking" }, "headers" => { default => 0, parent => "global", description => "headers checking" },
"headers-duplicated" => { default => 0, parent => "headers", description => "duplicated function declarations checking" }, "headers-duplicated" => { default => 0, parent => "headers", description => "duplicated function declarations checking" },
"headers-misplaced" => { default => 0, parent => "headers", description => "misplaced 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 = ( my %short_options = (
......
...@@ -2,6 +2,8 @@ package winapi_parser; ...@@ -2,6 +2,8 @@ package winapi_parser;
use strict; use strict;
use winapi_function;
sub parse_c_file { sub parse_c_file {
my $options = shift; my $options = shift;
my $output = shift; my $output = shift;
...@@ -13,23 +15,26 @@ sub parse_c_file { ...@@ -13,23 +15,26 @@ sub parse_c_file {
my $debug_channels = []; my $debug_channels = [];
# local # local
my $line_number = 0; my $documentation_line;
my $documentation; my $documentation;
my $function_line;
my $linkage; my $linkage;
my $return_type; my $return_type;
my $calling_convention; my $calling_convention;
my $function = ""; my $internal_name = "";
my $argument_types; my $argument_types;
my $argument_names; my $argument_names;
my $argument_documentations; my $argument_documentations;
my $statements; my $statements;
my $function_begin = sub { my $function_begin = sub {
$documentation_line = shift;
$documentation = shift; $documentation = shift;
$function_line = shift;
$linkage = shift; $linkage = shift;
$return_type= shift; $return_type= shift;
$calling_convention = shift; $calling_convention = shift;
$function = shift; $internal_name = shift;
$argument_types = shift; $argument_types = shift;
$argument_names = shift; $argument_names = shift;
$argument_documentations = shift; $argument_documentations = shift;
...@@ -49,10 +54,23 @@ sub parse_c_file { ...@@ -49,10 +54,23 @@ sub parse_c_file {
$statements = undef; $statements = undef;
}; };
my $function_end = sub { my $function_end = sub {
&$function_found_callback($line_number,$debug_channels,$documentation,$linkage,$return_type, my $function = 'winapi_function'->new;
$calling_convention,$function,$argument_types,
$argument_names,$argument_documentations,$statements); $function->debug_channels([@$debug_channels]);
$function = ""; $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 %regs_entrypoints;
my @comment_lines = (); my @comment_lines = ();
...@@ -85,7 +103,7 @@ sub parse_c_file { ...@@ -85,7 +103,7 @@ sub parse_c_file {
$again = 0; $again = 0;
} }
# Merge conflicts in file? # CVS merge conflicts in file?
if(/^(<<<<<<<|=======|>>>>>>>)/) { if(/^(<<<<<<<|=======|>>>>>>>)/) {
$output->write("$file: merge conflicts in file\n"); $output->write("$file: merge conflicts in file\n");
last; last;
...@@ -230,7 +248,7 @@ sub parse_c_file { ...@@ -230,7 +248,7 @@ sub parse_c_file {
$statements .= "$line\n"; $statements .= "$line\n";
} }
if($function && $level == 0) { if($internal_name && $level == 0) {
&$function_end; &$function_end;
} }
next; next;
...@@ -241,9 +259,6 @@ sub parse_c_file { ...@@ -241,9 +259,6 @@ sub parse_c_file {
my @lines = split(/\n/, $&); my @lines = split(/\n/, $&);
my $function_line = $. - scalar(@lines) + 1; my $function_line = $. - scalar(@lines) + 1;
# FIXME: Should be separate for documentation and function
$line_number = $documentation_line;
$_ = $'; $again = 1; $_ = $'; $again = 1;
if($11 eq "{") { if($11 eq "{") {
...@@ -324,19 +339,23 @@ sub parse_c_file { ...@@ -324,19 +339,23 @@ sub parse_c_file {
print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n"; 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) { if($level == 0) {
&$function_end; &$function_end;
} }
} elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) { } elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
my @arguments = (); my @arguments = ();
&$function_begin($documentation, "", "void", "__asm", $1, \@arguments); &$function_begin($documentation_line, $documentation,
$function_line, "", "void", "__asm", $1, \@arguments);
&$function_end; &$function_end;
} elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) { } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
my @arguments = ("HDC16"); my @arguments = ("HDC16");
&$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments); &$function_begin($documentation_line, $documentation,
$function_line, "", $2, "WINAPI", $3, \@arguments);
&$function_end; &$function_end;
} elsif(/DC_(GET_VAL)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) { } elsif(/DC_(GET_VAL)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
...@@ -349,57 +368,71 @@ sub parse_c_file { ...@@ -349,57 +368,71 @@ sub parse_c_file {
if($name16 eq "COLORREF16") { $name16 = "COLORREF"; } 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_end;
&$function_begin($documentation, "", $name32, "WINAPI", $return32, \@arguments32); &$function_begin($documentation_line, $documentation,
$function_line, "", $name32, "WINAPI", $return32, \@arguments32);
&$function_end; &$function_end;
} elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) { } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
my @arguments16 = ("HDC16", "LP" . $5 . "16"); my @arguments16 = ("HDC16", "LP" . $5 . "16");
my @arguments32 = ("HDC", "LP" . $5); 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_end;
&$function_begin($documentation, "", "BOOL", "WINAPI", $2, \@arguments32); &$function_begin($documentation_line, $documentation,
$function_line, "", "BOOL", "WINAPI", $2, \@arguments32);
&$function_end; &$function_end;
} elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) { } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
my @arguments16 = ("HDC16", "INT16"); my @arguments16 = ("HDC16", "INT16");
my @arguments32 = ("HDC", "INT"); 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_end;
&$function_begin($documentation, "", "INT", "WINAPI", $2, \@arguments32); &$function_begin($documentation_line, $documentation,
$function_line, "", "INT", "WINAPI", $2, \@arguments32);
&$function_end; &$function_end;
} elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) { } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
my @arguments16 = ("HWAVEIN16"); my @arguments16 = ("HWAVEIN16");
my @arguments32 = ("HWAVEIN"); 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_end;
&$function_begin($documentation, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32); &$function_begin($documentation_line, $documentation,
$function_line, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
&$function_end; &$function_end;
} elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) { } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
my @arguments16 = ("HWAVEOUT16"); my @arguments16 = ("HWAVEOUT16");
my @arguments32 = ("HWAVEOUT"); 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_end;
&$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32); &$function_begin($documentation_line, $documentation,
$function_line, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
&$function_end; &$function_end;
} elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) { } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
$_ = $'; $again = 1; $_ = $'; $again = 1;
if($1 eq "1") { if($1 eq "1") {
my @arguments16 = ("HWAVEOUT16", $4); my @arguments16 = ("HWAVEOUT16", $4);
my @arguments32 = ("HWAVEOUT", $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_end;
&$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32); &$function_begin($documentation_line, $documentation,
$function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
&$function_end; &$function_end;
} elsif($1 eq 2) { } elsif($1 eq 2) {
my @arguments16 = ("UINT16", $4); my @arguments16 = ("UINT16", $4);
my @arguments32 = ("UINT", $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_end;
&$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32); &$function_begin($documentation_line, $documentation,
$function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
&$function_end; &$function_end;
} }
} elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) { } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment