c_parser.pm 46 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830
  1. #
  2. # Copyright 1999, 2000, 2001 Patrik Stridvall
  3. #
  4. # This library is free software; you can redistribute it and/or
  5. # modify it under the terms of the GNU Lesser General Public
  6. # License as published by the Free Software Foundation; either
  7. # version 2.1 of the License, or (at your option) any later version.
  8. #
  9. # This library is distributed in the hope that it will be useful,
  10. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12. # Lesser General Public License for more details.
  13. #
  14. # You should have received a copy of the GNU Lesser General Public
  15. # License along with this library; if not, write to the Free Software
  16. # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17. #
  18. package c_parser;
  19. use strict;
  20. use warnings 'all';
  21. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  22. require Exporter;
  23. @ISA = qw(Exporter);
  24. @EXPORT = qw();
  25. @EXPORT_OK = qw();
  26. use options qw($options);
  27. use output qw($output);
  28. use c_function;
  29. use c_type;
  30. # Defined a couple common regexp tidbits
  31. my $CALL_CONVENTION="__cdecl|__stdcall|" .
  32. "__RPC_API|__RPC_STUB|__RPC_USER|" .
  33. "CALLBACK|CDECL|NTAPI|PASCAL|RPC_ENTRY|RPC_VAR_ENTRY|" .
  34. "SEC_ENTRY|VFWAPI|VFWAPIV|WINGDIPAPI|WMIAPI|WINAPI|WINAPIV|APIENTRY|";
  35. sub parse_c_function($$$$$);
  36. sub parse_c_function_call($$$$$$$$);
  37. sub parse_c_preprocessor($$$$);
  38. sub parse_c_statements($$$$);
  39. sub parse_c_tuple($$$$$$$);
  40. sub parse_c_type($$$$$);
  41. sub parse_c_typedef($$$$);
  42. sub parse_c_variable($$$$$$$);
  43. sub new($$)
  44. {
  45. my ($proto, $filename) = @_;
  46. my $class = ref($proto) || $proto;
  47. my $self = {FILE => $filename,
  48. CREATE_FUNCTION => sub { return new c_function; },
  49. CREATE_TYPE => sub { return new c_type; },
  50. FOUND_COMMENT => sub { return 1; },
  51. FOUND_DECLARATION => sub { return 1; },
  52. FOUND_FUNCTION => sub { return 1; },
  53. FOUND_FUNCTION_CALL => sub { return 1; },
  54. FOUND_LINE => sub { return 1; },
  55. FOUND_PREPROCESSOR => sub { return 1; },
  56. FOUND_STATEMENT => sub { return 1; },
  57. FOUND_TYPE => sub { return 1; },
  58. FOUND_VARIABLE => sub { return 1; }
  59. };
  60. bless ($self, $class);
  61. return $self;
  62. }
  63. #
  64. # Callback setters
  65. #
  66. sub set_found_comment_callback($$)
  67. {
  68. my ($self, $found_comment) = @_;
  69. $self->{FOUND_COMMENT} = $found_comment;
  70. }
  71. sub set_found_declaration_callback($$)
  72. {
  73. my ($self, $found_declaration) = @_;
  74. $self->{FOUND_DEClARATION} = $found_declaration;
  75. }
  76. sub set_found_function_callback($$)
  77. {
  78. my ($self, $found_function) = @_;
  79. $self->{FOUND_FUNCTION} = $found_function;
  80. }
  81. sub set_found_function_call_callback($$)
  82. {
  83. my ($self, $found_function_call) = @_;
  84. $self->{FOUND_FUNCTION_CALL} = $found_function_call;
  85. }
  86. sub set_found_line_callback($$)
  87. {
  88. my ($self, $found_line) = @_;
  89. $self->{FOUND_LINE} = $found_line;
  90. }
  91. sub set_found_preprocessor_callback($$)
  92. {
  93. my ($self, $found_preprocessor) = @_;
  94. $self->{FOUND_PREPROCESSOR} = $found_preprocessor;
  95. }
  96. sub set_found_statement_callback($$)
  97. {
  98. my ($self, $found_statement) = @_;
  99. $self->{FOUND_STATEMENT} = $found_statement;
  100. }
  101. sub set_found_type_callback($$)
  102. {
  103. my ($self, $found_type) = @_;
  104. $self->{FOUND_TYPE} = $found_type;
  105. }
  106. sub set_found_variable_callback($$)
  107. {
  108. my ($self, $found_variable) = @_;
  109. $self->{FOUND_VARIABLE} = $found_variable;
  110. }
  111. ########################################################################
  112. # _format_c_type
  113. sub _format_c_type($$)
  114. {
  115. my ($self, $type) = @_;
  116. $type =~ s/^\s*(.*?)\s*$/$1/;
  117. if ($type =~ /^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
  118. my $return_type = $1;
  119. my @arguments = split(/\s*,\s*/, $2);
  120. foreach my $argument (@arguments) {
  121. if ($argument =~ s/^(\w+(?:\s*\*)*)\s*\w+$/$1/) {
  122. $argument =~ s/\s+/ /g;
  123. $argument =~ s/\s*\*\s*/*/g;
  124. $argument =~ s/(\*+)$/ $1/;
  125. }
  126. }
  127. $type = "$return_type (*)(" . join(", ", @arguments) . ")";
  128. }
  129. return $type;
  130. }
  131. ########################################################################
  132. # _parse_c_warning
  133. #
  134. # FIXME: Use caller (See man perlfunc)
  135. sub _parse_c_warning($$$$$$)
  136. {
  137. my ($self, $curlines, $line, $column, $context, $message) = @_;
  138. $message = "warning" if !$message;
  139. my $current = "";
  140. if ($curlines) {
  141. my @lines = split(/\n/, $curlines);
  142. $current .= $lines[0] . "\n" if $lines[0];
  143. $current .= $lines[1] . "\n" if $lines[1];
  144. }
  145. if($current) {
  146. $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message: \\\n$current");
  147. } else {
  148. $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message\n");
  149. }
  150. }
  151. ########################################################################
  152. # _parse_c_error
  153. sub _parse_c_error($$$$$$)
  154. {
  155. my ($self, $curlines, $line, $column, $context, $message) = @_;
  156. $message = "parse error" if !$message;
  157. # Why did I do this?
  158. if($output->prefix) {
  159. # $output->write("\n");
  160. $output->prefix("");
  161. }
  162. $self->_parse_c_warning($curlines, $line, $column, $context, $message);
  163. exit 1;
  164. }
  165. ########################################################################
  166. # _update_c_position
  167. sub _update_c_position($$$$)
  168. {
  169. my ($self, $source, $refline, $refcolumn) = @_;
  170. my $line = $$refline;
  171. my $column = $$refcolumn;
  172. while ($source)
  173. {
  174. if ($source =~ s/^[^\n\t\'\"]*//s)
  175. {
  176. $column += length($&);
  177. }
  178. if ($source =~ s/^\'//)
  179. {
  180. $column++;
  181. while ($source =~ /^./ && $source !~ s/^\'//)
  182. {
  183. $source =~ s/^([^\'\\]*)//s;
  184. $column += length($1);
  185. if ($source =~ s/^\\//)
  186. {
  187. $column++;
  188. if ($source =~ s/^(.)//s)
  189. {
  190. $column += length($1);
  191. if ($1 eq "0")
  192. {
  193. $source =~ s/^(\d{0,3})//s;
  194. $column += length($1);
  195. }
  196. }
  197. }
  198. }
  199. $column++;
  200. }
  201. elsif ($source =~ s/^\"//)
  202. {
  203. $column++;
  204. while ($source =~ /^./ && $source !~ s/^\"//)
  205. {
  206. $source =~ s/^([^\"\\]*)//s;
  207. $column += length($1);
  208. if ($source =~ s/^\\//)
  209. {
  210. $column++;
  211. if ($source =~ s/^(.)//s)
  212. {
  213. $column += length($1);
  214. if ($1 eq "0")
  215. {
  216. $source =~ s/^(\d{0,3})//s;
  217. $column += length($1);
  218. }
  219. }
  220. }
  221. }
  222. $column++;
  223. }
  224. elsif ($source =~ s/^\n//)
  225. {
  226. $line++;
  227. $column = 0;
  228. }
  229. elsif ($source =~ s/^\t//)
  230. {
  231. $column = $column + 8 - $column % 8;
  232. }
  233. }
  234. $$refline = $line;
  235. $$refcolumn = $column;
  236. }
  237. ########################################################################
  238. # __parse_c_until_one_of
  239. sub __parse_c_until_one_of($$$$$$$) {
  240. my $self = shift;
  241. my $characters = shift;
  242. my $on_same_level = shift;
  243. my $refcurrent = shift;
  244. my $refline = shift;
  245. my $refcolumn = shift;
  246. my $match = shift;
  247. local $_ = $$refcurrent;
  248. my $line = $$refline;
  249. my $column = $$refcolumn;
  250. if(!defined($match)) {
  251. my $blackhole;
  252. $match = \$blackhole;
  253. }
  254. my $level = 0;
  255. $$match = "";
  256. while(/^[^$characters]/s || $level > 0) {
  257. my $submatch = "";
  258. if ($level > 0) {
  259. if(s/^[^\(\)\[\]\{\}\n\t\'\"]*//s) {
  260. $submatch .= $&;
  261. }
  262. } elsif ($on_same_level) {
  263. if(s/^[^$characters\(\)\[\]\{\}\n\t\'\"]*//s) {
  264. $submatch .= $&;
  265. }
  266. } else {
  267. if(s/^[^$characters\n\t\'\"]*//s) {
  268. $submatch .= $&;
  269. }
  270. }
  271. if(s/^\'//) {
  272. $submatch .= "\'";
  273. while(/^./ && !s/^\'//) {
  274. s/^([^\'\\]*)//s;
  275. $submatch .= $1;
  276. if(s/^\\//) {
  277. $submatch .= "\\";
  278. if(s/^(.)//s) {
  279. $submatch .= $1;
  280. if($1 eq "0") {
  281. s/^(\d{0,3})//s;
  282. $submatch .= $1;
  283. }
  284. }
  285. }
  286. }
  287. $submatch .= "\'";
  288. $$match .= $submatch;
  289. $column += length($submatch);
  290. } elsif(s/^\"//) {
  291. $submatch .= "\"";
  292. while(/^./ && !s/^\"//) {
  293. s/^([^\"\\]*)//s;
  294. $submatch .= $1;
  295. if(s/^\\//) {
  296. $submatch .= "\\";
  297. if(s/^(.)//s) {
  298. $submatch .= $1;
  299. if($1 eq "0") {
  300. s/^(\d{0,3})//s;
  301. $submatch .= $1;
  302. }
  303. }
  304. }
  305. }
  306. $submatch .= "\"";
  307. $$match .= $submatch;
  308. $column += length($submatch);
  309. } elsif($on_same_level && s/^[\(\[\{]//) {
  310. $level++;
  311. $submatch .= $&;
  312. $$match .= $submatch;
  313. $column++;
  314. } elsif($on_same_level && s/^[\)\]\}]//) {
  315. if ($level > 0) {
  316. $level--;
  317. $submatch .= $&;
  318. $$match .= $submatch;
  319. $column++;
  320. } else {
  321. $_ = "$&$_";
  322. $$match .= $submatch;
  323. last;
  324. }
  325. } elsif(s/^\n//) {
  326. $submatch .= "\n";
  327. $$match .= $submatch;
  328. $line++;
  329. $column = 0;
  330. } elsif(s/^\t//) {
  331. $submatch .= "\t";
  332. $$match .= $submatch;
  333. $column = $column + 8 - $column % 8;
  334. } else {
  335. $$match .= $submatch;
  336. $column += length($submatch);
  337. }
  338. }
  339. $$refcurrent = $_;
  340. $$refline = $line;
  341. $$refcolumn = $column;
  342. return 1;
  343. }
  344. sub _parse_c_until_one_of($$$$$$)
  345. {
  346. my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
  347. return $self->__parse_c_until_one_of($characters, 0, $refcurrent, $refline, $refcolumn, $match);
  348. }
  349. sub _parse_c_on_same_level_until_one_of($$$$$$)
  350. {
  351. my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
  352. return $self->__parse_c_until_one_of($characters, 1, $refcurrent, $refline, $refcolumn, $match);
  353. }
  354. ########################################################################
  355. # parse_c_block
  356. sub parse_c_block($$$$$$$) {
  357. my $self = shift;
  358. my $refcurrent = shift;
  359. my $refline = shift;
  360. my $refcolumn = shift;
  361. my $refstatements = shift;
  362. my $refstatements_line = shift;
  363. my $refstatements_column = shift;
  364. local $_ = $$refcurrent;
  365. my $line = $$refline;
  366. my $column = $$refcolumn;
  367. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  368. my $statements;
  369. if(s/^\{//) {
  370. $column++;
  371. $statements = "";
  372. } else {
  373. return 0;
  374. }
  375. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  376. my $statements_line = $line;
  377. my $statements_column = $column;
  378. my $plevel = 1;
  379. while($plevel > 0) {
  380. my $match;
  381. $self->_parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
  382. $column++;
  383. $statements .= $match;
  384. if(s/^\}//) {
  385. $plevel--;
  386. if($plevel > 0) {
  387. $statements .= "}";
  388. }
  389. } elsif(s/^\{//) {
  390. $plevel++;
  391. $statements .= "{";
  392. } else {
  393. return 0;
  394. }
  395. }
  396. $$refcurrent = $_;
  397. $$refline = $line;
  398. $$refcolumn = $column;
  399. $$refstatements = $statements;
  400. $$refstatements_line = $statements_line;
  401. $$refstatements_column = $statements_column;
  402. return 1;
  403. }
  404. sub parse_c_declaration($$$$)
  405. {
  406. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  407. local $_ = $$refcurrent;
  408. my $line = $$refline;
  409. my $column = $$refcolumn;
  410. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  411. my $begin_line = $line;
  412. my $begin_column = $column + 1;
  413. my $end_line = $begin_line;
  414. my $end_column = $begin_column;
  415. $self->_update_c_position($_, \$end_line, \$end_column);
  416. if(!$self->{FOUND_DECLARATION}($begin_line, $begin_column, $end_line, $end_column, $_)) {
  417. return 1;
  418. }
  419. # Function
  420. my $function;
  421. # Variable
  422. my ($linkage, $type, $name);
  423. if(s/^WINE_(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
  424. $self->_update_c_position($&, \$line, \$column);
  425. } elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
  426. $self->_update_c_position($&, \$line, \$column);
  427. $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
  428. if(s/\)//) {
  429. $column++;
  430. }
  431. } elsif(s/^__ASM_STDCALL_FUNC\(\s*(\w+)\s*,\s*\d+\s*,\s*//s) { # FIXME: Wine specific kludge
  432. $self->_update_c_position($&, \$line, \$column);
  433. $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
  434. if(s/\)//) {
  435. $column++;
  436. }
  437. } elsif(s/^(?:DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
  438. $self->_update_c_position($&, \$line, \$column);
  439. my @arguments;
  440. my @argument_lines;
  441. my @argument_columns;
  442. if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
  443. return 0;
  444. }
  445. } elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
  446. $self->_update_c_position($&, \$line, \$column);
  447. } elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
  448. $self->_update_c_position($&, \$line, \$column);
  449. } elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
  450. $self->_update_c_position($&, \$line, \$column);
  451. } elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
  452. $self->_update_c_position($&, \$line, \$column);
  453. } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
  454. $self->_update_c_position($&, \$line, \$column);
  455. } elsif(s/^(?:__asm__|asm)\s*\(//) {
  456. $self->_update_c_position($&, \$line, \$column);
  457. } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
  458. # Nothing
  459. } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
  460. # Nothing
  461. } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
  462. if($self->{FOUND_FUNCTION}($function))
  463. {
  464. my $statements = $function->statements;
  465. my $statements_line = $function->statements_line;
  466. my $statements_column = $function->statements_column;
  467. if(defined($statements)) {
  468. if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
  469. return 0;
  470. }
  471. }
  472. }
  473. } else {
  474. $self->_parse_c_error($_, $line, $column, "declaration");
  475. }
  476. $$refcurrent = $_;
  477. $$refline = $line;
  478. $$refcolumn = $column;
  479. return 1;
  480. }
  481. sub _parse_c($$$$$$)
  482. {
  483. my ($self, $pattern, $refcurrent, $refline, $refcolumn, $refmatch) = @_;
  484. local $_ = $$refcurrent;
  485. my $line = $$refline;
  486. my $column = $$refcolumn;
  487. my $match;
  488. if(s/^(?:$pattern)//s) {
  489. $self->_update_c_position($&, \$line, \$column);
  490. $match = $&;
  491. } else {
  492. return 0;
  493. }
  494. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  495. $$refcurrent = $_;
  496. $$refline = $line;
  497. $$refcolumn = $column;
  498. $$refmatch = $match;
  499. return 1;
  500. }
  501. sub parse_c_enum($$$$)
  502. {
  503. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  504. local $_ = $$refcurrent;
  505. my $line = $$refline;
  506. my $column = $$refcolumn;
  507. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  508. if (!s/^enum\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
  509. return 0;
  510. }
  511. my $_name = $1 || "";
  512. $self->_update_c_position($&, \$line, \$column);
  513. my $name = "";
  514. my $match;
  515. while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
  516. if ($match) {
  517. if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
  518. $self->_parse_c_error($_, $line, $column, "enum");
  519. }
  520. my $enum_name = $1;
  521. my $enum_value = $2 || "";
  522. # $output->write("enum:$_name:$enum_name:$enum_value\n");
  523. }
  524. if ($self->_parse_c(',', \$_, \$line, \$column)) {
  525. next;
  526. } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
  527. # FIXME: Kludge
  528. my $tuple = "($_)";
  529. my $tuple_line = $line;
  530. my $tuple_column = $column - 1;
  531. my @arguments;
  532. my @argument_lines;
  533. my @argument_columns;
  534. if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
  535. \@arguments, \@argument_lines, \@argument_columns))
  536. {
  537. $self->_parse_c_error($_, $line, $column, "enum");
  538. }
  539. # FIXME: Kludge
  540. if ($#arguments >= 0) {
  541. $name = $arguments[0];
  542. }
  543. last;
  544. } else {
  545. $self->_parse_c_error($_, $line, $column, "enum");
  546. }
  547. }
  548. $self->_update_c_position($_, \$line, \$column);
  549. $$refcurrent = $_;
  550. $$refline = $line;
  551. $$refcolumn = $column;
  552. }
  553. sub parse_c_expression($$$$)
  554. {
  555. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  556. local $_ = $$refcurrent;
  557. my $line = $$refline;
  558. my $column = $$refcolumn;
  559. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  560. while($_) {
  561. if(s/^(.*?)(\w+\s*\()/$2/s) {
  562. $self->_update_c_position($1, \$line, \$column);
  563. my $begin_line = $line;
  564. my $begin_column = $column + 1;
  565. my $name;
  566. my @arguments;
  567. my @argument_lines;
  568. my @argument_columns;
  569. if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
  570. return 0;
  571. }
  572. if($self->{FOUND_FUNCTION_CALL}($begin_line, $begin_column, $line, $column, $name, \@arguments))
  573. {
  574. while(defined(my $argument = shift @arguments) &&
  575. defined(my $argument_line = shift @argument_lines) &&
  576. defined(my $argument_column = shift @argument_columns))
  577. {
  578. $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
  579. }
  580. }
  581. } else {
  582. $_ = "";
  583. }
  584. }
  585. $self->_update_c_position($_, \$line, \$column);
  586. $$refcurrent = $_;
  587. $$refline = $line;
  588. $$refcolumn = $column;
  589. return 1;
  590. }
  591. sub parse_c_file($$$$)
  592. {
  593. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  594. local $_ = $$refcurrent;
  595. my $line = $$refline;
  596. my $column = $$refcolumn;
  597. my $declaration = "";
  598. my $declaration_line = $line;
  599. my $declaration_column = $column;
  600. my $previous_line = 0;
  601. my $previous_column = -1;
  602. my $preprocessor_condition = "";
  603. my $if = 0;
  604. my $if0 = 0;
  605. my $extern_c = 0;
  606. my $blevel = 1;
  607. my $plevel = 1;
  608. while($plevel > 0 || $blevel > 0) {
  609. my $match;
  610. $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
  611. if($line != $previous_line) {
  612. $self->{FOUND_LINE}($line);
  613. } else {
  614. # $self->{FOUND_LINE}("$line.$column");
  615. }
  616. $previous_line = $line;
  617. $previous_column = $column;
  618. if($match !~ /^\s+$/s && $options->debug) {
  619. $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
  620. }
  621. if(!$declaration && $match =~ s/^\s+//s) {
  622. $self->_update_c_position($&, \$declaration_line, \$declaration_column);
  623. }
  624. if(!$if0) {
  625. $declaration .= $match;
  626. # FIXME: Kludge
  627. if ($declaration =~ s/^extern\s*\"C\"//s) {
  628. if (s/^\{//) {
  629. $self->_update_c_position($&, \$line, \$column);
  630. $declaration = "";
  631. $declaration_line = $line;
  632. $declaration_column = $column;
  633. $extern_c = 1;
  634. next;
  635. }
  636. } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
  637. if (s/^\}//) {
  638. $self->_update_c_position($&, \$line, \$column);
  639. $declaration = "";
  640. $declaration_line = $line;
  641. $declaration_column = $column;
  642. $extern_c = 0;
  643. next;
  644. }
  645. } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
  646. my $prefix = $&;
  647. if ($plevel > 2 || !s/^\)//) {
  648. $declaration = "$prefix$declaration";
  649. } else {
  650. $plevel--;
  651. $self->_update_c_position($&, \$line, \$column);
  652. $declaration .= $&;
  653. my @arguments;
  654. my @argument_lines;
  655. my @argument_columns;
  656. if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
  657. \@arguments, \@argument_lines, \@argument_columns))
  658. {
  659. $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
  660. }
  661. $declaration = "";
  662. $declaration_line = $line;
  663. $declaration_column = $column;
  664. next;
  665. }
  666. } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
  667. $self->_update_c_position($&, \$declaration_line, \$declaration_column);
  668. }
  669. } else {
  670. my $blank_lines = 0;
  671. local $_ = $match;
  672. while(s/^.*?\n//) { $blank_lines++; }
  673. if(!$declaration) {
  674. $declaration_line = $line;
  675. $declaration_column = $column;
  676. } else {
  677. $declaration .= "\n" x $blank_lines;
  678. }
  679. }
  680. if(/^[\#\/]/) {
  681. my $blank_lines = 0;
  682. if(s/^\#\s*//) {
  683. my $preprocessor_line = $line;
  684. my $preprocessor_column = $column;
  685. my $preprocessor = $&;
  686. while(s/^(.*?)\\\s*\n//) {
  687. $blank_lines++;
  688. $preprocessor .= "$1\n";
  689. }
  690. if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
  691. $_ = "$2\n$_";
  692. if(defined($3)) {
  693. $preprocessor .= "$1$3";
  694. } else {
  695. $preprocessor .= $1;
  696. }
  697. } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
  698. if(defined($2)) {
  699. $_ = "$2\n$_";
  700. } else {
  701. $blank_lines++;
  702. }
  703. $preprocessor .= $1;
  704. }
  705. if($preprocessor =~ /^\#\s*if/) {
  706. if($preprocessor =~ /^\#\s*if\s*0/) {
  707. $if0++;
  708. } elsif($if0 > 0) {
  709. $if++;
  710. } else {
  711. if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
  712. $preprocessor_condition = "defined(WORD_BIGENDIAN)";
  713. # $output->write("'$preprocessor_condition':'$declaration'\n")
  714. } else {
  715. $preprocessor_condition = "";
  716. }
  717. }
  718. } elsif($preprocessor =~ /^\#\s*else/) {
  719. if ($preprocessor_condition ne "") {
  720. $preprocessor_condition =~ "!$preprocessor_condition";
  721. $preprocessor_condition =~ s/^!!/!/;
  722. # $output->write("'$preprocessor_condition':'$declaration'\n")
  723. }
  724. } elsif($preprocessor =~ /^\#\s*endif/) {
  725. if($if0 > 0) {
  726. if($if > 0) {
  727. $if--;
  728. } else {
  729. $if0--;
  730. }
  731. } else {
  732. if ($preprocessor_condition ne "") {
  733. # $output->write("'$preprocessor_condition':'$declaration'\n");
  734. $preprocessor_condition = "";
  735. }
  736. }
  737. }
  738. if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
  739. return 0;
  740. }
  741. }
  742. if(s/^\/\*.*?\*\///s) {
  743. $self->{FOUND_COMMENT}($line, $column + 1, $&);
  744. local $_ = $&;
  745. while(s/^.*?\n//) {
  746. $blank_lines++;
  747. }
  748. if($_) {
  749. $column += length($_);
  750. }
  751. } elsif(s/^\/\/(.*?)\n//) {
  752. $self->{FOUND_COMMENT}($line, $column + 1, $&);
  753. $blank_lines++;
  754. } elsif(s/^\///) {
  755. if(!$if0) {
  756. $declaration .= $&;
  757. $column++;
  758. }
  759. }
  760. $line += $blank_lines;
  761. if($blank_lines > 0) {
  762. $column = 0;
  763. }
  764. if(!$declaration) {
  765. $declaration_line = $line;
  766. $declaration_column = $column;
  767. } elsif($blank_lines > 0) {
  768. $declaration .= "\n" x $blank_lines;
  769. }
  770. next;
  771. }
  772. $column++;
  773. if($if0) {
  774. s/^.//;
  775. next;
  776. }
  777. if(s/^[\(\[]//) {
  778. $plevel++;
  779. $declaration .= $&;
  780. } elsif(s/^\]//) {
  781. $plevel--;
  782. $declaration .= $&;
  783. } elsif(s/^\)//) {
  784. $plevel--;
  785. if($plevel <= 0) {
  786. $self->_parse_c_error($_, $line, $column, "file", ") without (");
  787. }
  788. $declaration .= $&;
  789. if($plevel == 1 && $declaration =~ /^(__ASM_GLOBAL_FUNC|__ASM_STDCALL_FUNC)/) {
  790. if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
  791. return 0;
  792. }
  793. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  794. $declaration = "";
  795. $declaration_line = $line;
  796. $declaration_column = $column;
  797. }
  798. } elsif(s/^\{//) {
  799. $blevel++;
  800. $declaration .= $&;
  801. } elsif(s/^\}//) {
  802. $blevel--;
  803. if($blevel <= 0) {
  804. $self->_parse_c_error($_, $line, $column, "file", "} without {");
  805. }
  806. $declaration .= $&;
  807. if($declaration =~ /^typedef/s ||
  808. $declaration =~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)*(?:interface|struct|union)(?:\s+\w+)?\s*\{/s)
  809. {
  810. # Nothing
  811. } elsif($plevel == 1 && $blevel == 1) {
  812. if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
  813. return 0;
  814. }
  815. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  816. $declaration = "";
  817. $declaration_line = $line;
  818. $declaration_column = $column;
  819. } elsif($column == 1 && !$extern_c) {
  820. $self->_parse_c_warning("", $line, $column, "file", "inner } ends on column 1");
  821. }
  822. } elsif(s/^;//) {
  823. $declaration .= $&;
  824. if($plevel == 1 && $blevel == 1) {
  825. $declaration =~ s/\s*;$//;
  826. if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
  827. return 0;
  828. }
  829. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  830. $declaration = "";
  831. $declaration_line = $line;
  832. $declaration_column = $column;
  833. }
  834. } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
  835. $plevel = 0;
  836. $blevel = 0;
  837. } else {
  838. $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
  839. }
  840. }
  841. $$refcurrent = $_;
  842. $$refline = $line;
  843. $$refcolumn = $column;
  844. return 1;
  845. }
  846. sub parse_c_function($$$$$)
  847. {
  848. my ($self, $refcurrent, $refline, $refcolumn, $reffunction) = @_;
  849. local $_ = $$refcurrent;
  850. my $line = $$refline;
  851. my $column = $$refcolumn;
  852. my $linkage = "";
  853. my $calling_convention = "";
  854. my $return_type;
  855. my $name;
  856. my @arguments;
  857. my @argument_lines;
  858. my @argument_columns;
  859. my $statements;
  860. my $statements_line;
  861. my $statements_column;
  862. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  863. my $begin_line = $line;
  864. my $begin_column = $column + 1;
  865. if($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
  866. # Nothing
  867. }
  868. # $self->_parse_c_warning($_, $line, $column, "function", "");
  869. my $match;
  870. while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
  871. 'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
  872. 'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
  873. 'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
  874. \$_, \$line, \$column, \$match))
  875. {
  876. if($match =~ /^(?:extern|static)$/) {
  877. if(!$linkage) {
  878. $linkage = $match;
  879. }
  880. }
  881. }
  882. if($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
  883. # Nothing
  884. } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
  885. # Nothing
  886. } else {
  887. if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
  888. return 0;
  889. }
  890. $self->_parse_c('inline|FAR', \$_, \$line, \$column);
  891. $self->_parse_c($CALL_CONVENTION,
  892. \$_, \$line, \$column, \$calling_convention);
  893. # FIXME: ???: Old variant of __attribute((const))
  894. $self->_parse_c('(?:const|volatile)', \$_, \$line, \$column);
  895. if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
  896. return 0;
  897. }
  898. my $p = 0;
  899. if(s/^__P\s*\(//) {
  900. $self->_update_c_position($&, \$line, \$column);
  901. $p = 1;
  902. }
  903. if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
  904. return 0;
  905. }
  906. if($p) {
  907. if (s/^\)//) {
  908. $self->_update_c_position($&, \$line, \$column);
  909. } else {
  910. $self->_parse_c_error($_, $line, $column, "function");
  911. }
  912. }
  913. }
  914. if($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
  915. # Nothing
  916. }
  917. my $kar;
  918. # FIXME: Implement proper handling of K&R C functions
  919. $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
  920. if($kar) {
  921. $output->write("K&R: $kar\n");
  922. }
  923. if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
  924. return 0;
  925. }
  926. my $end_line = $line;
  927. my $end_column = $column;
  928. $$refcurrent = $_;
  929. $$refline = $line;
  930. $$refcolumn = $column;
  931. my $function = $self->{CREATE_FUNCTION}();
  932. $function->file($self->{FILE});
  933. $function->begin_line($begin_line);
  934. $function->begin_column($begin_column);
  935. $function->end_line($end_line);
  936. $function->end_column($end_column);
  937. $function->linkage($linkage);
  938. $function->return_type($return_type);
  939. $function->calling_convention($calling_convention);
  940. $function->name($name);
  941. # if(defined($argument_types)) {
  942. # $function->argument_types([@$argument_types]);
  943. # }
  944. # if(defined($argument_names)) {
  945. # $function->argument_names([@$argument_names]);
  946. # }
  947. $function->statements_line($statements_line);
  948. $function->statements_column($statements_column);
  949. $function->statements($statements);
  950. $$reffunction = $function;
  951. return 1;
  952. }
  953. sub parse_c_function_call($$$$$$$$)
  954. {
  955. my ($self, $refcurrent, $refline, $refcolumn, $refname, $refarguments, $refargument_lines, $refargument_columns) = @_;
  956. local $_ = $$refcurrent;
  957. my $line = $$refline;
  958. my $column = $$refcolumn;
  959. my $name;
  960. my @arguments;
  961. my @argument_lines;
  962. my @argument_columns;
  963. if(s/^(\w+)(\s*)(?=\()//s) {
  964. $self->_update_c_position($&, \$line, \$column);
  965. $name = $1;
  966. if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
  967. return 0;
  968. }
  969. } else {
  970. return 0;
  971. }
  972. $$refcurrent = $_;
  973. $$refline = $line;
  974. $$refcolumn = $column;
  975. $$refname = $name;
  976. @$refarguments = @arguments;
  977. @$refargument_lines = @argument_lines;
  978. @$refargument_columns = @argument_columns;
  979. return 1;
  980. }
  981. sub parse_c_preprocessor($$$$)
  982. {
  983. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  984. local $_ = $$refcurrent;
  985. my $line = $$refline;
  986. my $column = $$refcolumn;
  987. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  988. my $begin_line = $line;
  989. my $begin_column = $column + 1;
  990. if(!$self->{FOUND_PREPROCESSOR}($begin_line, $begin_column, "$_")) {
  991. return 1;
  992. }
  993. if(/^\#\s*define\s*(.*?)$/s) {
  994. $self->_update_c_position($_, \$line, \$column);
  995. } elsif(/^\#\s*else/s) {
  996. $self->_update_c_position($_, \$line, \$column);
  997. } elsif(/^\#\s*endif/s) {
  998. $self->_update_c_position($_, \$line, \$column);
  999. } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
  1000. $self->_update_c_position($_, \$line, \$column);
  1001. } elsif(/^\#\s*include\s+(.*?)$/s) {
  1002. $self->_update_c_position($_, \$line, \$column);
  1003. } elsif(/^\#\s*undef\s+(.*?)$/s) {
  1004. $self->_update_c_position($_, \$line, \$column);
  1005. } else {
  1006. $self->_parse_c_error($_, $line, $column, "preprocessor");
  1007. }
  1008. $$refcurrent = $_;
  1009. $$refline = $line;
  1010. $$refcolumn = $column;
  1011. return 1;
  1012. }
  1013. sub parse_c_statement($$$$)
  1014. {
  1015. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  1016. local $_ = $$refcurrent;
  1017. my $line = $$refline;
  1018. my $column = $$refcolumn;
  1019. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1020. $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
  1021. # $output->write("$line.$column: statement: '$_'\n");
  1022. if(/^$/) {
  1023. # Nothing
  1024. } elsif(/^\{/) {
  1025. my $statements;
  1026. my $statements_line;
  1027. my $statements_column;
  1028. if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
  1029. return 0;
  1030. }
  1031. if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
  1032. return 0;
  1033. }
  1034. } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
  1035. $self->_update_c_position($&, \$line, \$column);
  1036. my $name = $1;
  1037. my @arguments;
  1038. my @argument_lines;
  1039. my @argument_columns;
  1040. if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
  1041. return 0;
  1042. }
  1043. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1044. if(!$self->parse_c_statement(\$_, \$line, \$column)) {
  1045. return 0;
  1046. }
  1047. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1048. while(defined(my $argument = shift @arguments) &&
  1049. defined(my $argument_line = shift @argument_lines) &&
  1050. defined(my $argument_column = shift @argument_columns))
  1051. {
  1052. $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
  1053. }
  1054. } elsif(s/^else//) {
  1055. $self->_update_c_position($&, \$line, \$column);
  1056. if(!$self->parse_c_statement(\$_, \$line, \$column)) {
  1057. return 0;
  1058. }
  1059. } elsif(s/^return//) {
  1060. $self->_update_c_position($&, \$line, \$column);
  1061. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1062. if(!$self->parse_c_expression(\$_, \$line, \$column)) {
  1063. return 0;
  1064. }
  1065. } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
  1066. # Nothing
  1067. } else {
  1068. # $self->_parse_c_error($_, $line, $column, "statement");
  1069. }
  1070. $self->_update_c_position($_, \$line, \$column);
  1071. $$refcurrent = $_;
  1072. $$refline = $line;
  1073. $$refcolumn = $column;
  1074. return 1;
  1075. }
  1076. sub parse_c_statements($$$$)
  1077. {
  1078. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  1079. local $_ = $$refcurrent;
  1080. my $line = $$refline;
  1081. my $column = $$refcolumn;
  1082. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1083. # $output->write("$line.$column: statements: '$_'\n");
  1084. my $statement = "";
  1085. my $statement_line = $line;
  1086. my $statement_column = $column;
  1087. my $previous_line = -1;
  1088. my $previous_column = -1;
  1089. my $blevel = 1;
  1090. my $plevel = 1;
  1091. while($plevel > 0 || $blevel > 0) {
  1092. my $match;
  1093. $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
  1094. if($previous_line == $line && $previous_column == $column) {
  1095. $self->_parse_c_error($_, $line, $column, "statements", "no progress");
  1096. }
  1097. $previous_line = $line;
  1098. $previous_column = $column;
  1099. # $output->write("'$match' '$_'\n");
  1100. $statement .= $match;
  1101. $column++;
  1102. if(s/^[\(\[]//) {
  1103. $plevel++;
  1104. $statement .= $&;
  1105. } elsif(s/^[\)\]]//) {
  1106. $plevel--;
  1107. if($plevel <= 0) {
  1108. $self->_parse_c_error($_, $line, $column, "statements");
  1109. }
  1110. $statement .= $&;
  1111. } elsif(s/^\{//) {
  1112. $blevel++;
  1113. $statement .= $&;
  1114. } elsif(s/^\}//) {
  1115. $blevel--;
  1116. $statement .= $&;
  1117. if($blevel == 1) {
  1118. if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
  1119. return 0;
  1120. }
  1121. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1122. $statement = "";
  1123. $statement_line = $line;
  1124. $statement_column = $column;
  1125. }
  1126. } elsif(s/^;//) {
  1127. if($plevel == 1 && $blevel == 1) {
  1128. if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
  1129. return 0;
  1130. }
  1131. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1132. $statement = "";
  1133. $statement_line = $line;
  1134. $statement_column = $column;
  1135. } else {
  1136. $statement .= $&;
  1137. }
  1138. } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
  1139. $plevel = 0;
  1140. $blevel = 0;
  1141. } else {
  1142. $self->_parse_c_error($_, $line, $column, "statements");
  1143. }
  1144. }
  1145. $self->_update_c_position($_, \$line, \$column);
  1146. $$refcurrent = $_;
  1147. $$refline = $line;
  1148. $$refcolumn = $column;
  1149. return 1;
  1150. }
  1151. sub parse_c_struct_union($$$$$$$$$)
  1152. {
  1153. my ($self, $refcurrent, $refline, $refcolumn, $refkind, $ref_name, $reffield_type_names, $reffield_names, $refnames) = @_;
  1154. local $_ = $$refcurrent;
  1155. my $line = $$refline;
  1156. my $column = $$refcolumn;
  1157. my $kind;
  1158. my $_name;
  1159. my @field_type_names = ();
  1160. my @field_names = ();
  1161. my @names = ();
  1162. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1163. if (!s/^(interface|struct|union)(\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+))?\s*\{\s*//s) {
  1164. return 0;
  1165. }
  1166. $kind = $1;
  1167. $_name = $3 || "";
  1168. $self->_update_c_position($&, \$line, \$column);
  1169. my $match;
  1170. while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
  1171. {
  1172. my $field_linkage;
  1173. my $field_type_name;
  1174. my $field_name;
  1175. if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
  1176. $field_type_name =~ s/\s+/ /g;
  1177. push @field_type_names, $field_type_name;
  1178. push @field_names, $field_name;
  1179. # $output->write("$kind:$_name:$field_type_name:$field_name\n");
  1180. } elsif ($match) {
  1181. $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
  1182. }
  1183. if ($self->_parse_c(';', \$_, \$line, \$column)) {
  1184. next;
  1185. } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
  1186. # FIXME: Kludge
  1187. my $tuple = "($_)";
  1188. my $tuple_line = $line;
  1189. my $tuple_column = $column - 1;
  1190. my @arguments;
  1191. my @argument_lines;
  1192. my @argument_columns;
  1193. if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
  1194. \@arguments, \@argument_lines, \@argument_columns))
  1195. {
  1196. $self->_parse_c_error($_, $line, $column, "$kind");
  1197. }
  1198. foreach my $argument (@arguments) {
  1199. my $name = $argument;
  1200. push @names, $name;
  1201. }
  1202. last;
  1203. } else {
  1204. $self->_parse_c_error($_, $line, $column, "$kind");
  1205. }
  1206. }
  1207. $$refcurrent = $_;
  1208. $$refline = $line;
  1209. $$refcolumn = $column;
  1210. $$refkind = $kind;
  1211. $$ref_name = $_name;
  1212. @$reffield_type_names = @field_type_names;
  1213. @$reffield_names = @field_names;
  1214. @$refnames = @names;
  1215. return 1;
  1216. }
  1217. sub parse_c_tuple($$$$$$$)
  1218. {
  1219. my ($self, $refcurrent, $refline, $refcolumn,
  1220. # FIXME: Should not write directly
  1221. $items, $item_lines, $item_columns) = @_;
  1222. local $_ = $$refcurrent;
  1223. my $line = $$refline;
  1224. my $column = $$refcolumn;
  1225. my $item;
  1226. if(s/^\(//) {
  1227. $column++;
  1228. $item = "";
  1229. } else {
  1230. return 0;
  1231. }
  1232. my $item_line = $line;
  1233. my $item_column = $column + 1;
  1234. my $plevel = 1;
  1235. while($plevel > 0) {
  1236. my $match;
  1237. $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
  1238. $column++;
  1239. $item .= $match;
  1240. if(s/^\)//) {
  1241. $plevel--;
  1242. if($plevel == 0) {
  1243. push @$item_lines, $item_line;
  1244. push @$item_columns, $item_column;
  1245. push @$items, $item;
  1246. $item = "";
  1247. } else {
  1248. $item .= ")";
  1249. }
  1250. } elsif(s/^\(//) {
  1251. $plevel++;
  1252. $item .= "(";
  1253. } elsif(s/^,//) {
  1254. if($plevel == 1) {
  1255. push @$item_lines, $item_line;
  1256. push @$item_columns, $item_column;
  1257. push @$items, $item;
  1258. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1259. $item_line = $line;
  1260. $item_column = $column + 1;
  1261. $item = "";
  1262. } else {
  1263. $item .= ",";
  1264. }
  1265. } else {
  1266. return 0;
  1267. }
  1268. }
  1269. $$refcurrent = $_;
  1270. $$refline = $line;
  1271. $$refcolumn = $column;
  1272. return 1;
  1273. }
  1274. sub parse_c_type($$$$$)
  1275. {
  1276. my ($self, $refcurrent, $refline, $refcolumn, $reftype) = @_;
  1277. local $_ = $$refcurrent;
  1278. my $line = $$refline;
  1279. my $column = $$refcolumn;
  1280. my $type;
  1281. $self->_parse_c("(?:const|volatile)", \$_, \$line, \$column);
  1282. if($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
  1283. # Nothing
  1284. } elsif($self->_parse_c('(?:enum\s+|interface\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
  1285. \$_, \$line, \$column, \$type))
  1286. {
  1287. # Nothing
  1288. } else {
  1289. return 0;
  1290. }
  1291. $type =~ s/\s//g;
  1292. $$refcurrent = $_;
  1293. $$refline = $line;
  1294. $$refcolumn = $column;
  1295. $$reftype = $type;
  1296. return 1;
  1297. }
  1298. sub parse_c_typedef($$$$)
  1299. {
  1300. my ($self, $refcurrent, $refline, $refcolumn) = @_;
  1301. local $_ = $$refcurrent;
  1302. my $line = $$refline;
  1303. my $column = $$refcolumn;
  1304. if (!$self->_parse_c("typedef", \$_, \$line, \$column)) {
  1305. return 0;
  1306. }
  1307. my ($kind, $name, @field_type_names, @field_names, @names);
  1308. my ($linkage, $type_name);
  1309. if ($self->parse_c_enum(\$_, \$line, \$column))
  1310. {
  1311. # Nothing to do
  1312. }
  1313. elsif ($self->parse_c_struct_union(\$_, \$line, \$column,
  1314. \$kind, \$name, \@field_type_names, \@field_names, \@names))
  1315. {
  1316. my $base_name;
  1317. foreach my $_name (@names)
  1318. {
  1319. if ($_name =~ /^\w+$/)
  1320. {
  1321. $base_name = $_name;
  1322. last;
  1323. }
  1324. }
  1325. $base_name="$kind $name" if (!defined $base_name and defined $name);
  1326. $base_name=$kind if (!defined $base_name);
  1327. foreach my $_name (@names) {
  1328. if ($_name =~ /^\w+$/) {
  1329. my $type = $self->{CREATE_TYPE}();
  1330. $type->kind($kind);
  1331. $type->_name($name);
  1332. $type->name($_name);
  1333. $type->field_type_names([@field_type_names]);
  1334. $type->field_names([@field_names]);
  1335. $self->{FOUND_TYPE}($type);
  1336. } elsif ($_name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
  1337. my $type_name = "$base_name $1";
  1338. $_name = $2;
  1339. my $type = $self->{CREATE_TYPE}();
  1340. $type->kind("");
  1341. $type->name($_name);
  1342. $type->field_type_names([$type_name]);
  1343. $type->field_names([""]);
  1344. $self->{FOUND_TYPE}($type);
  1345. } else {
  1346. $self->_parse_c_error($_, $line, $column, "typedef 2");
  1347. }
  1348. }
  1349. }
  1350. elsif ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name))
  1351. {
  1352. $type_name =~ s/\s+/ /g;
  1353. if(defined($type_name) && defined($name)) {
  1354. my $type = $self->{CREATE_TYPE}();
  1355. if (length($name) == 0) {
  1356. $self->_parse_c_error($_, $line, $column, "typedef");
  1357. }
  1358. $type->kind("");
  1359. $type->name($name);
  1360. $type->field_type_names([$type_name]);
  1361. $type->field_names([""]);
  1362. $self->{FOUND_TYPE}($type);
  1363. }
  1364. } else {
  1365. $self->_parse_c_error($_, $line, $column, "typedef");
  1366. }
  1367. $$refcurrent = $_;
  1368. $$refline = $line;
  1369. $$refcolumn = $column;
  1370. return 1;
  1371. }
  1372. sub parse_c_variable($$$$$$$)
  1373. {
  1374. my ($self, $refcurrent, $refline, $refcolumn, $reflinkage, $reftype, $refname) = @_;
  1375. local $_ = $$refcurrent;
  1376. my $line = $$refline;
  1377. my $column = $$refcolumn;
  1378. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1379. my $begin_line = $line;
  1380. my $begin_column = $column + 1;
  1381. my $linkage = "";
  1382. my $sign = "";
  1383. my $type = "";
  1384. my $name = "";
  1385. # $self->_parse_c_warning($_, $line, $column, "variable");
  1386. my $match;
  1387. while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
  1388. 'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
  1389. 'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
  1390. 'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
  1391. \$_, \$line, \$column, \$match))
  1392. {
  1393. if ($match =~ /^(?:extern|static)$/) {
  1394. if (!$linkage) {
  1395. $linkage = $match;
  1396. } else {
  1397. $self->_parse_c_warning($_, $line, $column, "repeated linkage (ignored): $match");
  1398. }
  1399. } elsif ($match =~ /^(?:signed|unsigned)$/) {
  1400. if (!$sign) {
  1401. $sign = "$match ";
  1402. } else {
  1403. $self->_parse_c_warning($_, $line, $column, "repeated sign (ignored): $match");
  1404. }
  1405. }
  1406. }
  1407. return 0 if(/^$/);
  1408. finished: while (1)
  1409. {
  1410. if (s/^(enum\s+|interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
  1411. my $kind = $1;
  1412. my $_name = $2;
  1413. $self->_update_c_position($&, \$line, \$column);
  1414. if(defined($_name)) {
  1415. $type = "$kind $_name { }";
  1416. } else {
  1417. $type = "$kind { }";
  1418. }
  1419. last finished;
  1420. } 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) {
  1421. $type = "$sign$1";
  1422. $name = $2;
  1423. if (defined($3)) {
  1424. my $bits = $4;
  1425. local $_ = $3;
  1426. if (/^\[/) {
  1427. $type .= $_;
  1428. } elsif (/^:/) {
  1429. $type .= ":$bits";
  1430. } elsif (/^\{/) {
  1431. # Nothing
  1432. }
  1433. }
  1434. $type = $self->_format_c_type($type);
  1435. last finished;
  1436. } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*)\s*:\s*(\d+)$//s) {
  1437. $type = "$sign$1:$2";
  1438. $name = "";
  1439. $type = $self->_format_c_type($type);
  1440. last finished;
  1441. } 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) {
  1442. $type = $self->_format_c_type("$sign$1$3");
  1443. $name = $2;
  1444. last finished;
  1445. } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
  1446. $type = $match;
  1447. last finished;
  1448. } else {
  1449. $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
  1450. last finished;
  1451. }
  1452. if($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
  1453. $type = $match;
  1454. last finished;
  1455. } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
  1456. \$_, \$line, \$column, \$match))
  1457. {
  1458. $type = $match;
  1459. last finished;
  1460. } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
  1461. $type = $match;
  1462. last finished;
  1463. } elsif(s/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
  1464. my $kind = $1;
  1465. my $_name = $2;
  1466. $self->_update_c_position($&, \$line, \$column);
  1467. if(defined($_name)) {
  1468. $type = "struct $_name { }";
  1469. } else {
  1470. $type = "struct { }";
  1471. }
  1472. } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
  1473. $type = $&;
  1474. $type =~ s/\s//g;
  1475. } else {
  1476. return 0;
  1477. }
  1478. # $output->write("*** $type: '$_'\n");
  1479. # $self->_parse_c_warning($_, $line, $column, "variable2", "");
  1480. if(s/^WINAPI\s*//) {
  1481. $self->_update_c_position($&, \$line, \$column);
  1482. }
  1483. if(s/^(\((?:$CALL_CONVENTION)?\s*\*?\s*(?:$CALL_CONVENTION)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
  1484. $self->_update_c_position($&, \$line, \$column);
  1485. $name = $1;
  1486. $name =~ s/\s//g;
  1487. $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
  1488. if(s/^\)//) { $column++; }
  1489. $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
  1490. if(!s/^(?:=\s*|,\s*|$)//) {
  1491. return 0;
  1492. }
  1493. } elsif(s/^(?:\*\s*)*(?:const\s+|volatile\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
  1494. $self->_update_c_position($&, \$line, \$column);
  1495. $name = $1;
  1496. $name =~ s/\s//g;
  1497. } elsif(/^$/) {
  1498. $name = "";
  1499. } else {
  1500. return 0;
  1501. }
  1502. last finished;
  1503. }
  1504. # $output->write("$type: $name: '$_'\n");
  1505. $$refcurrent = $_;
  1506. $$refline = $line;
  1507. $$refcolumn = $column;
  1508. $$reflinkage = $linkage;
  1509. $$reftype = $type;
  1510. $$refname = $name;
  1511. $self->{FOUND_VARIABLE}($begin_line, $begin_column, $linkage, $type, $name);
  1512. return 1;
  1513. }
  1514. 1;