- Begun implementation of a C statements parser.
- More reorganizations and fixes.
diff --git a/tools/winapi/c_parser.pm b/tools/winapi/c_parser.pm
new file mode 100644
index 0000000..957723a
--- /dev/null
+++ b/tools/winapi/c_parser.pm
@@ -0,0 +1,534 @@
+package c_parser;
+
+use strict;
+
+use options qw($options);
+use output qw($output);
+
+sub _update_c_position {
+ local $_ = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ while($_) {
+ if(s/^[^\n\t\'\"]*//s) {
+ $column += length($&);
+ }
+
+ if(s/^\'//) {
+ $column++;
+ while(/^./ && !s/^\'//) {
+ s/^([^\'\\]*)//s;
+ $column += length($1);
+ if(s/^\\//) {
+ $column++;
+ if(s/^(.)//s) {
+ $column += length($1);
+ if($1 eq "0") {
+ s/^(\d{0,3})//s;
+ $column += length($1);
+ }
+ }
+ }
+ }
+ $column++;
+ } elsif(s/^\"//) {
+ $column++;
+ while(/^./ && !s/^\"//) {
+ s/^([^\"\\]*)//s;
+ $column += length($1);
+ if(s/^\\//) {
+ $column++;
+ if(s/^(.)//s) {
+ $column += length($1);
+ if($1 eq "0") {
+ s/^(\d{0,3})//s;
+ $column += length($1);
+ }
+ }
+ }
+ }
+ $column++;
+ } elsif(s/^\n//) {
+ $line++;
+ $column = 0;
+ } elsif(s/^\t//) {
+ $column = $column + 8 - $column % 8;
+ }
+ }
+
+ $$refline = $line;
+ $$refcolumn = $column;
+}
+
+sub parse_c {
+ my $pattern = shift;
+ my $refcurrent = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+
+ local $_ = $$refcurrent;
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ if(s/$pattern//) {
+ _update_c_position($&, \$line, \$column);
+ } else {
+ return 0;
+ }
+
+ $$refcurrent = $_;
+ $$refline = $line;
+ $$refcolumn = $column;
+
+ return 1;
+}
+
+sub parse_c_until_one_of {
+ my $characters = shift;
+ my $refcurrent = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+ my $match = shift;
+
+ local $_ = $$refcurrent;
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ if(!defined($line) || !defined($column)) {
+ $output->write("error: \$characters = '$characters' \$_ = '$_'\n");
+ exit 1;
+ }
+
+ if(!defined($match)) {
+ my $blackhole;
+ $match = \$blackhole;
+ }
+
+ $$match = "";
+ while(/^[^$characters]/s) {
+ my $submatch = "";
+
+ if(s/^[^$characters\n\t\'\"]*//s) {
+ $submatch .= $&;
+ }
+
+ if(s/^\'//) {
+ $submatch .= "\'";
+ while(/^./ && !s/^\'//) {
+ s/^([^\'\\]*)//s;
+ $submatch .= $1;
+ if(s/^\\//) {
+ $submatch .= "\\";
+ if(s/^(.)//s) {
+ $submatch .= $1;
+ if($1 eq "0") {
+ s/^(\d{0,3})//s;
+ $submatch .= $1;
+ }
+ }
+ }
+ }
+ $submatch .= "\'";
+
+ $$match .= $submatch;
+ $column += length($submatch);
+ } elsif(s/^\"//) {
+ $submatch .= "\"";
+ while(/^./ && !s/^\"//) {
+ s/^([^\"\\]*)//s;
+ $submatch .= $1;
+ if(s/^\\//) {
+ $submatch .= "\\";
+ if(s/^(.)//s) {
+ $submatch .= $1;
+ if($1 eq "0") {
+ s/^(\d{0,3})//s;
+ $submatch .= $1;
+ }
+ }
+ }
+ }
+ $submatch .= "\"";
+
+ $$match .= $submatch;
+ $column += length($submatch);
+ } elsif(s/^\n//) {
+ $submatch .= "\n";
+
+ $$match .= $submatch;
+ $line++;
+ $column = 0;
+ } elsif(s/^\t//) {
+ $submatch .= "\t";
+
+ $$match .= $submatch;
+ $column = $column + 8 - $column % 8;
+ } else {
+ $$match .= $submatch;
+ $column += length($submatch);
+ }
+ }
+
+ $$refcurrent = $_;
+ $$refline = $line;
+ $$refcolumn = $column;
+ return 1;
+}
+
+sub parse_c_block {
+ my $refcurrent = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+ my $refstatements = shift;
+ my $refstatements_line = shift;
+ my $refstatements_column = shift;
+
+ local $_ = $$refcurrent;
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ my $statements;
+ if(s/^\{//) {
+ $column++;
+ $statements = "";
+ } else {
+ return 0;
+ }
+
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+
+ my $statements_line = $line;
+ my $statements_column = $column;
+
+ my $plevel = 1;
+ while($plevel > 0) {
+ my $match;
+ parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
+
+ $column++;
+
+ $statements .= $match;
+ if(s/^\}//) {
+ $plevel--;
+ if($plevel > 0) {
+ $statements .= "}";
+ }
+ } elsif(s/^\{//) {
+ $plevel++;
+ $statements .= "{";
+ } else {
+ return 0;
+ }
+ }
+
+ $$refcurrent = $_;
+ $$refline = $line;
+ $$refcolumn = $column;
+ $$refstatements = $statements;
+ $$refstatements_line = $statements_line;
+ $$refstatements_column = $statements_column;
+
+ return 1;
+}
+
+sub parse_c_expression {
+ my $refcurrent = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+ my $found_function_call_callback = shift;
+
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ local $_ = $$refcurrent;
+
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+
+ if(s/^(.*?)(\w+)(\s*)\(//s) {
+ my $begin_line = $line;
+ my $begin_column = $column + length($1) + 1;
+
+ $line = $begin_line;
+ $column = $begin_column + length("$2$3") - 1;
+
+ my $name = $2;
+
+ $_ = "($'";
+
+ # $output->write("$name: $line.$column: '$_'\n");
+
+ my @arguments;
+ my @argument_lines;
+ my @argument_columns;
+ if(!parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
+ return 0;
+ }
+
+ if($name =~ /^sizeof$/) {
+ # Nothing
+ } else {
+ &$found_function_call_callback($begin_line, $begin_column, $line, $column,
+ $name, \@arguments);
+ }
+
+ while(defined(my $argument = shift @arguments) &&
+ defined(my $argument_line = shift @argument_lines) &&
+ defined(my $argument_column = shift @argument_columns))
+ {
+ parse_c_expression(\$argument, \$argument_line, \$argument_column, $found_function_call_callback);
+ }
+ } elsif(s/^return//) {
+ $column += length($&);
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+ if(!parse_c_expression(\$_, \$line, \$column, $found_function_call_callback)) {
+ return 0;
+ }
+ } else {
+ return 0;
+ }
+
+ _update_c_position($_, \$line, \$column);
+
+ $$refcurrent = $_;
+ $$refline = $line;
+ $$refcolumn = $column;
+
+ return 1;
+}
+
+sub parse_c_statement {
+ my $refcurrent = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+ my $found_function_call_callback = shift;
+
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ local $_ = $$refcurrent;
+
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+
+ if(s/^(?:case\s+)?(\w+)\s*://) {
+ $column += length($&);
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+ }
+
+ # $output->write("$line.$column: '$_'\n");
+
+ if(/^$/) {
+ # Nothing
+ } elsif(/^\{/) {
+ my $statements;
+ my $statements_line;
+ my $statements_column;
+ if(!parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
+ return 0;
+ }
+ if(!parse_c_statements(\$statements, \$statements_line, \$statements_column, $found_function_call_callback)) {
+ return 0;
+ }
+ } elsif(/^(for|if|switch|while)(\s*)\(/) {
+ $column += length("$1$2");
+ my $name = $1;
+
+ $_ = "($'";
+
+ my @arguments;
+ my @argument_lines;
+ my @argument_columns;
+ if(!parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
+ return 0;
+ }
+
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+ if(!parse_c_statement(\$_, \$line, \$column, $found_function_call_callback)) {
+ return 0;
+ }
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+
+ while(defined(my $argument = shift @arguments) &&
+ defined(my $argument_line = shift @argument_lines) &&
+ defined(my $argument_column = shift @argument_columns))
+ {
+ parse_c_expression(\$argument, \$argument_line, \$argument_column, $found_function_call_callback);
+ }
+ } elsif(s/^else//) {
+ $column += length($&);
+ if(!parse_c_statement(\$_, \$line, \$column, $found_function_call_callback)) {
+ return 0;
+ }
+ } elsif(parse_c_expression(\$_, \$line, \$column, $found_function_call_callback)) {
+ # Nothing
+ } else {
+ # $output->write("error '$_'\n");
+ # exit 1;
+ }
+
+ _update_c_position($_, \$line, \$column);
+
+ $$refcurrent = $_;
+ $$refline = $line;
+ $$refcolumn = $column;
+
+ return 1;
+}
+
+sub parse_c_statements {
+ my $refcurrent = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+ my $found_function_call_callback = shift;
+
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ local $_ = $$refcurrent;
+
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+ my $statement = "";
+ my $statement_line = $line;
+ my $statement_column = $column;
+
+ my $blevel = 1;
+ my $plevel = 1;
+ while($plevel > 0 || $blevel > 0) {
+ my $match;
+ parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
+
+ # $output->write("'$match' '$_'\n");
+
+ $column++;
+ $statement .= $match;
+ if(s/^[\(\[]//) {
+ $plevel++;
+ $statement .= $&;
+ } elsif(s/^[\)\]]//) {
+ $plevel--;
+ if($plevel <= 0) {
+ $output->write("error $plevel: '$statement' '$match' '$_'\n");
+ exit 1;
+ }
+ $statement .= $&;
+ } elsif(s/^\{//) {
+ $blevel++;
+ $statement .= $&;
+ } elsif(s/^\}//) {
+ $blevel--;
+ $statement .= $&;
+ if($blevel == 1) {
+ if(!parse_c_statement(\$statement, \$statement_line, \$statement_column, $found_function_call_callback)) {
+ return 0;
+ }
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+ $statement = "";
+ $statement_line = $line;
+ $statement_column = $column;
+ }
+ } elsif(s/^;//) {
+ if($plevel == 1 && $blevel == 1) {
+ if(!parse_c_statement(\$statement, \$statement_line, \$statement_column, $found_function_call_callback)) {
+ return 0;
+ }
+
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+ $statement = "";
+ $statement_line = $line;
+ $statement_column = $column;
+ } else {
+ $statement .= $&;
+ }
+ } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
+ $plevel = 0;
+ $blevel = 0;
+ } else {
+ $output->write("error $plevel: '$statement' '$match' '$_'\n");
+ exit 1;
+ }
+ }
+
+ _update_c_position($_, \$line, \$column);
+
+ $$refcurrent = $_;
+ $$refline = $line;
+ $$refcolumn = $column;
+
+ return 1;
+}
+
+sub parse_c_tuple {
+ my $refcurrent = shift;
+ my $refline = shift;
+ my $refcolumn = shift;
+
+ # FIXME: Should not write directly
+ my $items = shift;
+ my $item_lines = shift;
+ my $item_columns = shift;
+
+ local $_ = $$refcurrent;
+
+ my $line = $$refline;
+ my $column = $$refcolumn;
+
+ my $item;
+ if(s/^\(//) {
+ $column++;
+ $item = "";
+ } else {
+ return 0;
+ }
+
+ my $item_line = $line;
+ my $item_column = $column + 1;
+
+ my $plevel = 1;
+ while($plevel > 0) {
+ my $match;
+ parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
+
+ $column++;
+
+ $item .= $match;
+ if(s/^\)//) {
+ $plevel--;
+ if($plevel == 0) {
+ push @$item_lines, $item_line;
+ push @$item_columns, $item_column;
+ push @$items, $item;
+ $item = "";
+ } else {
+ $item .= ")";
+ }
+ } elsif(s/^\(//) {
+ $plevel++;
+ $item .= "(";
+ } elsif(s/^,//) {
+ if($plevel == 1) {
+ push @$item_lines, $item_line;
+ push @$item_columns, $item_column;
+ push @$items, $item;
+ parse_c_until_one_of("\\S", \$_, \$line, \$column);
+ $item_line = $line;
+ $item_column = $column + 1;
+ $item = "";
+ } else {
+ $item .= ",";
+ }
+ } else {
+ return 0;
+ }
+ }
+
+ $$refcurrent = $_;
+ $$refline = $line;
+ $$refcolumn = $column;
+
+ return 1;
+}
+
+1;
diff --git a/tools/winapi/function.pm b/tools/winapi/function.pm
index be48873..2bd9b37 100644
--- a/tools/winapi/function.pm
+++ b/tools/winapi/function.pm
@@ -143,6 +143,17 @@
return $$argument_documentations;
}
+sub statements_line {
+ my $self = shift;
+ my $statements_line = \${$self->{STATEMENTS_LINE}};
+
+ local $_ = shift;
+
+ if(defined($_)) { $$statements_line = $_; }
+
+ return $$statements_line;
+}
+
sub statements {
my $self = shift;
my $statements = \${$self->{STATEMENTS}};
diff --git a/tools/winapi/make_filter b/tools/winapi/make_filter
index 8278270..4cbd1f3 100755
--- a/tools/winapi/make_filter
+++ b/tools/winapi/make_filter
@@ -38,13 +38,13 @@
if($message) {
if($file && $line) {
- if($directory && $directory ne ".") {
+ if($directory && $directory ne "." && $file !~ m%^/%) {
$output->write(&file_normalize("$directory/$file") . ":$line: $message\n");
} else {
$output->write("$file:$line: $message\n");
}
} elsif($file) {
- if($directory && $directory ne ".") {
+ if($directory && $directory ne "." && $file !~ m%^/%) {
$output->write(&file_normalize("$directory/$file") . ": $message\n");
} else {
$output->write("$file: $message\n");
diff --git a/tools/winapi/make_parser.pm b/tools/winapi/make_parser.pm
index 62e844d..ff0b517 100644
--- a/tools/winapi/make_parser.pm
+++ b/tools/winapi/make_parser.pm
@@ -131,7 +131,7 @@
error("line");
} elsif($tool eq "bison" && /^conflicts:\s+\d+\s+shift\/reduce$/) {
# Nothing
- } elsif($tool eq "gcc" && /^In file included from (.+?):(\d+):$/) {
+ } elsif($tool eq "gcc" && /^(?:In file included |\s*)from (.+?):(\d+)[,:]$/) {
# Nothing
} elsif($tool =~ /^gcc|ld$/ && s/^(.+?\.o(?:\(.*?\))?):\s*//) {
ld_output($1, $_)
diff --git a/tools/winapi/winapi_fixup b/tools/winapi/winapi_fixup
index f043138..3583143 100755
--- a/tools/winapi/winapi_fixup
+++ b/tools/winapi/winapi_fixup
@@ -18,14 +18,15 @@
);
use output qw($output);
use winapi_fixup_options qw($options);
-use modules qw($modules);
-use winapi qw($win16api $win32api @winapis);
use type;
-use util;
use winapi_function;
use winapi_parser;
+use winapi_fixup_documentation qw(&fixup_documentation);
+use winapi_fixup_editor;
+use winapi_fixup_statements qw(&fixup_statements);
+
my @c_files = $options->c_files;
@c_files = files_skip(@c_files);
@c_files = files_filter("winelib", @c_files);
@@ -35,400 +36,38 @@
my $progress_max = scalar(@c_files);
foreach my $file (@c_files) {
- my %insert_line;
- my %substitute_line;
- my %delete_line;
-
- my %spec_file;
+ my $editor = new winapi_fixup_editor($file);
$progress_current++;
if($options->progress) {
- $output->progress("$file: file $progress_current of $progress_max");
+ $output->progress("$file (file $progress_current of $progress_max)");
}
- my %documentation_line_used;
-
my $create_function = sub {
return 'winapi_function'->new;
};
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 $statements = $function->statements;
-
- if($linkage eq "static" ||
- ($linkage eq "extern" && !defined($statements)) ||
- ($linkage eq "" && !defined($statements)))
- {
- return;
+ if($options->progress) {
+ $output->progress("$file (file $progress_current of $progress_max): $internal_name");
}
- my @external_names = $function->external_names;
- if($#external_names < 0) {
- return;
- }
-
- if($documentation_line_used{$documentation_line}) {
- $documentation = undef;
- }
- $documentation_line_used{$documentation_line}++;
-
$output->prefix_callback(sub { return $function->prefix; });
- my @module_ordinal_entries = ();
- foreach my $entry2 ($function->get_all_module_ordinal) {
- (my $external_name2, my $module2, my $ordinal2) = @$entry2;
- if(($external_name2 eq "@" ||
- ($win16api->is_module($module2) && !$win16api->is_function_stub_in_module($module2, $external_name2)) ||
- ($win32api->is_module($module2) && !$win32api->is_function_stub_in_module($module2, $external_name2))) &&
- $modules->is_allowed_module_in_file($module2, "$current_dir/$file"))
- {
- push @module_ordinal_entries, $entry2;
- }
+ if($options->documentation) {
+ fixup_documentation($function, $editor);
}
- my $spec_modified = 0;
-
- if($options->stub && defined($documentation)) {
- my $calling_convention16 = $function->calling_convention16;
- my $calling_convention32 = $function->calling_convention32;
-
- foreach my $winapi (@winapis) {
- my @entries = ();
- my $module = $winapi->function_internal_module($internal_name);
- my $ordinal = $winapi->function_internal_ordinal($internal_name);
-
- if($winapi->is_function_stub_in_module($module, $internal_name)) {
- my $external_name = $internal_name;
- if($winapi->name eq "win16") {
- $external_name =~ s/(?:_)?16([AW]?)$//;
- if(defined($1)) {
- $external_name .= $1;
- }
- }
- push @entries, [$external_name, $module, $ordinal];
- }
-
- foreach (split(/\n/, $documentation)) {
- if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
- my $external_name = $1;
- my $module = lc($2);
- my $ordinal = $3;
-
- if($external_name ne "@" &&
- $winapi->is_module($module) &&
- $winapi->is_function_stub_in_module($module, $external_name) &&
- $internal_name !~ /^\U$module\E_\Q$external_name\E$/)
- {
- push @entries, [$external_name, $module, $ordinal];
- }
- }
- }
-
- foreach my $entry (@entries) {
- (my $external_name, my $module, my $ordinal) = @$entry;
-
- my $refargument_types = $function->argument_types;
-
- if(!defined($refargument_types)) {
- next;
- }
-
- my $abort = 0;
- my $n;
- my @argument_kinds = map {
- my $type = $_;
- my $kind;
- if($type ne "..." && !defined($kind = $winapi->translate_argument($type))) {
- $output->write("no translation defined: " . $type . "\n");
- }
-
- # FIXME: Kludge
- if(defined($kind) && $kind eq "longlong") {
- $n += 2;
- ("long", "long");
- } elsif(defined($kind)) {
- $n++;
- $kind;
- } elsif($type eq "...") {
- if($winapi->name eq "win16") {
- $calling_convention16 = "pascal"; # FIXME: Is this correct?
- } else {
- $calling_convention32 = "varargs";
- }
- ();
- } else {
- $abort = 1;
- $n++;
- "undef";
- }
- } @$refargument_types;
-
- my $substitute = {};
- $substitute->{search} = "^\\s*$ordinal\\s+stub\\s+$external_name\\s*(?:#.*?)?\$";
-
- if($winapi->name eq "win16") {
- $substitute->{replace} = "$ordinal $calling_convention16 $external_name(@argument_kinds) $internal_name";
- } else {
- $substitute->{replace} = "$ordinal $calling_convention32 $external_name(@argument_kinds) $internal_name";
- }
-
- if(!defined($spec_file{$module})) {
- $spec_file{$module} = [];
- }
-
- if(!$abort) {
- $spec_modified = 1;
- push @{$spec_file{$module}}, $substitute;
- }
- }
- }
- }
-
- my %found_external_names;
- foreach my $external_name (@external_names) {
- $found_external_names{$external_name} = {};
- }
-
- my $documentation_modified = 0;
-
- if(!$spec_modified &&
- (defined($documentation) && !$documentation_modified) &&
- ($options->documentation_name || $options->documentation_ordinal ||
- $options->documentation_missing))
- {
- local $_;
-
- my $line3;
- my $search;
- my $replace;
-
- my $count = 0;
- my $line2 = $documentation_line - 1;
- foreach (split(/\n/, $documentation)) {
- $line2++;
- if(/^(\s*\*\s*(\S+)\s*)((?:\s*[\(\[]\s*\w+(?:\s*\.\s*[^\s\)\]]*\s*)?[\)\]])+)(.*?)$/) {
- my $part1 = $1;
- my $external_name = $2;
- my $part3 = $3;
- my $part4 = $4;
-
- $part4 =~ s/\s*$//;
-
- my @entries = ();
- while($part3 =~ s/^\s*([\(\[]\s*(\w+)(?:\s*\.\s*([^\s\)\]]*)\s*)?[\)\]])//) {
- push @entries, [$1, $2, $3];
- }
-
- my $found = 0;
- foreach my $external_name2 (@external_names) {
- if($external_name eq $external_name2) {
- foreach my $entry (@entries) {
- (undef, my $module, undef) = @$entry;
- $found_external_names{$external_name2}{$module} = 1;
- }
- $found = 1;
- last;
- }
- }
-
- my $replaced = 0;
- my $replace2 = "";
- foreach my $entry (@entries) {
- my $part12 = $part1;
- (my $part32, my $module, my $ordinal) = @$entry;
-
- foreach my $entry2 (@module_ordinal_entries) {
- (my $external_name2, my $module2, my $ordinal2) = @$entry2;
-
- 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/) {
- $external_name = $external_name2;
- $replaced++;
- }
- }
-
- if($options->documentation_ordinal &&
- $external_name eq $external_name2 &&
- lc($module) eq $module2 &&
- ($#entries > 0 || !defined($ordinal) || ($ordinal ne $ordinal2)))
- {
- if(defined($ordinal)) {
- if($part32 =~ s/\Q$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
- $replaced++;
- }
- } else {
- if($part32 =~ s/\Q$module\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
- $replaced++;
- }
- }
- }
-
- }
- if($replace2) { $replace2 .= "\n"; }
- $replace2 .= "$part12$part32$part4";
- }
-
- if($replaced > 0) {
- $line3 = $line2;
- $search = "^\Q$_\E\$";
- $replace = $replace2;
- }
- $count++;
- } elsif(/^(\s*\*\s*)([^\s\(]+)(?:\(\))?\s*$/) {
- my $part1 = $1;
- my $external_name = $2;
-
- if($internal_name =~ /^(?:\S+_)?\Q$external_name\E(?:16)?$/) {
- foreach my $entry (@module_ordinal_entries) {
- (my $external_name2, my $module, my $ordinal) = @$entry;
-
- $line3 = $line2;
- $search = "^\Q$_\E\$";
- $replace = "$part1$external_name2 (\U$module\E.$ordinal)";
- }
- $count++;
- }
- }
- }
-
- 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");
- } else {
- $documentation_modified = 1;
-
- $substitute_line{$line3}{search} = $search;
- $substitute_line{$line3}{replace} = $replace;
-
- }
- }
- }
-
- if(!$spec_modified && !$documentation_modified &&
- $options->documentation_missing && defined($documentation))
- {
- my $part1;
- my $part2;
- my $part3;
- my $part4;
- my $line3 = 0;
-
- my $line2 = $documentation_line - 1;
- foreach (split(/\n/, $documentation)) {
- $line2++;
- if(/^(\s*\*\s*)(\S+\s*)([\(\[])\s*\w+\s*\.\s*[^\s\)\]]*\s*([\)\]]).*?$/) {
- $part1 = $1;
- $part2 = $2;
- $part3 = $3;
- $part4 = $4;
-
- $part2 =~ s/\S/ /g;
-
- $line3 = $line2 + 1;
- }
- }
-
- foreach my $entry2 (@module_ordinal_entries) {
- (my $external_name2, my $module2, my $ordinal2) = @$entry2;
-
- my $found = 0;
- foreach my $external_name (keys(%found_external_names)) {
- foreach my $module3 (keys(%{$found_external_names{$external_name}})) {
- if($external_name eq $external_name2 && uc($module2) eq $module3) {
- $found = 1;
- }
- }
- }
- # FIXME: Not 100% correct
- if(!$found &&
- !$win16api->is_function_stub_in_module($module2, $internal_name) &&
- !$win32api->is_function_stub_in_module($module2, $internal_name))
- {
- if($line3 > 0) {
- $documentation_modified = 1;
-
- $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");
- }
- }
- }
- }
-
- if(!$documentation_modified &&
- defined($documentation) &&
- $options->documentation_wrong)
- {
- my $line2 = $documentation_line - 1;
- foreach (split(/\n/, $documentation)) {
- $line2++;
- if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
- my $external_name = $1;
- my $module = $2;
- my $ordinal = $3;
-
- my $found = 0;
- foreach my $entry2 (@module_ordinal_entries) {
- (my $external_name2, my $module2, my $ordinal2) = @$entry2;
-
- if($external_name eq $external_name2 &&
- lc($module) eq $module2 &&
- $ordinal eq $ordinal2)
- {
- $found = 1;
- }
- }
- if(!$found) {
- if(1) {
- $documentation_modified = 1;
-
- $delete_line{$line2} = "^\Q$_\E\$";
- } else {
- $output->write("$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n");
- };
- }
- }
- }
- }
-
- if(!$spec_modified && !$documentation_modified && !defined($documentation))
- {
- my $insert = "";
- foreach my $winapi (@winapis) {
- my $external_name = $winapi->function_external_name($internal_name);
- my $module = $winapi->function_internal_module($internal_name);
- my $ordinal = $winapi->function_internal_ordinal($internal_name);
-
- if(defined($external_name) && defined($module) && defined($ordinal)) {
- $insert .= " *\t\t$external_name (\U$module\E.$ordinal)\n";
- }
- }
- if($insert) {
- $insert_line{$function_line} =
- "/" . "*" x 71 . "\n" .
- "$insert" .
- " */\n";
- }
+ if($options->statements) {
+ fixup_statements($function, $editor);
}
$output->prefix("");
};
-
my $create_type = sub {
return 'type'->new;
};
@@ -444,160 +83,6 @@
&winapi_parser::parse_c_file($file, $create_function, $found_function, $create_type, $found_type, $found_preprocessor);
- my $editor = sub {
- local *IN = shift;
- local *OUT = shift;
-
- my $modified = 0;
- while(<IN>) {
- chomp;
-
- my $line;
-
- $line = $insert_line{$.};
- if(defined($line)) {
- 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");
- foreach my $line2 (@line2) {
- $output->write("'$line2'\n");
- }
- } else {
- $output->write("$file: $.: insert: '$line2'\n");
- }
- }
- }
-
- my $search = $substitute_line{$.}{search};
- my $replace = $substitute_line{$.}{replace};
-
- if(defined($search) && defined($replace)) {
- my $modified2 = 0;
- if(s/$search/$replace/) {
- if($options->modify) {
- $modified = 1;
- }
- $modified2 = 1;
- }
-
- if(!$options->modify || !$modified2) {
- my $search2;
- my $replace2;
- if(!$modified2) {
- $search2 = "unmatched search";
- $replace2 = "unmatched replace";
- } else {
- $search2 = "search";
- $replace2 = "replace";
- }
- $output->write("$file: $.: $search2 : '$search'\n");
-
- my @replace2 = split(/\n/, $replace);
- if($#replace2 > 0) {
- $output->write("$file: $.: $replace2: \\\n");
- foreach my $replace2 (@replace2) {
- $output->write("'$replace2'\n");
- }
- } else {
- $output->write("$file: $.: $replace2: '$replace'\n");
- }
- }
- }
-
- $line = $delete_line{$.};
- if(defined($line)) {
- if(/$line/) {
- if($options->modify) {
- $modified = 1;
- next;
- } else {
- $output->write("$file: $.: delete: '$line'\n");
- }
- } else {
- $output->write("$file: $.: unmatched delete: '$line'\n");
- }
- }
-
- print OUT "$_\n";
- }
-
- return $modified;
- };
-
- my $n = 0;
- while(defined(each %insert_line)) { $n++; }
- while(defined(each %substitute_line)) { $n++; }
- while(defined(each %delete_line)) { $n++; }
- if($n > 0) {
- edit_file($file, $editor);
- }
-
- foreach my $module (sort(keys(%spec_file))) {
- my $file;
- foreach my $winapi (@winapis) {
- $file = ($winapi->module_file($module) || $file);
- }
-
- if(defined($file)) {
- $file = file_normalize($file);
- }
-
- my @substitutes = @{$spec_file{$module}};
-
- my $editor = sub {
- local *IN = shift;
- local *OUT = shift;
-
- my $modified = 0;
- while(<IN>) {
- chomp;
-
- my @substitutes2 = ();
- foreach my $substitute (@substitutes) {
- my $search = $substitute->{search};
- my $replace = $substitute->{replace};
-
- if(s/$search/$replace/) {
- if($options->modify) {
- $modified = 1;
- } else {
- $output->write("$file: search : '$search'\n");
- $output->write("$file: replace: '$replace'\n");
- }
- next;
- } else {
- push @substitutes2, $substitute;
- }
- }
- @substitutes = @substitutes2;
-
- print OUT "$_\n";
- }
-
- return $modified;
- };
-
- if(defined($file)) {
- edit_file($file, $editor);
- } else {
- $output->write("$module: doesn't have any spec file\n");
- }
-
- if($#substitutes >= 0) {
- foreach my $substitute (@substitutes) {
- my $search = $substitute->{search};
- my $replace = $substitute->{replace};
-
- $output->write("$file: unmatched search : '$search'\n");
- $output->write("$file: unmatched replace: '$replace'\n");
- }
- }
-
- }
+ $editor->flush;
}
diff --git a/tools/winapi/winapi_fixup_documentation.pm b/tools/winapi/winapi_fixup_documentation.pm
new file mode 100644
index 0000000..15d22ea
--- /dev/null
+++ b/tools/winapi/winapi_fixup_documentation.pm
@@ -0,0 +1,384 @@
+package winapi_fixup_documentation;
+
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw();
+@EXPORT_OK = qw(&fixup_documentation);
+
+use config qw($current_dir $wine_dir);
+use modules qw($modules);
+use options qw($options);
+use output qw($output);
+use winapi qw($win16api $win32api @winapis);
+
+my %documentation_line_used;
+
+sub fixup_documentation {
+ my $function = shift;
+ my $editor = shift;
+
+ my $file = $function->file;
+ 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 $statements = $function->statements;
+
+ if($linkage eq "static" ||
+ ($linkage eq "extern" && !defined($statements)) ||
+ ($linkage eq "" && !defined($statements)))
+ {
+ return;
+ }
+
+ my @external_names = $function->external_names;
+ if($#external_names < 0) {
+ return;
+ }
+
+ if($documentation_line_used{$file}{documentation_line}) {
+ $documentation = undef;
+ }
+ $documentation_line_used{$file}{$documentation_line}++;
+
+ my @module_ordinal_entries = ();
+ foreach my $entry2 ($function->get_all_module_ordinal) {
+ (my $external_name2, my $module2, my $ordinal2) = @$entry2;
+ if(($external_name2 eq "@" ||
+ ($win16api->is_module($module2) && !$win16api->is_function_stub_in_module($module2, $external_name2)) ||
+ ($win32api->is_module($module2) && !$win32api->is_function_stub_in_module($module2, $external_name2))) &&
+ $modules->is_allowed_module_in_file($module2, "$current_dir/$file"))
+ {
+ push @module_ordinal_entries, $entry2;
+ }
+ }
+
+ my $spec_modified = 0;
+
+ if($options->stub && defined($documentation)) {
+ my $calling_convention16 = $function->calling_convention16;
+ my $calling_convention32 = $function->calling_convention32;
+
+ foreach my $winapi (@winapis) {
+ my @entries = ();
+ my $module = $winapi->function_internal_module($internal_name);
+ my $ordinal = $winapi->function_internal_ordinal($internal_name);
+
+ if($winapi->is_function_stub_in_module($module, $internal_name)) {
+ my $external_name = $internal_name;
+ if($winapi->name eq "win16") {
+ $external_name =~ s/(?:_)?16([AW]?)$//;
+ if(defined($1)) {
+ $external_name .= $1;
+ }
+ }
+ push @entries, [$external_name, $module, $ordinal];
+ }
+
+ foreach (split(/\n/, $documentation)) {
+ if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
+ my $external_name = $1;
+ my $module = lc($2);
+ my $ordinal = $3;
+
+ if($external_name ne "@" &&
+ $winapi->is_module($module) &&
+ $winapi->is_function_stub_in_module($module, $external_name) &&
+ $internal_name !~ /^\U$module\E_\Q$external_name\E$/)
+ {
+ push @entries, [$external_name, $module, $ordinal];
+ }
+ }
+ }
+
+ foreach my $entry (@entries) {
+ (my $external_name, my $module, my $ordinal) = @$entry;
+
+ my $refargument_types = $function->argument_types;
+
+ if(!defined($refargument_types)) {
+ next;
+ }
+
+ my $abort = 0;
+ my $n;
+ my @argument_kinds = map {
+ my $type = $_;
+ my $kind;
+ if($type ne "..." && !defined($kind = $winapi->translate_argument($type))) {
+ $output->write("no translation defined: " . $type . "\n");
+ }
+
+ # FIXME: Kludge
+ if(defined($kind) && $kind eq "longlong") {
+ $n += 2;
+ ("long", "long");
+ } elsif(defined($kind)) {
+ $n++;
+ $kind;
+ } elsif($type eq "...") {
+ if($winapi->name eq "win16") {
+ $calling_convention16 = "pascal"; # FIXME: Is this correct?
+ } else {
+ $calling_convention32 = "varargs";
+ }
+ ();
+ } else {
+ $abort = 1;
+ $n++;
+ "undef";
+ }
+ } @$refargument_types;
+
+ my $search = "^\\s*$ordinal\\s+stub\\s+$external_name\\s*(?:#.*?)?\$";
+ my $replace;
+ if($winapi->name eq "win16") {
+ $replace = "$ordinal $calling_convention16 $external_name(@argument_kinds) $internal_name";
+ } else {
+ $replace = "$ordinal $calling_convention32 $external_name(@argument_kinds) $internal_name";
+ }
+
+ if(!$abort) {
+ $spec_modified = 1;
+ $editor->replace_spec_file($module, $search, $replace);
+ }
+ }
+ }
+ }
+
+ my %found_external_names;
+ foreach my $external_name (@external_names) {
+ $found_external_names{$external_name} = {};
+ }
+
+ my $documentation_modified = 0;
+
+ if(!$spec_modified &&
+ (defined($documentation) && !$documentation_modified) &&
+ ($options->documentation_name || $options->documentation_ordinal ||
+ $options->documentation_missing))
+ {
+ local $_;
+
+ my $line3;
+ my $search;
+ my $replace;
+
+ my $count = 0;
+ my $line2 = $documentation_line - 1;
+ foreach (split(/\n/, $documentation)) {
+ $line2++;
+ if(/^(\s*\*\s*(\S+)\s*)((?:\s*[\(\[]\s*\w+(?:\s*\.\s*[^\s\)\]]*\s*)?[\)\]])+)(.*?)$/) {
+ my $part1 = $1;
+ my $external_name = $2;
+ my $part3 = $3;
+ my $part4 = $4;
+
+ $part4 =~ s/\s*$//;
+
+ my @entries = ();
+ while($part3 =~ s/^\s*([\(\[]\s*(\w+)(?:\s*\.\s*([^\s\)\]]*)\s*)?[\)\]])//) {
+ push @entries, [$1, $2, $3];
+ }
+
+ my $found = 0;
+ foreach my $external_name2 (@external_names) {
+ if($external_name eq $external_name2) {
+ foreach my $entry (@entries) {
+ (undef, my $module, undef) = @$entry;
+ $found_external_names{$external_name2}{$module} = 1;
+ }
+ $found = 1;
+ last;
+ }
+ }
+
+ my $replaced = 0;
+ my $replace2 = "";
+ foreach my $entry (@entries) {
+ my $part12 = $part1;
+ (my $part32, my $module, my $ordinal) = @$entry;
+
+ foreach my $entry2 (@module_ordinal_entries) {
+ (my $external_name2, my $module2, my $ordinal2) = @$entry2;
+
+ 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/) {
+ $external_name = $external_name2;
+ $replaced++;
+ }
+ }
+
+ if($options->documentation_ordinal &&
+ $external_name eq $external_name2 &&
+ lc($module) eq $module2 &&
+ ($#entries > 0 || !defined($ordinal) || ($ordinal ne $ordinal2)))
+ {
+ if(defined($ordinal)) {
+ if($part32 =~ s/\Q$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
+ $replaced++;
+ }
+ } else {
+ if($part32 =~ s/\Q$module\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
+ $replaced++;
+ }
+ }
+ }
+ }
+ if($replace2) { $replace2 .= "\n"; }
+ $replace2 .= "$part12$part32$part4";
+ }
+
+ if($replaced > 0) {
+ $line3 = $line2;
+ $search = "^\Q$_\E\$";
+ $replace = $replace2;
+ }
+ $count++;
+ } elsif(/^(\s*\*\s*)([^\s\(]+)(?:\(\))?\s*$/) {
+ my $part1 = $1;
+ my $external_name = $2;
+
+ if($internal_name =~ /^(?:\S+_)?\Q$external_name\E(?:16)?$/) {
+ foreach my $entry (@module_ordinal_entries) {
+ (my $external_name2, my $module, my $ordinal) = @$entry;
+
+ $line3 = $line2;
+ $search = "^\Q$_\E\$";
+ $replace = "$part1$external_name2 (\U$module\E.$ordinal)";
+ }
+ $count++;
+ }
+ }
+ }
+
+ 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");
+ } else {
+ $documentation_modified = 1;
+ $editor->substitute_line($line3, $search, $replace);
+ }
+ }
+ }
+
+ if(!$spec_modified && !$documentation_modified &&
+ $options->documentation_missing && defined($documentation))
+ {
+ my $part1;
+ my $part2;
+ my $part3;
+ my $part4;
+ my $line3 = 0;
+
+ my $line2 = $documentation_line - 1;
+ foreach (split(/\n/, $documentation)) {
+ $line2++;
+ if(/^(\s*\*\s*)(\S+\s*)([\(\[])\s*\w+\s*\.\s*[^\s\)\]]*\s*([\)\]]).*?$/) {
+ $part1 = $1;
+ $part2 = $2;
+ $part3 = $3;
+ $part4 = $4;
+
+ $part2 =~ s/\S/ /g;
+
+ $line3 = $line2 + 1;
+ }
+ }
+
+ foreach my $entry2 (@module_ordinal_entries) {
+ (my $external_name2, my $module2, my $ordinal2) = @$entry2;
+
+ my $found = 0;
+ foreach my $external_name (keys(%found_external_names)) {
+ foreach my $module3 (keys(%{$found_external_names{$external_name}})) {
+ if($external_name eq $external_name2 && uc($module2) eq $module3) {
+ $found = 1;
+ }
+ }
+ }
+ # FIXME: Not 100% correct
+ if(!$found &&
+ !$win16api->is_function_stub_in_module($module2, $internal_name) &&
+ !$win32api->is_function_stub_in_module($module2, $internal_name))
+ {
+ if($line3 > 0) {
+ $documentation_modified = 1;
+ $part2 = $external_name2 . " " x (length($part2) - length($external_name2));
+ $editor->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");
+ }
+ }
+ }
+ }
+
+ if(!$documentation_modified &&
+ defined($documentation) &&
+ $options->documentation_wrong)
+ {
+ my $line2 = $documentation_line - 1;
+ foreach (split(/\n/, $documentation)) {
+ $line2++;
+ if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
+ my $external_name = $1;
+ my $module = $2;
+ my $ordinal = $3;
+
+ my $found = 0;
+ foreach my $entry2 (@module_ordinal_entries) {
+ (my $external_name2, my $module2, my $ordinal2) = @$entry2;
+
+ if($external_name eq $external_name2 &&
+ lc($module) eq $module2 &&
+ $ordinal eq $ordinal2)
+ {
+ $found = 1;
+ }
+ }
+ if(!$found) {
+ if(1) {
+ $documentation_modified = 1;
+
+ $editor->delete_line($line2, "^\Q$_\E\$");
+ } else {
+ $output->write("$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n");
+ };
+ }
+ }
+ }
+ }
+
+ if(!$spec_modified && !$documentation_modified && !defined($documentation))
+ {
+ my $insert = "";
+ foreach my $winapi (@winapis) {
+ my $external_name = $winapi->function_external_name($internal_name);
+ my $module = $winapi->function_internal_module($internal_name);
+ my $ordinal = $winapi->function_internal_ordinal($internal_name);
+
+ if(defined($external_name) && defined($module) && defined($ordinal)) {
+ $insert .= " *\t\t$external_name (\U$module\E.$ordinal)\n";
+ }
+ }
+ if($insert) {
+ $editor->insert_line($function_line,
+ "/" . "*" x 71 . "\n" .
+ "$insert" .
+ " */\n");
+ }
+ }
+}
+
+1;
diff --git a/tools/winapi/winapi_fixup_editor.pm b/tools/winapi/winapi_fixup_editor.pm
new file mode 100644
index 0000000..89331b4
--- /dev/null
+++ b/tools/winapi/winapi_fixup_editor.pm
@@ -0,0 +1,389 @@
+package winapi_fixup_editor;
+
+use strict;
+
+use options qw($options);
+use output qw($output);
+use winapi qw($win16api $win32api @winapis);
+
+use util;
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+
+ my $file = \${$self->{FILE}};
+
+ $$file = shift;
+
+ return $self;
+}
+
+sub add_trigger {
+ my $self = shift;
+
+ my $triggers = \%{$self->{TRIGGERS}};
+
+ my $line = shift;
+ my $action = shift;
+
+ if(!defined($$triggers{$line})) {
+ $$triggers{$line} = [];
+ }
+
+ push @{$$triggers{$line}}, $action;
+}
+
+sub replace {
+ my $self = shift;
+
+ my $begin_line = shift;
+ my $begin_column = shift;
+ my $end_line = shift;
+ my $end_column = shift;
+ my $replace = shift;
+
+ my $file = \${$self->{FILE}};
+
+ my $line = $begin_line;
+ my $action = {};
+
+ $self->add_trigger($begin_line, {
+ type => "replace",
+ begin_line => $begin_line,
+ begin_column => $begin_column,
+ end_line => $end_line,
+ end_column => $end_column,
+ replace => $replace
+ });
+}
+
+sub flush {
+ my $self = shift;
+
+ my $file = \${$self->{FILE}};
+ my $triggers = \%{$self->{TRIGGERS}};
+
+ my $editor = sub {
+ local *IN = shift;
+ local *OUT = shift;
+
+ my $modified = 0;
+
+ my $again = 0;
+ my $lookahead = 0;
+ my $lookahead_count = 0;
+ LINE: while($again || defined(my $current = <IN>)) {
+ if(!$again) {
+ chomp $current;
+
+ if($lookahead) {
+ $lookahead = 0;
+ $_ .= "\n" . $current;
+ $lookahead_count++;
+ } else {
+ $_ = $current;
+ $lookahead_count = 0;
+ }
+ } else {
+ $lookahead_count = 0;
+ $again = 0;
+ }
+
+ my $line = $. - $lookahead_count;
+ foreach my $action (@{$$triggers{$line}}) {
+ if($. < $action->{end_line}) {
+ $lookahead = 1;
+ next LINE;
+ }
+
+ my $type = $action->{type};
+ my $begin_line = $action->{begin_line};
+ my $begin_column = $action->{begin_column};
+ my $end_line = $action->{end_line};
+ my $end_column = $action->{end_column};
+
+ if($type eq "replace") {
+ my $replace = $action->{replace};
+
+ my @lines = split(/\n/, $_);
+ if($#lines < 0) {
+ @lines = ($_);
+ }
+
+ my $begin = "";
+ my $column = 0;
+ $_ = $lines[0];
+ while($column < $begin_column - 1 && s/^.//) {
+ $begin .= $&;
+ if($& eq "\t") {
+ $column = $column + 8 - $column % 8;
+ } else {
+ $column++;
+ }
+ }
+
+ my $column2 = 0;
+ $_ = $lines[$#lines];
+ while($column2 < $end_column && s/^.//) {
+ if($& eq "\t") {
+ $column2 = $column2 + 8 - $column2 % 8;
+ } else {
+ $column2++;
+ }
+ }
+ my $end = $_;
+
+ $_ = "$begin$replace$end";
+ if($options->modify) {
+ $modified = 1;
+ } else {
+ $output->write("$$file:$begin_line.$begin_column-$end_line.$end_column: $replace\n");
+ }
+ }
+ }
+
+ print OUT "$_\n";
+ }
+
+ return $modified;
+ };
+
+ my $modified = 0;
+ if(1) {
+ $modified = edit_file($$file, $editor);
+ }
+
+ if(!$modified) {
+ $self->flush_old;
+ }
+}
+
+########################################################################
+# Hack for backward compabillity
+#
+
+my %insert_line;
+my %substitute_line;
+my %delete_line;
+
+my %spec_file;
+
+sub flush_old {
+ my $self = shift;
+
+ my $file = ${$self->{FILE}};
+
+ my $editor = sub {
+ local *IN = shift;
+ local *OUT = shift;
+
+ my $modified = 0;
+ while(<IN>) {
+ chomp;
+
+ my $line;
+
+ $line = $insert_line{$.};
+ if(defined($line)) {
+ 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");
+ foreach my $line2 (@line2) {
+ $output->write("'$line2'\n");
+ }
+ } else {
+ $output->write("$file: $.: insert: '$line2'\n");
+ }
+ }
+ }
+
+ my $search = $substitute_line{$.}{search};
+ my $replace = $substitute_line{$.}{replace};
+
+ if(defined($search) && defined($replace)) {
+ my $modified2 = 0;
+ if(s/$search/$replace/) {
+ if($options->modify) {
+ $modified = 1;
+ }
+ $modified2 = 1;
+ }
+
+ if(!$options->modify || !$modified2) {
+ my $search2;
+ my $replace2;
+ if(!$modified2) {
+ $search2 = "unmatched search";
+ $replace2 = "unmatched replace";
+ } else {
+ $search2 = "search";
+ $replace2 = "replace";
+ }
+ $output->write("$file: $.: $search2 : '$search'\n");
+
+ my @replace2 = split(/\n/, $replace);
+ if($#replace2 > 0) {
+ $output->write("$file: $.: $replace2: \\\n");
+ foreach my $replace2 (@replace2) {
+ $output->write("'$replace2'\n");
+ }
+ } else {
+ $output->write("$file: $.: $replace2: '$replace'\n");
+ }
+ }
+ }
+
+ $line = $delete_line{$.};
+ if(defined($line)) {
+ if(/$line/) {
+ if($options->modify) {
+ $modified = 1;
+ next;
+ } else {
+ $output->write("$file: $.: delete: '$line'\n");
+ }
+ } else {
+ $output->write("$file: $.: unmatched delete: '$line'\n");
+ }
+ }
+
+ print OUT "$_\n";
+ }
+
+ return $modified;
+ };
+
+ my $n = 0;
+ while(defined(each %insert_line)) { $n++; }
+ while(defined(each %substitute_line)) { $n++; }
+ while(defined(each %delete_line)) { $n++; }
+ if($n > 0) {
+ edit_file($file, $editor);
+ }
+
+ foreach my $module (sort(keys(%spec_file))) {
+ my $file;
+ foreach my $winapi (@winapis) {
+ $file = ($winapi->module_file($module) || $file);
+ }
+
+ if(defined($file)) {
+ $file = file_normalize($file);
+ }
+
+ my @substitutes = @{$spec_file{$module}};
+
+ my $editor = sub {
+ local *IN = shift;
+ local *OUT = shift;
+
+ my $modified = 0;
+ while(<IN>) {
+ chomp;
+
+ my @substitutes2 = ();
+ foreach my $substitute (@substitutes) {
+ my $search = $substitute->{search};
+ my $replace = $substitute->{replace};
+
+ if(s/$search/$replace/) {
+ if($options->modify) {
+ $modified = 1;
+ } else {
+ $output->write("$file: search : '$search'\n");
+ $output->write("$file: replace: '$replace'\n");
+ }
+ next;
+ } else {
+ push @substitutes2, $substitute;
+ }
+ }
+ @substitutes = @substitutes2;
+
+ print OUT "$_\n";
+ }
+
+ return $modified;
+ };
+
+ if(defined($file)) {
+ edit_file($file, $editor);
+ } else {
+ $output->write("$module: doesn't have any spec file\n");
+ }
+
+ if($#substitutes >= 0) {
+ foreach my $substitute (@substitutes) {
+ my $search = $substitute->{search};
+ my $replace = $substitute->{replace};
+
+ $output->write("$file: unmatched search : '$search'\n");
+ $output->write("$file: unmatched replace: '$replace'\n");
+ }
+ }
+
+ }
+
+ %insert_line = ();
+ %substitute_line = ();
+ %delete_line = ();
+
+ %spec_file = ();
+}
+
+sub delete_line {
+ my $self = shift;
+
+ my $line = shift;
+ my $pattern = shift;
+
+ $delete_line{$line} = $pattern;
+}
+
+sub insert_line {
+ my $self = shift;
+
+ my $line = shift;
+ my $insert = shift;
+
+ $insert_line{$line} = $insert;
+}
+
+sub substitute_line {
+ my $self = shift;
+
+ my $line = shift;
+ my $search = shift;
+ my $replace = shift;
+
+ $substitute_line{$line}{search} = $search;
+ $substitute_line{$line}{replace} = $replace;
+}
+
+sub replace_spec_file {
+ my $self = shift;
+
+ my $module = shift;
+ my $search = shift;
+ my $replace = shift;
+
+ my $substitute = {};
+ $substitute->{search} = $search;
+ $substitute->{replace} = $replace;
+
+ if(!defined($spec_file{$module})) {
+ $spec_file{$module} = [];
+ }
+
+ push @{$spec_file{$module}}, $substitute;
+}
+
+1;
diff --git a/tools/winapi/winapi_fixup_options.pm b/tools/winapi/winapi_fixup_options.pm
index e2a26dd..2acc704 100644
--- a/tools/winapi/winapi_fixup_options.pm
+++ b/tools/winapi/winapi_fixup_options.pm
@@ -28,6 +28,8 @@
"documentation-name" => { default => 1, parent => "documentation", description => "documentation name fixup" },
"documentation-ordinal" => { default => 1, parent => "documentation", description => "documentation ordinal fixup" },
"documentation-wrong" => { default => 1, parent => "documentation", description => "documentation wrong fixup" },
+ "statements" => { default => 1, parent => "local", description => "statements fixup" },
+ "statements-windowsx" => { default => 1, parent => "local", description => "statements windowsx fixup" },
"stub" => { default => 0, parent => "local", description => "stub fixup" },
"global" => { default => 1, description => "global fixup" },
diff --git a/tools/winapi/winapi_fixup_statements.pm b/tools/winapi/winapi_fixup_statements.pm
new file mode 100644
index 0000000..f7706db
--- /dev/null
+++ b/tools/winapi/winapi_fixup_statements.pm
@@ -0,0 +1,198 @@
+package winapi_fixup_statements;
+
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw();
+@EXPORT_OK = qw(&fixup_statements);
+
+use options qw($options);
+use output qw($output);
+
+use c_parser;
+
+sub fixup_function_call {
+ my $name = shift;
+ my @arguments = @{(shift)};;
+
+ return "$name(" . join(", ", @arguments) . ")";
+}
+
+sub _parse_makelong {
+ my $value = shift;
+
+ my $low;
+ my $high;
+ if($value =~ /^
+ (?:\(\w+\)\s*)?
+ MAKE(?:LONG|LPARAM|LRESULT|WPARAM)\s*
+ \(\s*(.*?)\s*,\s*(.*?)\s*\)$/sx)
+ {
+ $low = $1;
+ $high = $2;
+ } elsif($value =~ /^(?:\(\w+\)\s*)?0L?$/) {
+ $low = "0";
+ $high = "0";
+ } else {
+ $low = "($value) & 0xffff";
+ $high = "($value) << 16";
+ }
+
+ return ($low, $high);
+}
+
+sub fixup_function_call_2_forward_wm_call {
+ my $name = shift;
+ (my $hwnd, my $msg, my $wparam, my $lparam) = @{(shift)};
+
+ if($msg =~ /^(?:WM_BEGINDRAG|WM_ENTERMENULOOP|WM_EXITMENULOOP|WM_HELP|
+ WM_ISACTIVEICON|WM_LBTRACKPOINT|WM_NEXTMENU)$/x)
+ {
+ return undef;
+ }
+
+ my $suffix;
+ $name =~ /([AW])?$/;
+ if(defined($1)) {
+ $suffix = $1;
+ } else {
+ $suffix = "";
+ }
+
+ $wparam =~ s/^\(WPARAM\)//;
+ $lparam =~ s/^\(LPARAM\)//;
+
+ my @arguments;
+ if(0) {
+ # Nothing
+ } elsif($msg =~ /^WM_COMMAND$/) {
+ (my $id, my $code_notify) = _parse_makelong($wparam);
+ my $hwndctl = $lparam;
+ @arguments = ($id, $hwndctl, $code_notify);
+ } elsif($msg =~ /^WM_(?:COPY|CUT|PASTE)$/) {
+ @arguments = ();
+ } elsif($msg =~ /^WM_(?:CHARTO|VKEYTO)ITEM$/) {
+ (my $key, my $caret) = _parse_makelong($wparam);
+ my $hwndctl = $lparam;
+ @arguments = ($key, $hwndctl, $caret);
+ } elsif($msg =~ /^WM_(?:COMPARE|DELETE|DRAW|MEASURE)ITEM$/) {
+ @arguments = ($lparam);
+ } elsif($msg =~ s/^WM_GETTEXT$/$&$suffix/) {
+ @arguments = ($wparam, $lparam);
+ } elsif($msg =~ /^WM_INITMENU$/) {
+ my $hmenu = $wparam;
+ @arguments = ($hmenu);
+ } elsif($msg =~ /^WM_INITMENUPOPUP$/) {
+ my $hmenu = $wparam;
+ (my $item, my $system_menu) = _parse_makelong($lparam);
+ @arguments = ($hmenu, $item, $system_menu);
+ } elsif($msg =~ /^WM_MENUCHAR$/) {
+ (my $ch, my $flags) = _parse_makelong($wparam);
+ my $hmenu = $lparam;
+ @arguments = ($ch, $flags, $hmenu);
+ } elsif($msg =~ /^WM_MENUSELECT$/) {
+ (my $item, my $flags) = _parse_makelong($wparam);
+ my $hmenu = $lparam;
+ my $hmenu_popup = "NULL"; # FIXME: Is this really correct?
+ @arguments = ($hmenu, $item, $hmenu_popup, $flags);
+ } elsif($msg =~ s/^WM_(NC)?LBUTTONDBLCLK$/WM_$1LBUTTONDOWN/) {
+ my $double_click = "TRUE";
+ my $key_flags = $wparam;
+ (my $x, my $y) = _parse_makelong($lparam);
+ @arguments = ($double_click, $x, $y, $key_flags);
+ } elsif($msg =~ /^WM_(NC)?LBUTTONDOWN$/) {
+ my $double_click = "FALSE";
+ my $key_flags = $wparam;
+ (my $x, my $y) = _parse_makelong($lparam);
+ @arguments = ($double_click, $x, $y, $key_flags);
+ } elsif($msg =~ /^WM_LBUTTONUP$/) {
+ my $key_flags = $wparam;
+ (my $x, my $y) = _parse_makelong($lparam);
+ @arguments = ($x, $y, $key_flags);
+ } elsif($msg =~ /^WM_SETCURSOR$/) {
+ my $hwnd_cursor = $wparam;
+ (my $code_hit_test, my $msg2) = _parse_makelong($lparam);
+ @arguments = ($hwnd_cursor, $code_hit_test, $msg2);
+ } elsif($msg =~ s/^WM_SETTEXT$/$&$suffix/) {
+ my $text = $lparam;
+ @arguments = ($text);
+ } elsif($msg =~ /^WM_(?:SYS)?KEYDOWN$/) {
+ my $vk = $wparam;
+ (my $repeat, my $flags) = _parse_makelong($lparam);
+ @arguments = ($vk, $repeat, $flags);
+ } else {
+ @arguments = ($wparam, $lparam);
+ }
+ unshift @arguments, $hwnd;
+
+ return "FORWARD_" . $msg . "(" . join(", ", @arguments) . ", $name)";
+}
+
+sub fixup_statements {
+ my $function = shift;
+ my $editor = shift;
+
+ my $linkage = $function->linkage;
+ my $internal_name = $function->internal_name;
+ my $statements_line = $function->statements_line;
+ my $statements = $function->statements;
+
+ if(($linkage eq "extern" && !defined($statements)) ||
+ ($linkage eq "" && !defined($statements)))
+ {
+ return;
+ }
+
+ if($options->statements_windowsx && defined($statements)) {
+ my $found_function_call = sub {
+ my $begin_line = shift;
+ my $begin_column = shift;
+ my $end_line = shift;
+ my $end_column = shift;
+ my $name = shift;
+ my $arguments = shift;
+
+ foreach my $argument (@$arguments) {
+ $argument =~ s/^\s*(.*?)\s*$/$1/;
+ }
+
+ if($options->statements_windowsx &&
+ $name =~ /^(?:DefWindowProc|SendMessage)[AW]$/ &&
+ $$arguments[1] =~ /^WM_\w+$/)
+ {
+ fixup_replace(\&fixup_function_call_2_forward_wm_call, $editor,
+ $begin_line, $begin_column, $end_line, $end_column,
+ $name, $arguments);
+ } elsif(0) {
+ $output->write("$begin_line.$begin_column-$end_line.$end_column: " .
+ "$name(" . join(", ", @$arguments) . ")\n");
+ }
+ };
+ my $line = $statements_line;
+ my $column = 1;
+
+ if(!&c_parser::parse_c_statements(\$statements, \$line, \$column, $found_function_call)) {
+ $output->write("error: can't parse statements\n");
+ }
+ }
+}
+
+sub fixup_replace {
+ my $function = shift;
+ my $editor = shift;
+ my $begin_line = shift;
+ my $begin_column = shift;
+ my $end_line = shift;
+ my $end_column = shift;
+
+ my $replace = &$function(@_);
+
+ if(defined($replace)) {
+ $editor->replace($begin_line, $begin_column, $end_line, $end_column, $replace);
+ }
+}
+
+1;
diff --git a/tools/winapi_check/win32/shell32.api b/tools/winapi_check/win32/shell32.api
index d4afdf2..20ce347 100644
--- a/tools/winapi_check/win32/shell32.api
+++ b/tools/winapi_check/win32/shell32.api
@@ -6,7 +6,6 @@
HANDLE
HBITMAP
HDROP
-HGLOBAL
HMENU
HICON
HINSTANCE
diff --git a/tools/winapi_check/win32/wineps.api b/tools/winapi_check/win32/wineps.api
index 89b4309..6ab1056 100644
--- a/tools/winapi_check/win32/wineps.api
+++ b/tools/winapi_check/win32/wineps.api
@@ -20,19 +20,17 @@
DOCINFOA *
DWORD *
INT *
+LPCVOID
LPDEVMODEA
LPINT
LPLOGFONTW
LPSIZE
+LPVOID
POINT *
RECT *
TEXTMETRICW *
void *
-%ptr # --forbidden
-
-SEGPTR
-
%str
LPCSTR
diff --git a/tools/winapi_check/win32/x11drv.api b/tools/winapi_check/win32/x11drv.api
index 2dfd72c..77363b9 100644
--- a/tools/winapi_check/win32/x11drv.api
+++ b/tools/winapi_check/win32/x11drv.api
@@ -56,10 +56,6 @@
WND *
void *
-%ptr # --forbidden
-
-SEGPTR
-
%str
LPCSTR
diff --git a/tools/winapi_check/winapi_parser.pm b/tools/winapi_check/winapi_parser.pm
index 1e6e4af..3ade82d 100644
--- a/tools/winapi_check/winapi_parser.pm
+++ b/tools/winapi_check/winapi_parser.pm
@@ -30,6 +30,7 @@
my $argument_types;
my $argument_names;
my $argument_documentations;
+ my $statements_line;
my $statements;
$function_begin = sub {
@@ -64,6 +65,7 @@
};
$function_end = sub {
+ $statements_line = shift;
$statements = shift;
my $function = &$function_create_callback();
@@ -90,6 +92,7 @@
if(defined($argument_documentations)) {
$function->argument_documentations([@$argument_documentations]);
}
+ $function->statements_line($statements_line);
$function->statements($statements);
&$function_found_callback($function);
@@ -127,6 +130,7 @@
my %regs_entrypoints;
my @comment_lines = ();
my @comments = ();
+ my $statements_line;
my $statements;
my $level = 0;
my $extern_c = 0;
@@ -163,9 +167,15 @@
}
# remove C comments
- if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) {
+ if(/^(.*?)(\/\*(.*?)\*\/)(.*)$/s) {
+ my @lines = split(/\n/, $2);
push @comment_lines, $.;
- push @comments, $2;
+ push @comments, $2;
+ if($#lines <= 0) {
+ $_ = "$1 $4";
+ } else {
+ $_ = $1 . ("\n" x $#lines) . $4;
+ }
$again = 1;
next;
}
@@ -175,23 +185,25 @@
}
# remove C++ comments
- while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1 }
+ while(s/^(.*?)\/\/.*?$/$1/s) { $again = 1 }
if($again) { next; }
- # remove empty rows
- if(/^\s*$/) { next; }
-
# remove preprocessor directives
- if(s/^\s*\#/\#/m) {
- if(/^\\#.*?\\$/m) {
+ if(s/^\s*\#/\#/s) {
+ if(/^\#.*?\\$/s) {
$lookahead = 1;
next;
- } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
+ } elsif(s/^\#\s*(\w+)((?:\s+(.*?))?\s*)$//s) {
+ my @lines = split(/\n/, $2);
+ if($#lines > 0) {
+ $_ = "\n" x $#lines;
+ }
if(defined($3)) {
&$preprocessor_found_callback($1, $3);
} else {
&$preprocessor_found_callback($1, "");
}
+ $again = 1;
next;
}
}
@@ -282,6 +294,7 @@
$line .= "{";
print "+1: \{$_\n" if $options->debug >= 2;
$level++;
+ $statements .= $line;
} elsif(s/^\}//) {
$_ = $'; $again = 1;
$line .= "}" if $level > 1;
@@ -291,15 +304,14 @@
$extern_c = 0;
$level = 0;
}
- }
-
- if($line !~ /^\s*$/) {
+ $statements .= $line;
+ } else {
$statements .= "$line\n";
}
if($level == 0) {
if($in_function) {
- &$function_end($statements);
+ &$function_end($statements_line, $statements);
$statements = undef;
} elsif($in_type) {
if(/^\s*(?:WINE_PACKED\s+)?((?:\*\s*)?\w+\s*(?:\s*,\s*(?:\*+\s*)?\w+)*\s*);/s) {
@@ -404,8 +416,9 @@
$function_line, $linkage, $return_type, $calling_convention, $name,
\@argument_types,\@argument_names,\@argument_documentations);
if($level == 0) {
- &$function_end(undef);
+ &$function_end(undef, undef);
}
+ $statements_line = $.;
$statements = "";
} elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
my @lines = split(/\n/, $&);
@@ -415,7 +428,7 @@
&$function_begin($documentation_line, $documentation,
$function_line, "", "void", "__asm", $1);
- &$function_end("");
+ &$function_end($., "");
} elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
my @lines = split(/\n/, $&);
my $function_line = $. - scalar(@lines) + 1;
@@ -425,10 +438,10 @@
my @arguments32 = ("HWAVEIN");
&$function_begin($documentation_line, $documentation,
$function_line, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
- &$function_end("");
+ &$function_end($., "");
&$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) {
my @lines = split(/\n/, $&);
my $function_line = $. - scalar(@lines) + 1;
@@ -439,10 +452,10 @@
my @arguments32 = ("HWAVEOUT");
&$function_begin($documentation_line, $documentation,
$function_line, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
- &$function_end("");
+ &$function_end($., "");
&$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) {
my @lines = split(/\n/, $&);
my $function_line = $. - scalar(@lines) + 1;
@@ -454,19 +467,19 @@
my @arguments32 = ("HWAVEOUT", $4);
&$function_begin($documentation_line, $documentation,
$function_line, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
- &$function_end("");
+ &$function_end($., "");
&$function_begin($documentation_line, $documentation,
$function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
- &$function_end("");
+ &$function_end($., "");
} elsif($1 eq 2) {
my @arguments16 = ("UINT16", $4);
my @arguments32 = ("UINT", $4);
&$function_begin($documentation_line, $documentation,
$function_line, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
- &$function_end("");
+ &$function_end($., "");
&$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) {
$_ = $'; $again = 1;
