c_parser.pm 45 KB

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