git.oblomov.eu Git - wine/blob - tools/winapi/c_parser.pm

   1 package c_parser;
   2
   3 use strict;
   4
   5 use options qw($options);
   6 use output qw($output);
   7
   8 sub _update_c_position {
   9     local $_ = shift;
  10     my $refline = shift;
  11     my $refcolumn = shift;
  12
  13     my $line = $$refline;
  14     my $column = $$refcolumn;
  15
  16     while($_) {
  17         if(s/^[^\n\t\'\"]*//s) {
  18             $column += length($&);
  19         }
  20
  21         if(s/^\'//) {
  22             $column++;
  23             while(/^./ && !s/^\'//) {
  24                 s/^([^\'\\]*)//s;
  25                 $column += length($1);
  26                 if(s/^\\//) {
  27                     $column++;
  28                     if(s/^(.)//s) {
  29                         $column += length($1);
  30                         if($1 eq "0") {
  31                             s/^(\d{0,3})//s;
  32                             $column += length($1);
  33                         }
  34                     }
  35                 }
  36             }
  37             $column++;
  38         } elsif(s/^\"//) {
  39             $column++;
  40             while(/^./ && !s/^\"//) {
  41                 s/^([^\"\\]*)//s;
  42                 $column += length($1);
  43                 if(s/^\\//) {
  44                     $column++;
  45                     if(s/^(.)//s) {
  46                         $column += length($1);
  47                         if($1 eq "0") {
  48                             s/^(\d{0,3})//s;
  49                             $column += length($1);
  50                         }
  51                     }
  52                 }
  53             }
  54             $column++;
  55         } elsif(s/^\n//) {
  56             $line++;
  57             $column = 0;
  58         } elsif(s/^\t//) {
  59             $column = $column + 8 - $column % 8;
  60         }
  61     }
  62
  63     $$refline = $line;
  64     $$refcolumn = $column;
  65 }
  66
  67 sub parse_c {
  68     my $pattern = shift;
  69     my $refcurrent = shift;
  70     my $refline = shift;
  71     my $refcolumn = shift;
  72
  73     local $_ = $$refcurrent;
  74     my $line = $$refline;
  75     my $column = $$refcolumn;
  76
  77     if(s/$pattern//) {
  78         _update_c_position($&, \$line, \$column);
  79     } else {
  80         return 0;
  81     }
  82
  83     $$refcurrent = $_;
  84     $$refline = $line;
  85     $$refcolumn = $column;
  86
  87     return 1;
  88 }
  89
  90 sub parse_c_until_one_of {
  91     my $characters = shift;
  92     my $refcurrent = shift;
  93     my $refline = shift;
  94     my $refcolumn = shift;
  95     my $match = shift;
  96
  97     local $_ = $$refcurrent;
  98     my $line = $$refline;
  99     my $column = $$refcolumn;
 100
 101     if(!defined($line) || !defined($column)) {
 102         $output->write("error: \$characters = '$characters' \$_ = '$_'\n");
 103         exit 1;
 104     }
 105
 106     if(!defined($match)) {
 107         my $blackhole;
 108         $match = \$blackhole;
 109     }
 110
 111     $$match = "";
 112     while(/^[^$characters]/s) {
 113         my $submatch = "";
 114
 115         if(s/^[^$characters\n\t\'\"]*//s) {
 116             $submatch .= $&;
 117         }
 118
 119         if(s/^\'//) {
 120             $submatch .= "\'";
 121             while(/^./ && !s/^\'//) {
 122                 s/^([^\'\\]*)//s;
 123                 $submatch .= $1;
 124                 if(s/^\\//) {
 125                     $submatch .= "\\";
 126                     if(s/^(.)//s) {
 127                         $submatch .= $1;
 128                         if($1 eq "0") {
 129                             s/^(\d{0,3})//s;
 130                             $submatch .= $1;
 131                         }
 132                     }
 133                 }
 134             }
 135             $submatch .= "\'";
 136
 137             $$match .= $submatch;
 138             $column += length($submatch);
 139         } elsif(s/^\"//) {
 140             $submatch .= "\"";
 141             while(/^./ && !s/^\"//) {
 142                 s/^([^\"\\]*)//s;
 143                 $submatch .= $1;
 144                 if(s/^\\//) {
 145                     $submatch .= "\\";
 146                     if(s/^(.)//s) {
 147                         $submatch .= $1;
 148                         if($1 eq "0") {
 149                             s/^(\d{0,3})//s;
 150                             $submatch .= $1;
 151                         }
 152                     }
 153                 }
 154             }
 155             $submatch .= "\"";
 156
 157             $$match .= $submatch;
 158             $column += length($submatch);
 159         } elsif(s/^\n//) {
 160             $submatch .= "\n";
 161
 162             $$match .= $submatch;
 163             $line++;
 164             $column = 0;
 165         } elsif(s/^\t//) {
 166             $submatch .= "\t";
 167
 168             $$match .= $submatch;
 169             $column = $column + 8 - $column % 8;
 170         } else {
 171             $$match .= $submatch;
 172             $column += length($submatch);
 173         }
 174     }
 175
 176     $$refcurrent = $_;
 177     $$refline = $line;
 178     $$refcolumn = $column;
 179     return 1;
 180 }
 181
 182 sub parse_c_block {
 183     my $refcurrent = shift;
 184     my $refline = shift;
 185     my $refcolumn = shift;
 186     my $refstatements = shift;
 187     my $refstatements_line = shift;
 188     my $refstatements_column = shift;
 189
 190     local $_ = $$refcurrent;
 191     my $line = $$refline;
 192     my $column = $$refcolumn;
 193
 194     my $statements;
 195     if(s/^\{//) {
 196         $column++;
 197         $statements = "";
 198     } else {
 199         return 0;
 200     }
 201
 202     parse_c_until_one_of("\\S", \$_, \$line, \$column);
 203
 204     my $statements_line = $line;
 205     my $statements_column = $column;
 206
 207     my $plevel = 1;
 208     while($plevel > 0) {
 209         my $match;
 210         parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
 211
 212         $column++;
 213
 214         $statements .= $match;
 215         if(s/^\}//) {
 216             $plevel--;
 217             if($plevel > 0) {
 218                 $statements .= "}";
 219             }
 220         } elsif(s/^\{//) {
 221             $plevel++;
 222             $statements .= "{";
 223         } else {
 224             return 0;
 225         }
 226     }
 227
 228     $$refcurrent = $_;
 229     $$refline = $line;
 230     $$refcolumn = $column;
 231     $$refstatements = $statements;
 232     $$refstatements_line = $statements_line;
 233     $$refstatements_column = $statements_column;
 234
 235     return 1;
 236 }
 237
 238 sub parse_c_expression {
 239     my $refcurrent = shift;
 240     my $refline = shift;
 241     my $refcolumn = shift;
 242     my $found_function_call_callback = shift;
 243
 244     my $line = $$refline;
 245     my $column = $$refcolumn;
 246
 247     local $_ = $$refcurrent;
 248
 249     parse_c_until_one_of("\\S", \$_, \$line, \$column);
 250
 251     if(s/^(.*?)(\w+)(\s*)\(//s) {
 252         my $begin_line = $line;
 253         my $begin_column = $column + length($1) + 1;
 254
 255         $line = $begin_line;
 256         $column = $begin_column + length("$2$3") - 1;
 257
 258         my $name = $2;
 259
 260         $_ = "($'";
 261
 262         # $output->write("$name: $line.$column: '$_'\n");
 263
 264         my @arguments;
 265         my @argument_lines;
 266         my @argument_columns;
 267         if(!parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 268             return 0;
 269         }
 270
 271         if($name =~ /^sizeof$/) {
 272             # Nothing
 273         } else {
 274             &$found_function_call_callback($begin_line, $begin_column, $line, $column,
 275                                            $name, \@arguments);
 276         }
 277
 278         while(defined(my $argument = shift @arguments) &&
 279               defined(my $argument_line = shift @argument_lines) &&
 280               defined(my $argument_column = shift @argument_columns))
 281         {
 282             parse_c_expression(\$argument, \$argument_line, \$argument_column, $found_function_call_callback);
 283         }
 284     } elsif(s/^return//) {
 285         $column += length($&);
 286         parse_c_until_one_of("\\S", \$_, \$line, \$column);
 287         if(!parse_c_expression(\$_, \$line, \$column, $found_function_call_callback)) {
 288             return 0;
 289         }
 290     } else {
 291         return 0;
 292     }
 293
 294     _update_c_position($_, \$line, \$column);
 295
 296     $$refcurrent = $_;
 297     $$refline = $line;
 298     $$refcolumn = $column;
 299
 300     return 1;
 301 }
 302
 303 sub parse_c_statement {
 304     my $refcurrent = shift;
 305     my $refline = shift;
 306     my $refcolumn = shift;
 307     my $found_function_call_callback = shift;
 308
 309     my $line = $$refline;
 310     my $column = $$refcolumn;
 311
 312     local $_ = $$refcurrent;
 313
 314     parse_c_until_one_of("\\S", \$_, \$line, \$column);
 315
 316     if(s/^(?:case\s+)?(\w+)\s*://) {
 317         $column += length($&);
 318         parse_c_until_one_of("\\S", \$_, \$line, \$column);
 319     }
 320
 321     # $output->write("$line.$column: '$_'\n");
 322
 323     if(/^$/) {
 324         # Nothing
 325     } elsif(/^\{/) {
 326         my $statements;
 327         my $statements_line;
 328         my $statements_column;
 329         if(!parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
 330             return 0;
 331         }
 332         if(!parse_c_statements(\$statements, \$statements_line, \$statements_column, $found_function_call_callback)) {
 333             return 0;
 334         }
 335     } elsif(/^(for|if|switch|while)(\s*)\(/) {
 336         $column += length("$1$2");
 337         my $name = $1;
 338
 339         $_ = "($'";
 340
 341         my @arguments;
 342         my @argument_lines;
 343         my @argument_columns;
 344         if(!parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 345             return 0;
 346         }
 347
 348         parse_c_until_one_of("\\S", \$_, \$line, \$column);
 349         if(!parse_c_statement(\$_, \$line, \$column, $found_function_call_callback)) {
 350             return 0;
 351         }
 352         parse_c_until_one_of("\\S", \$_, \$line, \$column);
 353
 354         while(defined(my $argument = shift @arguments) &&
 355               defined(my $argument_line = shift @argument_lines) &&
 356               defined(my $argument_column = shift @argument_columns))
 357         {
 358             parse_c_expression(\$argument, \$argument_line, \$argument_column, $found_function_call_callback);
 359         }
 360     } elsif(s/^else//) {
 361         $column += length($&);
 362         if(!parse_c_statement(\$_, \$line, \$column, $found_function_call_callback)) {
 363             return 0;
 364         }
 365     } elsif(parse_c_expression(\$_, \$line, \$column, $found_function_call_callback)) {
 366         # Nothing
 367     } else {
 368         # $output->write("error '$_'\n");
 369         # exit 1;
 370     }
 371
 372     _update_c_position($_, \$line, \$column);
 373
 374     $$refcurrent = $_;
 375     $$refline = $line;
 376     $$refcolumn = $column;
 377
 378     return 1;
 379 }
 380
 381 sub parse_c_statements {
 382     my $refcurrent = shift;
 383     my $refline = shift;
 384     my $refcolumn = shift;
 385     my $found_function_call_callback = shift;
 386
 387     my $line = $$refline;
 388     my $column = $$refcolumn;
 389
 390     local $_ = $$refcurrent;
 391
 392     parse_c_until_one_of("\\S", \$_, \$line, \$column);
 393     my $statement = "";
 394     my $statement_line = $line;
 395     my $statement_column = $column;
 396
 397     my $blevel = 1;
 398     my $plevel = 1;
 399     while($plevel > 0 || $blevel > 0) {
 400         my $match;
 401         parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
 402
 403         # $output->write("'$match' '$_'\n");
 404
 405         $column++;
 406         $statement .= $match;
 407         if(s/^[\(\[]//) {
 408             $plevel++;
 409             $statement .= $&;
 410         } elsif(s/^[\)\]]//) {
 411             $plevel--;
 412             if($plevel <= 0) {
 413                 $output->write("error $plevel: '$statement' '$match' '$_'\n");
 414                 exit 1;
 415             }
 416             $statement .= $&;
 417         } elsif(s/^\{//) {
 418             $blevel++;
 419             $statement .= $&;
 420         } elsif(s/^\}//) {
 421             $blevel--;
 422             $statement .= $&;
 423             if($blevel == 1) {
 424                 if(!parse_c_statement(\$statement, \$statement_line, \$statement_column, $found_function_call_callback)) {
 425                     return 0;
 426                 }
 427                 parse_c_until_one_of("\\S", \$_, \$line, \$column);
 428                 $statement = "";
 429                 $statement_line = $line;
 430                 $statement_column = $column;
 431             }
 432         } elsif(s/^;//) {
 433             if($plevel == 1 && $blevel == 1) {
 434                 if(!parse_c_statement(\$statement, \$statement_line, \$statement_column, $found_function_call_callback)) {
 435                     return 0;
 436                 }
 437
 438                 parse_c_until_one_of("\\S", \$_, \$line, \$column);
 439                 $statement = "";
 440                 $statement_line = $line;
 441                 $statement_column = $column;
 442             } else {
 443                 $statement .= $&;
 444             }
 445         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
 446             $plevel = 0;
 447             $blevel = 0;
 448         } else {
 449             $output->write("error $plevel: '$statement' '$match' '$_'\n");
 450             exit 1;
 451         }
 452     }
 453
 454     _update_c_position($_, \$line, \$column);
 455
 456     $$refcurrent = $_;
 457     $$refline = $line;
 458     $$refcolumn = $column;
 459
 460     return 1;
 461 }
 462
 463 sub parse_c_tuple {
 464     my $refcurrent = shift;
 465     my $refline = shift;
 466     my $refcolumn = shift;
 467
 468     # FIXME: Should not write directly
 469     my $items = shift;
 470     my $item_lines = shift;
 471     my $item_columns = shift;
 472
 473     local $_ = $$refcurrent;
 474
 475     my $line = $$refline;
 476     my $column = $$refcolumn;
 477
 478     my $item;
 479     if(s/^\(//) {
 480         $column++;
 481         $item = "";
 482     } else {
 483         return 0;
 484     }
 485
 486     my $item_line = $line;
 487     my $item_column = $column + 1;
 488
 489     my $plevel = 1;
 490     while($plevel > 0) {
 491         my $match;
 492         parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
 493
 494         $column++;
 495
 496         $item .= $match;
 497         if(s/^\)//) {
 498             $plevel--;
 499             if($plevel == 0) {
 500                 push @$item_lines, $item_line;
 501                 push @$item_columns, $item_column;
 502                 push @$items, $item;
 503                 $item = "";
 504             } else {
 505                 $item .= ")";
 506             }
 507         } elsif(s/^\(//) {
 508             $plevel++;
 509             $item .= "(";
 510         } elsif(s/^,//) {
 511             if($plevel == 1) {
 512                 push @$item_lines, $item_line;
 513                 push @$item_columns, $item_column;
 514                 push @$items, $item;
 515                 parse_c_until_one_of("\\S", \$_, \$line, \$column);
 516                 $item_line = $line;
 517                 $item_column = $column + 1;
 518                 $item = "";
 519             } else {
 520                 $item .= ",";
 521             }
 522         } else {
 523             return 0;
 524         }
 525     }
 526
 527     $$refcurrent = $_;
 528     $$refline = $line;
 529     $$refcolumn = $column;
 530
 531     return 1;
 532 }
 533
 534 1;