123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830 |
- #
- # Copyright 1999, 2000, 2001 Patrik Stridvall
- #
- # This library is free software; you can redistribute it and/or
- # modify it under the terms of the GNU Lesser General Public
- # License as published by the Free Software Foundation; either
- # version 2.1 of the License, or (at your option) any later version.
- #
- # This library is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- # Lesser General Public License for more details.
- #
- # You should have received a copy of the GNU Lesser General Public
- # License along with this library; if not, write to the Free Software
- # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
- #
- package c_parser;
- use strict;
- use warnings 'all';
- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
- require Exporter;
- @ISA = qw(Exporter);
- @EXPORT = qw();
- @EXPORT_OK = qw();
- use options qw($options);
- use output qw($output);
- use c_function;
- use c_type;
- # Defined a couple common regexp tidbits
- my $CALL_CONVENTION="__cdecl|__stdcall|" .
- "__RPC_API|__RPC_STUB|__RPC_USER|" .
- "CALLBACK|CDECL|NTAPI|PASCAL|RPC_ENTRY|RPC_VAR_ENTRY|" .
- "SEC_ENTRY|VFWAPI|VFWAPIV|WINGDIPAPI|WMIAPI|WINAPI|WINAPIV|APIENTRY|";
- sub parse_c_function($$$$$);
- sub parse_c_function_call($$$$$$$$);
- sub parse_c_preprocessor($$$$);
- sub parse_c_statements($$$$);
- sub parse_c_tuple($$$$$$$);
- sub parse_c_type($$$$$);
- sub parse_c_typedef($$$$);
- sub parse_c_variable($$$$$$$);
- sub new($$)
- {
- my ($proto, $filename) = @_;
- my $class = ref($proto) || $proto;
- my $self = {FILE => $filename,
- CREATE_FUNCTION => sub { return new c_function; },
- CREATE_TYPE => sub { return new c_type; },
- FOUND_COMMENT => sub { return 1; },
- FOUND_DECLARATION => sub { return 1; },
- FOUND_FUNCTION => sub { return 1; },
- FOUND_FUNCTION_CALL => sub { return 1; },
- FOUND_LINE => sub { return 1; },
- FOUND_PREPROCESSOR => sub { return 1; },
- FOUND_STATEMENT => sub { return 1; },
- FOUND_TYPE => sub { return 1; },
- FOUND_VARIABLE => sub { return 1; }
- };
- bless ($self, $class);
- return $self;
- }
- #
- # Callback setters
- #
- sub set_found_comment_callback($$)
- {
- my ($self, $found_comment) = @_;
- $self->{FOUND_COMMENT} = $found_comment;
- }
- sub set_found_declaration_callback($$)
- {
- my ($self, $found_declaration) = @_;
- $self->{FOUND_DEClARATION} = $found_declaration;
- }
- sub set_found_function_callback($$)
- {
- my ($self, $found_function) = @_;
- $self->{FOUND_FUNCTION} = $found_function;
- }
- sub set_found_function_call_callback($$)
- {
- my ($self, $found_function_call) = @_;
- $self->{FOUND_FUNCTION_CALL} = $found_function_call;
- }
- sub set_found_line_callback($$)
- {
- my ($self, $found_line) = @_;
- $self->{FOUND_LINE} = $found_line;
- }
- sub set_found_preprocessor_callback($$)
- {
- my ($self, $found_preprocessor) = @_;
- $self->{FOUND_PREPROCESSOR} = $found_preprocessor;
- }
- sub set_found_statement_callback($$)
- {
- my ($self, $found_statement) = @_;
- $self->{FOUND_STATEMENT} = $found_statement;
- }
- sub set_found_type_callback($$)
- {
- my ($self, $found_type) = @_;
- $self->{FOUND_TYPE} = $found_type;
- }
- sub set_found_variable_callback($$)
- {
- my ($self, $found_variable) = @_;
- $self->{FOUND_VARIABLE} = $found_variable;
- }
- ########################################################################
- # _format_c_type
- sub _format_c_type($$)
- {
- my ($self, $type) = @_;
- $type =~ s/^\s*(.*?)\s*$/$1/;
- if ($type =~ /^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
- my $return_type = $1;
- my @arguments = split(/\s*,\s*/, $2);
- foreach my $argument (@arguments) {
- if ($argument =~ s/^(\w+(?:\s*\*)*)\s*\w+$/$1/) {
- $argument =~ s/\s+/ /g;
- $argument =~ s/\s*\*\s*/*/g;
- $argument =~ s/(\*+)$/ $1/;
- }
- }
- $type = "$return_type (*)(" . join(", ", @arguments) . ")";
- }
- return $type;
- }
- ########################################################################
- # _parse_c_warning
- #
- # FIXME: Use caller (See man perlfunc)
- sub _parse_c_warning($$$$$$)
- {
- my ($self, $curlines, $line, $column, $context, $message) = @_;
- $message = "warning" if !$message;
- my $current = "";
- if ($curlines) {
- my @lines = split(/\n/, $curlines);
- $current .= $lines[0] . "\n" if $lines[0];
- $current .= $lines[1] . "\n" if $lines[1];
- }
- if($current) {
- $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message: \\\n$current");
- } else {
- $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message\n");
- }
- }
- ########################################################################
- # _parse_c_error
- sub _parse_c_error($$$$$$)
- {
- my ($self, $curlines, $line, $column, $context, $message) = @_;
- $message = "parse error" if !$message;
- # Why did I do this?
- if($output->prefix) {
- # $output->write("\n");
- $output->prefix("");
- }
- $self->_parse_c_warning($curlines, $line, $column, $context, $message);
- exit 1;
- }
- ########################################################################
- # _update_c_position
- sub _update_c_position($$$$)
- {
- my ($self, $source, $refline, $refcolumn) = @_;
- my $line = $$refline;
- my $column = $$refcolumn;
- while ($source)
- {
- if ($source =~ s/^[^\n\t\'\"]*//s)
- {
- $column += length($&);
- }
- if ($source =~ s/^\'//)
- {
- $column++;
- while ($source =~ /^./ && $source !~ s/^\'//)
- {
- $source =~ s/^([^\'\\]*)//s;
- $column += length($1);
- if ($source =~ s/^\\//)
- {
- $column++;
- if ($source =~ s/^(.)//s)
- {
- $column += length($1);
- if ($1 eq "0")
- {
- $source =~ s/^(\d{0,3})//s;
- $column += length($1);
- }
- }
- }
- }
- $column++;
- }
- elsif ($source =~ s/^\"//)
- {
- $column++;
- while ($source =~ /^./ && $source !~ s/^\"//)
- {
- $source =~ s/^([^\"\\]*)//s;
- $column += length($1);
- if ($source =~ s/^\\//)
- {
- $column++;
- if ($source =~ s/^(.)//s)
- {
- $column += length($1);
- if ($1 eq "0")
- {
- $source =~ s/^(\d{0,3})//s;
- $column += length($1);
- }
- }
- }
- }
- $column++;
- }
- elsif ($source =~ s/^\n//)
- {
- $line++;
- $column = 0;
- }
- elsif ($source =~ s/^\t//)
- {
- $column = $column + 8 - $column % 8;
- }
- }
- $$refline = $line;
- $$refcolumn = $column;
- }
- ########################################################################
- # __parse_c_until_one_of
- sub __parse_c_until_one_of($$$$$$$) {
- my $self = shift;
- my $characters = shift;
- my $on_same_level = shift;
- my $refcurrent = shift;
- my $refline = shift;
- my $refcolumn = shift;
- my $match = shift;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- if(!defined($match)) {
- my $blackhole;
- $match = \$blackhole;
- }
- my $level = 0;
- $$match = "";
- while(/^[^$characters]/s || $level > 0) {
- my $submatch = "";
- if ($level > 0) {
- if(s/^[^\(\)\[\]\{\}\n\t\'\"]*//s) {
- $submatch .= $&;
- }
- } elsif ($on_same_level) {
- if(s/^[^$characters\(\)\[\]\{\}\n\t\'\"]*//s) {
- $submatch .= $&;
- }
- } else {
- 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($on_same_level && s/^[\(\[\{]//) {
- $level++;
- $submatch .= $&;
- $$match .= $submatch;
- $column++;
- } elsif($on_same_level && s/^[\)\]\}]//) {
- if ($level > 0) {
- $level--;
-
- $submatch .= $&;
- $$match .= $submatch;
- $column++;
- } else {
- $_ = "$&$_";
- $$match .= $submatch;
- last;
- }
- } 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_until_one_of($$$$$$)
- {
- my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
- return $self->__parse_c_until_one_of($characters, 0, $refcurrent, $refline, $refcolumn, $match);
- }
- sub _parse_c_on_same_level_until_one_of($$$$$$)
- {
- my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
- return $self->__parse_c_until_one_of($characters, 1, $refcurrent, $refline, $refcolumn, $match);
- }
- ########################################################################
- # parse_c_block
- sub parse_c_block($$$$$$$) {
- my $self = shift;
- 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;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- my $statements;
- if(s/^\{//) {
- $column++;
- $statements = "";
- } else {
- return 0;
- }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- my $statements_line = $line;
- my $statements_column = $column;
- my $plevel = 1;
- while($plevel > 0) {
- my $match;
- $self->_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_declaration($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- my $begin_line = $line;
- my $begin_column = $column + 1;
- my $end_line = $begin_line;
- my $end_column = $begin_column;
- $self->_update_c_position($_, \$end_line, \$end_column);
- if(!$self->{FOUND_DECLARATION}($begin_line, $begin_column, $end_line, $end_column, $_)) {
- return 1;
- }
- # Function
- my $function;
- # Variable
- my ($linkage, $type, $name);
- if(s/^WINE_(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- } elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
- if(s/\)//) {
- $column++;
- }
- } elsif(s/^__ASM_STDCALL_FUNC\(\s*(\w+)\s*,\s*\d+\s*,\s*//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
- if(s/\)//) {
- $column++;
- }
- } elsif(s/^(?:DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- my @arguments;
- my @argument_lines;
- my @argument_columns;
- if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
- return 0;
- }
- } elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- } elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- } elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- } elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
- $self->_update_c_position($&, \$line, \$column);
- } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
- $self->_update_c_position($&, \$line, \$column);
- } elsif(s/^(?:__asm__|asm)\s*\(//) {
- $self->_update_c_position($&, \$line, \$column);
- } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
- # Nothing
- } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
- # Nothing
- } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
- if($self->{FOUND_FUNCTION}($function))
- {
- my $statements = $function->statements;
- my $statements_line = $function->statements_line;
- my $statements_column = $function->statements_column;
- if(defined($statements)) {
- if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
- return 0;
- }
- }
- }
- } else {
- $self->_parse_c_error($_, $line, $column, "declaration");
- }
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- return 1;
- }
- sub _parse_c($$$$$$)
- {
- my ($self, $pattern, $refcurrent, $refline, $refcolumn, $refmatch) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- my $match;
- if(s/^(?:$pattern)//s) {
- $self->_update_c_position($&, \$line, \$column);
- $match = $&;
- } else {
- return 0;
- }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- $$refmatch = $match;
- return 1;
- }
- sub parse_c_enum($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- if (!s/^enum\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
- return 0;
- }
- my $_name = $1 || "";
- $self->_update_c_position($&, \$line, \$column);
- my $name = "";
-
- my $match;
- while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
- if ($match) {
- if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
- $self->_parse_c_error($_, $line, $column, "enum");
- }
- my $enum_name = $1;
- my $enum_value = $2 || "";
- # $output->write("enum:$_name:$enum_name:$enum_value\n");
- }
- if ($self->_parse_c(',', \$_, \$line, \$column)) {
- next;
- } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
- # FIXME: Kludge
- my $tuple = "($_)";
- my $tuple_line = $line;
- my $tuple_column = $column - 1;
-
- my @arguments;
- my @argument_lines;
- my @argument_columns;
-
- if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
- \@arguments, \@argument_lines, \@argument_columns))
- {
- $self->_parse_c_error($_, $line, $column, "enum");
- }
-
- # FIXME: Kludge
- if ($#arguments >= 0) {
- $name = $arguments[0];
- }
-
- last;
- } else {
- $self->_parse_c_error($_, $line, $column, "enum");
- }
- }
- $self->_update_c_position($_, \$line, \$column);
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- }
- sub parse_c_expression($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- while($_) {
- if(s/^(.*?)(\w+\s*\()/$2/s) {
- $self->_update_c_position($1, \$line, \$column);
- my $begin_line = $line;
- my $begin_column = $column + 1;
- my $name;
- my @arguments;
- my @argument_lines;
- my @argument_columns;
- if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
- return 0;
- }
- if($self->{FOUND_FUNCTION_CALL}($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))
- {
- $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
- }
- }
- } else {
- $_ = "";
- }
- }
- $self->_update_c_position($_, \$line, \$column);
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- return 1;
- }
- sub parse_c_file($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- my $declaration = "";
- my $declaration_line = $line;
- my $declaration_column = $column;
- my $previous_line = 0;
- my $previous_column = -1;
- my $preprocessor_condition = "";
- my $if = 0;
- my $if0 = 0;
- my $extern_c = 0;
- my $blevel = 1;
- my $plevel = 1;
- while($plevel > 0 || $blevel > 0) {
- my $match;
- $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
- if($line != $previous_line) {
- $self->{FOUND_LINE}($line);
- } else {
- # $self->{FOUND_LINE}("$line.$column");
- }
- $previous_line = $line;
- $previous_column = $column;
- if($match !~ /^\s+$/s && $options->debug) {
- $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
- }
- if(!$declaration && $match =~ s/^\s+//s) {
- $self->_update_c_position($&, \$declaration_line, \$declaration_column);
- }
- if(!$if0) {
- $declaration .= $match;
- # FIXME: Kludge
- if ($declaration =~ s/^extern\s*\"C\"//s) {
- if (s/^\{//) {
- $self->_update_c_position($&, \$line, \$column);
- $declaration = "";
- $declaration_line = $line;
- $declaration_column = $column;
- $extern_c = 1;
- next;
- }
- } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
- if (s/^\}//) {
- $self->_update_c_position($&, \$line, \$column);
- $declaration = "";
- $declaration_line = $line;
- $declaration_column = $column;
-
- $extern_c = 0;
- next;
- }
- } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
- my $prefix = $&;
- if ($plevel > 2 || !s/^\)//) {
- $declaration = "$prefix$declaration";
- } else {
- $plevel--;
- $self->_update_c_position($&, \$line, \$column);
- $declaration .= $&;
- my @arguments;
- my @argument_lines;
- my @argument_columns;
- if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
- \@arguments, \@argument_lines, \@argument_columns))
- {
- $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
- }
- $declaration = "";
- $declaration_line = $line;
- $declaration_column = $column;
-
- next;
- }
- } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
- $self->_update_c_position($&, \$declaration_line, \$declaration_column);
- }
- } else {
- my $blank_lines = 0;
- local $_ = $match;
- while(s/^.*?\n//) { $blank_lines++; }
- if(!$declaration) {
- $declaration_line = $line;
- $declaration_column = $column;
- } else {
- $declaration .= "\n" x $blank_lines;
- }
- }
- if(/^[\#\/]/) {
- my $blank_lines = 0;
- if(s/^\#\s*//) {
- my $preprocessor_line = $line;
- my $preprocessor_column = $column;
- my $preprocessor = $&;
- while(s/^(.*?)\\\s*\n//) {
- $blank_lines++;
- $preprocessor .= "$1\n";
- }
- if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
- $_ = "$2\n$_";
- if(defined($3)) {
- $preprocessor .= "$1$3";
- } else {
- $preprocessor .= $1;
- }
- } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
- if(defined($2)) {
- $_ = "$2\n$_";
- } else {
- $blank_lines++;
- }
- $preprocessor .= $1;
- }
- if($preprocessor =~ /^\#\s*if/) {
- if($preprocessor =~ /^\#\s*if\s*0/) {
- $if0++;
- } elsif($if0 > 0) {
- $if++;
- } else {
- if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
- $preprocessor_condition = "defined(WORD_BIGENDIAN)";
- # $output->write("'$preprocessor_condition':'$declaration'\n")
- } else {
- $preprocessor_condition = "";
- }
- }
- } elsif($preprocessor =~ /^\#\s*else/) {
- if ($preprocessor_condition ne "") {
- $preprocessor_condition =~ "!$preprocessor_condition";
- $preprocessor_condition =~ s/^!!/!/;
- # $output->write("'$preprocessor_condition':'$declaration'\n")
- }
- } elsif($preprocessor =~ /^\#\s*endif/) {
- if($if0 > 0) {
- if($if > 0) {
- $if--;
- } else {
- $if0--;
- }
- } else {
- if ($preprocessor_condition ne "") {
- # $output->write("'$preprocessor_condition':'$declaration'\n");
- $preprocessor_condition = "";
- }
- }
- }
- if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
- return 0;
- }
- }
- if(s/^\/\*.*?\*\///s) {
- $self->{FOUND_COMMENT}($line, $column + 1, $&);
- local $_ = $&;
- while(s/^.*?\n//) {
- $blank_lines++;
- }
- if($_) {
- $column += length($_);
- }
- } elsif(s/^\/\/(.*?)\n//) {
- $self->{FOUND_COMMENT}($line, $column + 1, $&);
- $blank_lines++;
- } elsif(s/^\///) {
- if(!$if0) {
- $declaration .= $&;
- $column++;
- }
- }
- $line += $blank_lines;
- if($blank_lines > 0) {
- $column = 0;
- }
- if(!$declaration) {
- $declaration_line = $line;
- $declaration_column = $column;
- } elsif($blank_lines > 0) {
- $declaration .= "\n" x $blank_lines;
- }
- next;
- }
- $column++;
- if($if0) {
- s/^.//;
- next;
- }
- if(s/^[\(\[]//) {
- $plevel++;
- $declaration .= $&;
- } elsif(s/^\]//) {
- $plevel--;
- $declaration .= $&;
- } elsif(s/^\)//) {
- $plevel--;
- if($plevel <= 0) {
- $self->_parse_c_error($_, $line, $column, "file", ") without (");
- }
- $declaration .= $&;
- if($plevel == 1 && $declaration =~ /^(__ASM_GLOBAL_FUNC|__ASM_STDCALL_FUNC)/) {
- if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
- return 0;
- }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- $declaration = "";
- $declaration_line = $line;
- $declaration_column = $column;
- }
- } elsif(s/^\{//) {
- $blevel++;
- $declaration .= $&;
- } elsif(s/^\}//) {
- $blevel--;
- if($blevel <= 0) {
- $self->_parse_c_error($_, $line, $column, "file", "} without {");
- }
- $declaration .= $&;
- if($declaration =~ /^typedef/s ||
- $declaration =~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)*(?:interface|struct|union)(?:\s+\w+)?\s*\{/s)
- {
- # Nothing
- } elsif($plevel == 1 && $blevel == 1) {
- if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
- return 0;
- }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- $declaration = "";
- $declaration_line = $line;
- $declaration_column = $column;
- } elsif($column == 1 && !$extern_c) {
- $self->_parse_c_warning("", $line, $column, "file", "inner } ends on column 1");
- }
- } elsif(s/^;//) {
- $declaration .= $&;
- if($plevel == 1 && $blevel == 1) {
- $declaration =~ s/\s*;$//;
- if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
- return 0;
- }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- $declaration = "";
- $declaration_line = $line;
- $declaration_column = $column;
- }
- } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
- $plevel = 0;
- $blevel = 0;
- } else {
- $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
- }
- }
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- return 1;
- }
- sub parse_c_function($$$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn, $reffunction) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- my $linkage = "";
- my $calling_convention = "";
- my $return_type;
- my $name;
- my @arguments;
- my @argument_lines;
- my @argument_columns;
- my $statements;
- my $statements_line;
- my $statements_column;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- my $begin_line = $line;
- my $begin_column = $column + 1;
- if($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
- # Nothing
- }
- # $self->_parse_c_warning($_, $line, $column, "function", "");
- my $match;
- while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
- 'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
- 'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
- 'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
- \$_, \$line, \$column, \$match))
- {
- if($match =~ /^(?:extern|static)$/) {
- if(!$linkage) {
- $linkage = $match;
- }
- }
- }
- if($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
- # Nothing
- } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
- # Nothing
- } else {
- if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
- return 0;
- }
- $self->_parse_c('inline|FAR', \$_, \$line, \$column);
- $self->_parse_c($CALL_CONVENTION,
- \$_, \$line, \$column, \$calling_convention);
- # FIXME: ???: Old variant of __attribute((const))
- $self->_parse_c('(?:const|volatile)', \$_, \$line, \$column);
- if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
- return 0;
- }
- my $p = 0;
- if(s/^__P\s*\(//) {
- $self->_update_c_position($&, \$line, \$column);
- $p = 1;
- }
- if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
- return 0;
- }
- if($p) {
- if (s/^\)//) {
- $self->_update_c_position($&, \$line, \$column);
- } else {
- $self->_parse_c_error($_, $line, $column, "function");
- }
- }
- }
- if($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
- # Nothing
- }
- my $kar;
- # FIXME: Implement proper handling of K&R C functions
- $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
- if($kar) {
- $output->write("K&R: $kar\n");
- }
- if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
- return 0;
- }
- my $end_line = $line;
- my $end_column = $column;
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- my $function = $self->{CREATE_FUNCTION}();
- $function->file($self->{FILE});
- $function->begin_line($begin_line);
- $function->begin_column($begin_column);
- $function->end_line($end_line);
- $function->end_column($end_column);
- $function->linkage($linkage);
- $function->return_type($return_type);
- $function->calling_convention($calling_convention);
- $function->name($name);
- # if(defined($argument_types)) {
- # $function->argument_types([@$argument_types]);
- # }
- # if(defined($argument_names)) {
- # $function->argument_names([@$argument_names]);
- # }
- $function->statements_line($statements_line);
- $function->statements_column($statements_column);
- $function->statements($statements);
- $$reffunction = $function;
- return 1;
- }
- sub parse_c_function_call($$$$$$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn, $refname, $refarguments, $refargument_lines, $refargument_columns) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- my $name;
- my @arguments;
- my @argument_lines;
- my @argument_columns;
- if(s/^(\w+)(\s*)(?=\()//s) {
- $self->_update_c_position($&, \$line, \$column);
- $name = $1;
- if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
- return 0;
- }
- } else {
- return 0;
- }
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- $$refname = $name;
- @$refarguments = @arguments;
- @$refargument_lines = @argument_lines;
- @$refargument_columns = @argument_columns;
- return 1;
- }
- sub parse_c_preprocessor($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- my $begin_line = $line;
- my $begin_column = $column + 1;
- if(!$self->{FOUND_PREPROCESSOR}($begin_line, $begin_column, "$_")) {
- return 1;
- }
- if(/^\#\s*define\s*(.*?)$/s) {
- $self->_update_c_position($_, \$line, \$column);
- } elsif(/^\#\s*else/s) {
- $self->_update_c_position($_, \$line, \$column);
- } elsif(/^\#\s*endif/s) {
- $self->_update_c_position($_, \$line, \$column);
- } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
- $self->_update_c_position($_, \$line, \$column);
- } elsif(/^\#\s*include\s+(.*?)$/s) {
- $self->_update_c_position($_, \$line, \$column);
- } elsif(/^\#\s*undef\s+(.*?)$/s) {
- $self->_update_c_position($_, \$line, \$column);
- } else {
- $self->_parse_c_error($_, $line, $column, "preprocessor");
- }
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- return 1;
- }
- sub parse_c_statement($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
- # $output->write("$line.$column: statement: '$_'\n");
- if(/^$/) {
- # Nothing
- } elsif(/^\{/) {
- my $statements;
- my $statements_line;
- my $statements_column;
- if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
- return 0;
- }
- if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
- return 0;
- }
- } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
- $self->_update_c_position($&, \$line, \$column);
- my $name = $1;
- my @arguments;
- my @argument_lines;
- my @argument_columns;
- if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
- return 0;
- }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- if(!$self->parse_c_statement(\$_, \$line, \$column)) {
- return 0;
- }
- $self->_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))
- {
- $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
- }
- } elsif(s/^else//) {
- $self->_update_c_position($&, \$line, \$column);
- if(!$self->parse_c_statement(\$_, \$line, \$column)) {
- return 0;
- }
- } elsif(s/^return//) {
- $self->_update_c_position($&, \$line, \$column);
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- if(!$self->parse_c_expression(\$_, \$line, \$column)) {
- return 0;
- }
- } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
- # Nothing
- } else {
- # $self->_parse_c_error($_, $line, $column, "statement");
- }
- $self->_update_c_position($_, \$line, \$column);
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- return 1;
- }
- sub parse_c_statements($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- # $output->write("$line.$column: statements: '$_'\n");
- my $statement = "";
- my $statement_line = $line;
- my $statement_column = $column;
- my $previous_line = -1;
- my $previous_column = -1;
- my $blevel = 1;
- my $plevel = 1;
- while($plevel > 0 || $blevel > 0) {
- my $match;
- $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
- if($previous_line == $line && $previous_column == $column) {
- $self->_parse_c_error($_, $line, $column, "statements", "no progress");
- }
- $previous_line = $line;
- $previous_column = $column;
- # $output->write("'$match' '$_'\n");
- $statement .= $match;
- $column++;
- if(s/^[\(\[]//) {
- $plevel++;
- $statement .= $&;
- } elsif(s/^[\)\]]//) {
- $plevel--;
- if($plevel <= 0) {
- $self->_parse_c_error($_, $line, $column, "statements");
- }
- $statement .= $&;
- } elsif(s/^\{//) {
- $blevel++;
- $statement .= $&;
- } elsif(s/^\}//) {
- $blevel--;
- $statement .= $&;
- if($blevel == 1) {
- if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
- return 0;
- }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- $statement = "";
- $statement_line = $line;
- $statement_column = $column;
- }
- } elsif(s/^;//) {
- if($plevel == 1 && $blevel == 1) {
- if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
- return 0;
- }
- $self->_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 {
- $self->_parse_c_error($_, $line, $column, "statements");
- }
- }
- $self->_update_c_position($_, \$line, \$column);
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- return 1;
- }
- sub parse_c_struct_union($$$$$$$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn, $refkind, $ref_name, $reffield_type_names, $reffield_names, $refnames) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- my $kind;
- my $_name;
- my @field_type_names = ();
- my @field_names = ();
- my @names = ();
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- if (!s/^(interface|struct|union)(\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+))?\s*\{\s*//s) {
- return 0;
- }
- $kind = $1;
- $_name = $3 || "";
- $self->_update_c_position($&, \$line, \$column);
- my $match;
- while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
- {
- my $field_linkage;
- my $field_type_name;
- my $field_name;
-
- if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
- $field_type_name =~ s/\s+/ /g;
-
- push @field_type_names, $field_type_name;
- push @field_names, $field_name;
- # $output->write("$kind:$_name:$field_type_name:$field_name\n");
- } elsif ($match) {
- $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
- }
-
- if ($self->_parse_c(';', \$_, \$line, \$column)) {
- next;
- } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
- # FIXME: Kludge
- my $tuple = "($_)";
- my $tuple_line = $line;
- my $tuple_column = $column - 1;
-
- my @arguments;
- my @argument_lines;
- my @argument_columns;
-
- if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
- \@arguments, \@argument_lines, \@argument_columns))
- {
- $self->_parse_c_error($_, $line, $column, "$kind");
- }
- foreach my $argument (@arguments) {
- my $name = $argument;
- push @names, $name;
- }
- last;
- } else {
- $self->_parse_c_error($_, $line, $column, "$kind");
- }
- }
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- $$refkind = $kind;
- $$ref_name = $_name;
- @$reffield_type_names = @field_type_names;
- @$reffield_names = @field_names;
- @$refnames = @names;
- return 1;
- }
- sub parse_c_tuple($$$$$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn,
- # FIXME: Should not write directly
- $items, $item_lines, $item_columns) = @_;
- 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;
- $self->_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;
- $self->_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;
- }
- sub parse_c_type($$$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn, $reftype) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- my $type;
- $self->_parse_c("(?:const|volatile)", \$_, \$line, \$column);
- if($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
- # Nothing
- } elsif($self->_parse_c('(?:enum\s+|interface\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
- \$_, \$line, \$column, \$type))
- {
- # Nothing
- } else {
- return 0;
- }
- $type =~ s/\s//g;
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- $$reftype = $type;
- return 1;
- }
- sub parse_c_typedef($$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- if (!$self->_parse_c("typedef", \$_, \$line, \$column)) {
- return 0;
- }
- my ($kind, $name, @field_type_names, @field_names, @names);
- my ($linkage, $type_name);
- if ($self->parse_c_enum(\$_, \$line, \$column))
- {
- # Nothing to do
- }
- elsif ($self->parse_c_struct_union(\$_, \$line, \$column,
- \$kind, \$name, \@field_type_names, \@field_names, \@names))
- {
- my $base_name;
- foreach my $_name (@names)
- {
- if ($_name =~ /^\w+$/)
- {
- $base_name = $_name;
- last;
- }
- }
- $base_name="$kind $name" if (!defined $base_name and defined $name);
- $base_name=$kind if (!defined $base_name);
- foreach my $_name (@names) {
- if ($_name =~ /^\w+$/) {
- my $type = $self->{CREATE_TYPE}();
-
- $type->kind($kind);
- $type->_name($name);
- $type->name($_name);
- $type->field_type_names([@field_type_names]);
- $type->field_names([@field_names]);
- $self->{FOUND_TYPE}($type);
- } elsif ($_name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
- my $type_name = "$base_name $1";
- $_name = $2;
- my $type = $self->{CREATE_TYPE}();
- $type->kind("");
- $type->name($_name);
- $type->field_type_names([$type_name]);
- $type->field_names([""]);
- $self->{FOUND_TYPE}($type);
- } else {
- $self->_parse_c_error($_, $line, $column, "typedef 2");
- }
- }
- }
- elsif ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name))
- {
- $type_name =~ s/\s+/ /g;
-
- if(defined($type_name) && defined($name)) {
- my $type = $self->{CREATE_TYPE}();
-
- if (length($name) == 0) {
- $self->_parse_c_error($_, $line, $column, "typedef");
- }
- $type->kind("");
- $type->name($name);
- $type->field_type_names([$type_name]);
- $type->field_names([""]);
-
- $self->{FOUND_TYPE}($type);
- }
- } else {
- $self->_parse_c_error($_, $line, $column, "typedef");
- }
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- return 1;
- }
- sub parse_c_variable($$$$$$$)
- {
- my ($self, $refcurrent, $refline, $refcolumn, $reflinkage, $reftype, $refname) = @_;
- local $_ = $$refcurrent;
- my $line = $$refline;
- my $column = $$refcolumn;
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- my $begin_line = $line;
- my $begin_column = $column + 1;
- my $linkage = "";
- my $sign = "";
- my $type = "";
- my $name = "";
- # $self->_parse_c_warning($_, $line, $column, "variable");
- my $match;
- while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
- 'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
- 'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
- 'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
- \$_, \$line, \$column, \$match))
- {
- if ($match =~ /^(?:extern|static)$/) {
- if (!$linkage) {
- $linkage = $match;
- } else {
- $self->_parse_c_warning($_, $line, $column, "repeated linkage (ignored): $match");
- }
- } elsif ($match =~ /^(?:signed|unsigned)$/) {
- if (!$sign) {
- $sign = "$match ";
- } else {
- $self->_parse_c_warning($_, $line, $column, "repeated sign (ignored): $match");
- }
- }
- }
- return 0 if(/^$/);
- finished: while (1)
- {
- if (s/^(enum\s+|interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
- my $kind = $1;
- my $_name = $2;
- $self->_update_c_position($&, \$line, \$column);
- if(defined($_name)) {
- $type = "$kind $_name { }";
- } else {
- $type = "$kind { }";
- }
- last finished;
- } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s+DECLSPEC_ALIGN\(.*?\)|\s*(?:const\s*|volatile\s*)?\*)*)\s*(\w+)\s*(\[.*?\]$|:\s*(\d+)$|\{)?//s) {
- $type = "$sign$1";
- $name = $2;
- if (defined($3)) {
- my $bits = $4;
- local $_ = $3;
- if (/^\[/) {
- $type .= $_;
- } elsif (/^:/) {
- $type .= ":$bits";
- } elsif (/^\{/) {
- # Nothing
- }
- }
- $type = $self->_format_c_type($type);
- last finished;
- } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*)\s*:\s*(\d+)$//s) {
- $type = "$sign$1:$2";
- $name = "";
- $type = $self->_format_c_type($type);
- last finished;
- } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*\s*\(\s*(?:$CALL_CONVENTION)?(?:\s+DECLSPEC_[A-Z]+)?(?:\s*\*)*)\s*(\w+)\s*(\)\s*\(.*?\))$//s) {
- $type = $self->_format_c_type("$sign$1$3");
- $name = $2;
- last finished;
- } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
- $type = $match;
- last finished;
- } else {
- $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
- last finished;
- }
- if($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
- $type = $match;
- last finished;
- } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
- \$_, \$line, \$column, \$match))
- {
- $type = $match;
- last finished;
- } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
- $type = $match;
- last finished;
- } elsif(s/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
- my $kind = $1;
- my $_name = $2;
- $self->_update_c_position($&, \$line, \$column);
- if(defined($_name)) {
- $type = "struct $_name { }";
- } else {
- $type = "struct { }";
- }
- } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
- $type = $&;
- $type =~ s/\s//g;
- } else {
- return 0;
- }
- # $output->write("*** $type: '$_'\n");
- # $self->_parse_c_warning($_, $line, $column, "variable2", "");
- if(s/^WINAPI\s*//) {
- $self->_update_c_position($&, \$line, \$column);
- }
- if(s/^(\((?:$CALL_CONVENTION)?\s*\*?\s*(?:$CALL_CONVENTION)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
- $self->_update_c_position($&, \$line, \$column);
- $name = $1;
- $name =~ s/\s//g;
- $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
- if(s/^\)//) { $column++; }
- $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
- if(!s/^(?:=\s*|,\s*|$)//) {
- return 0;
- }
- } elsif(s/^(?:\*\s*)*(?:const\s+|volatile\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
- $self->_update_c_position($&, \$line, \$column);
- $name = $1;
- $name =~ s/\s//g;
- } elsif(/^$/) {
- $name = "";
- } else {
- return 0;
- }
- last finished;
- }
- # $output->write("$type: $name: '$_'\n");
- $$refcurrent = $_;
- $$refline = $line;
- $$refcolumn = $column;
- $$reflinkage = $linkage;
- $$reftype = $type;
- $$refname = $name;
- $self->{FOUND_VARIABLE}($begin_line, $begin_column, $linkage, $type, $name);
- return 1;
- }
- 1;
|