arch/nios2nommu/scripts/PTF/PTFParser.pm

   1 ####################################################################
   2 #
   3 #    This file was generated using Parse::Yapp version 1.05.
   4 #
   5 #        Don't edit this file, use source file instead.
   6 #
   7 #             ANY CHANGE MADE HERE WILL BE LOST !
   8 #
   9 ####################################################################
  10 package PTFParser;
  11 use vars qw ( @ISA );
  12 use strict;
  13
  14 @ISA= qw ( Parse::Yapp::Driver );
  15 #Included Parse/Yapp/Driver.pm file----------------------------------------
  16 {
  17 #
  18 # Module Parse::Yapp::Driver
  19 #
  20 # This module is part of the Parse::Yapp package available on your
  21 # nearest CPAN
  22 #
  23 # Any use of this module in a standalone parser make the included
  24 # text under the same copyright as the Parse::Yapp module itself.
  25 #
  26 # This notice should remain unchanged.
  27 #
  28 # (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
  29 # (see the pod text in Parse::Yapp module for use and distribution rights)
  30 #
  31
  32 package Parse::Yapp::Driver;
  33
  34 require 5.004;
  35
  36 use strict;
  37
  38 use vars qw ( $VERSION $COMPATIBLE $FILENAME );
  39
  40 $VERSION = '1.05';
  41 $COMPATIBLE = '0.07';
  42 $FILENAME=__FILE__;
  43
  44 use Carp;
  45
  46 #Known parameters, all starting with YY (leading YY will be discarded)
  47 my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '',
  48                          YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => '');
  49 #Mandatory parameters
  50 my(@params)=('LEX','RULES','STATES');
  51
  52 sub new {
  53     my($class)=shift;
  54         my($errst,$nberr,$token,$value,$check,$dotpos);
  55     my($self)={ ERROR => \&_Error,
  56                                 ERRST => \$errst,
  57                 NBERR => \$nberr,
  58                                 TOKEN => \$token,
  59                                 VALUE => \$value,
  60                                 DOTPOS => \$dotpos,
  61                                 STACK => [],
  62                                 DEBUG => 0,
  63                                 CHECK => \$check };
  64
  65         _CheckParams( [], \%params, \@_, $self );
  66
  67                 exists($$self{VERSION})
  68         and     $$self{VERSION} < $COMPATIBLE
  69         and     croak "Yapp driver version $VERSION ".
  70                           "incompatible with version $$self{VERSION}:\n".
  71                           "Please recompile parser module.";
  72
  73         ref($class)
  74     and $class=ref($class);
  75
  76     bless($self,$class);
  77 }
  78
  79 sub YYParse {
  80     my($self)=shift;
  81     my($retval);
  82
  83         _CheckParams( \@params, \%params, \@_, $self );
  84
  85         if($$self{DEBUG}) {
  86                 _DBLoad();
  87                 $retval = eval '$self->_DBParse()';#Do not create stab entry on compile
  88         $@ and die $@;
  89         }
  90         else {
  91                 $retval = $self->_Parse();
  92         }
  93     $retval
  94 }
  95
  96 sub YYData {
  97         my($self)=shift;
  98
  99                 exists($$self{USER})
 100         or      $$self{USER}={};
 101
 102         $$self{USER};
 103
 104 }
 105
 106 sub YYErrok {
 107         my($self)=shift;
 108
 109         ${$$self{ERRST}}=0;
 110     undef;
 111 }
 112
 113 sub YYNberr {
 114         my($self)=shift;
 115
 116         ${$$self{NBERR}};
 117 }
 118
 119 sub YYRecovering {
 120         my($self)=shift;
 121
 122         ${$$self{ERRST}} != 0;
 123 }
 124
 125 sub YYAbort {
 126         my($self)=shift;
 127
 128         ${$$self{CHECK}}='ABORT';
 129     undef;
 130 }
 131
 132 sub YYAccept {
 133         my($self)=shift;
 134
 135         ${$$self{CHECK}}='ACCEPT';
 136     undef;
 137 }
 138
 139 sub YYError {
 140         my($self)=shift;
 141
 142         ${$$self{CHECK}}='ERROR';
 143     undef;
 144 }
 145
 146 sub YYSemval {
 147         my($self)=shift;
 148         my($index)= $_[0] - ${$$self{DOTPOS}} - 1;
 149
 150                 $index < 0
 151         and     -$index <= @{$$self{STACK}}
 152         and     return $$self{STACK}[$index][1];
 153
 154         undef;  #Invalid index
 155 }
 156
 157 sub YYCurtok {
 158         my($self)=shift;
 159
 160         @_
 161     and ${$$self{TOKEN}}=$_[0];
 162     ${$$self{TOKEN}};
 163 }
 164
 165 sub YYCurval {
 166         my($self)=shift;
 167
 168         @_
 169     and ${$$self{VALUE}}=$_[0];
 170     ${$$self{VALUE}};
 171 }
 172
 173 sub YYExpect {
 174     my($self)=shift;
 175
 176     keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}}
 177 }
 178
 179 sub YYLexer {
 180     my($self)=shift;
 181
 182         $$self{LEX};
 183 }
 184
 185
 186 #################
 187 # Private stuff #
 188 #################
 189
 190
 191 sub _CheckParams {
 192         my($mandatory,$checklist,$inarray,$outhash)=@_;
 193         my($prm,$value);
 194         my($prmlst)={};
 195
 196         while(($prm,$value)=splice(@$inarray,0,2)) {
 197         $prm=uc($prm);
 198                         exists($$checklist{$prm})
 199                 or      croak("Unknow parameter '$prm'");
 200                         ref($value) eq $$checklist{$prm}
 201                 or      croak("Invalid value for parameter '$prm'");
 202         $prm=unpack('@2A*',$prm);
 203                 $$outhash{$prm}=$value;
 204         }
 205         for (@$mandatory) {
 206                         exists($$outhash{$_})
 207                 or      croak("Missing mandatory parameter '".lc($_)."'");
 208         }
 209 }
 210
 211 sub _Error {
 212         print "Parse error.\n";
 213 }
 214
 215 sub _DBLoad {
 216         {
 217                 no strict 'refs';
 218
 219                         exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ?
 220                 and     return;
 221         }
 222         my($fname)=__FILE__;
 223         my(@drv);
 224         open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname";
 225         while(<DRV>) {
 226                         /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/
 227                 and     do {
 228                         s/^#DBG>//;
 229                         push(@drv,$_);
 230                 }
 231         }
 232         close(DRV);
 233
 234         $drv[0]=~s/_P/_DBP/;
 235         eval join('',@drv);
 236 }
 237
 238 #Note that for loading debugging version of the driver,
 239 #this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive.
 240 #So, DO NOT remove comment at end of sub !!!
 241 sub _Parse {
 242     my($self)=shift;
 243
 244         my($rules,$states,$lex,$error)
 245      = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' };
 246         my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos)
 247      = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' };
 248
 249 #DBG>   my($debug)=$$self{DEBUG};
 250 #DBG>   my($dbgerror)=0;
 251
 252 #DBG>   my($ShowCurToken) = sub {
 253 #DBG>           my($tok)='>';
 254 #DBG>           for (split('',$$token)) {
 255 #DBG>                   $tok.=          (ord($_) < 32 or ord($_) > 126)
 256 #DBG>                                   ?       sprintf('<%02X>',ord($_))
 257 #DBG>                                   :       $_;
 258 #DBG>           }
 259 #DBG>           $tok.='<';
 260 #DBG>   };
 261
 262         $$errstatus=0;
 263         $$nberror=0;
 264         ($$token,$$value)=(undef,undef);
 265         @$stack=( [ 0, undef ] );
 266         $$check='';
 267
 268     while(1) {
 269         my($actions,$act,$stateno);
 270
 271         $stateno=$$stack[-1][0];
 272         $actions=$$states[$stateno];
 273
 274 #DBG>   print STDERR ('-' x 40),"\n";
 275 #DBG>           $debug & 0x2
 276 #DBG>   and     print STDERR "In state $stateno:\n";
 277 #DBG>           $debug & 0x08
 278 #DBG>   and     print STDERR "Stack:[".
 279 #DBG>                                    join(',',map { $$_[0] } @$stack).
 280 #DBG>                                    "]\n";
 281
 282
 283         if  (exists($$actions{ACTIONS})) {
 284
 285                                 defined($$token)
 286             or  do {
 287                                 ($$token,$$value)=&$lex($self);
 288 #DBG>                           $debug & 0x01
 289 #DBG>                   and     print STDERR "Need token. Got ".&$ShowCurToken."\n";
 290                         };
 291
 292             $act=   exists($$actions{ACTIONS}{$$token})
 293                     ?   $$actions{ACTIONS}{$$token}
 294                     :   exists($$actions{DEFAULT})
 295                         ?   $$actions{DEFAULT}
 296                         :   undef;
 297         }
 298         else {
 299             $act=$$actions{DEFAULT};
 300 #DBG>                   $debug & 0x01
 301 #DBG>           and     print STDERR "Don't need token.\n";
 302         }
 303
 304             defined($act)
 305         and do {
 306
 307                 $act > 0
 308             and do {        #shift
 309
 310 #DBG>                           $debug & 0x04
 311 #DBG>                   and     print STDERR "Shift and go to state $act.\n";
 312
 313                                         $$errstatus
 314                                 and     do {
 315                                         --$$errstatus;
 316
 317 #DBG>                                   $debug & 0x10
 318 #DBG>                           and     $dbgerror
 319 #DBG>                           and     $$errstatus == 0
 320 #DBG>                           and     do {
 321 #DBG>                                   print STDERR "**End of Error recovery.\n";
 322 #DBG>                                   $dbgerror=0;
 323 #DBG>                           };
 324                                 };
 325
 326
 327                 push(@$stack,[ $act, $$value ]);
 328
 329                                         $$token ne ''   #Don't eat the eof
 330                                 and     $$token=$$value=undef;
 331                 next;
 332             };
 333
 334             #reduce
 335             my($lhs,$len,$code,@sempar,$semval);
 336             ($lhs,$len,$code)=@{$$rules[-$act]};
 337
 338 #DBG>                   $debug & 0x04
 339 #DBG>           and     $act
 340 #DBG>           and     print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
 341
 342                 $act
 343             or  $self->YYAccept();
 344
 345             $$dotpos=$len;
 346
 347                 unpack('A1',$lhs) eq '@'    #In line rule
 348             and do {
 349                     $lhs =~ /^\@[0-9]+\-([0-9]+)$/
 350                 or  die "In line rule name '$lhs' ill formed: ".
 351                         "report it as a BUG.\n";
 352                 $$dotpos = $1;
 353             };
 354
 355             @sempar =       $$dotpos
 356                         ?   map { $$_[1] } @$stack[ -$$dotpos .. -1 ]
 357                         :   ();
 358
 359             $semval = $code ? &$code( $self, @sempar )
 360                             : @sempar ? $sempar[0] : undef;
 361
 362             splice(@$stack,-$len,$len);
 363
 364                 $$check eq 'ACCEPT'
 365             and do {
 366
 367 #DBG>                   $debug & 0x04
 368 #DBG>           and     print STDERR "Accept.\n";
 369
 370                                 return($semval);
 371                         };
 372
 373                 $$check eq 'ABORT'
 374             and do {
 375
 376 #DBG>                   $debug & 0x04
 377 #DBG>           and     print STDERR "Abort.\n";
 378
 379                                 return(undef);
 380
 381                         };
 382
 383 #DBG>                   $debug & 0x04
 384 #DBG>           and     print STDERR "Back to state $$stack[-1][0], then ";
 385
 386                 $$check eq 'ERROR'
 387             or  do {
 388 #DBG>                           $debug & 0x04
 389 #DBG>                   and     print STDERR
 390 #DBG>                               "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
 391
 392 #DBG>                           $debug & 0x10
 393 #DBG>                   and     $dbgerror
 394 #DBG>                   and     $$errstatus == 0
 395 #DBG>                   and     do {
 396 #DBG>                           print STDERR "**End of Error recovery.\n";
 397 #DBG>                           $dbgerror=0;
 398 #DBG>                   };
 399
 400                             push(@$stack,
 401                      [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]);
 402                 $$check='';
 403                 next;
 404             };
 405
 406 #DBG>                   $debug & 0x04
 407 #DBG>           and     print STDERR "Forced Error recovery.\n";
 408
 409             $$check='';
 410
 411         };
 412
 413         #Error
 414             $$errstatus
 415         or   do {
 416
 417             $$errstatus = 1;
 418             &$error($self);
 419                 $$errstatus # if 0, then YYErrok has been called
 420             or  next;       # so continue parsing
 421
 422 #DBG>                   $debug & 0x10
 423 #DBG>           and     do {
 424 #DBG>                   print STDERR "**Entering Error recovery.\n";
 425 #DBG>                   ++$dbgerror;
 426 #DBG>           };
 427
 428             ++$$nberror;
 429
 430         };
 431
 432                         $$errstatus == 3        #The next token is not valid: discard it
 433                 and     do {
 434                                 $$token eq ''   # End of input: no hope
 435                         and     do {
 436 #DBG>                           $debug & 0x10
 437 #DBG>                   and     print STDERR "**At eof: aborting.\n";
 438                                 return(undef);
 439                         };
 440
 441 #DBG>                   $debug & 0x10
 442 #DBG>           and     print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";
 443
 444                         $$token=$$value=undef;
 445                 };
 446
 447         $$errstatus=3;
 448
 449                 while(    @$stack
 450                           and (         not exists($$states[$$stack[-1][0]]{ACTIONS})
 451                                 or  not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
 452                                         or      $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {
 453
 454 #DBG>                   $debug & 0x10
 455 #DBG>           and     print STDERR "**Pop state $$stack[-1][0].\n";
 456
 457                         pop(@$stack);
 458                 }
 459
 460                         @$stack
 461                 or      do {
 462
 463 #DBG>                   $debug & 0x10
 464 #DBG>           and     print STDERR "**No state left on stack: aborting.\n";
 465
 466                         return(undef);
 467                 };
 468
 469                 #shift the error token
 470
 471 #DBG>                   $debug & 0x10
 472 #DBG>           and     print STDERR "**Shift \$error token and go to state ".
 473 #DBG>                                            $$states[$$stack[-1][0]]{ACTIONS}{error}.
 474 #DBG>                                            ".\n";
 475
 476                 push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);
 477
 478     }
 479
 480     #never reached
 481         croak("Error in driver logic. Please, report it as a BUG");
 482
 483 }#_Parse
 484 #DO NOT remove comment
 485
 486 1;
 487
 488 }
 489 #End of include--------------------------------------------------
 490
 491
 492 #line 1 "PTFParser.yp"
 493 #
 494 # Altera PTF file parser
 495 #
 496 # Copyright (c) 2004 Microtronix Datacom Ltd.
 497 #
 498
 499 package PTFParser;
 500
 501 use PTF::PTFSection;
 502
 503 #global variables should go here.
 504
 505 #my $line = 0;          # for error messages
 506 #my @sectionStack = (); # used to keep track of ptf sections
 507 #my $root;
 508
 509 my $fh;
 510
 511 sub new {
 512         my($class)=shift;
 513         ref($class)
 514     and $class=ref($class);
 515
 516     my($self)=$class->SUPER::new( yyversion => '1.05',
 517                                   yystates =>
 518 [
 519         {#State 0
 520                 ACTIONS => {
 521                         'IDENTIFIER' => 1
 522                 },
 523                 GOTOS => {
 524                         'section' => 2,
 525                         'section_title' => 3
 526                 }
 527         },
 528         {#State 1
 529                 ACTIONS => {
 530                         'IDENTIFIER' => 4,
 531                         'STRING_LITERAL' => 6,
 532                         'NUMBER' => 7
 533                 },
 534                 DEFAULT => -3,
 535                 GOTOS => {
 536                         'section_name' => 5
 537                 }
 538         },
 539         {#State 2
 540                 ACTIONS => {
 541                         '' => 8
 542                 }
 543         },
 544         {#State 3
 545                 ACTIONS => {
 546                         "{" => 9
 547                 }
 548         },
 549         {#State 4
 550                 DEFAULT => -4
 551         },
 552         {#State 5
 553                 DEFAULT => -2
 554         },
 555         {#State 6
 556                 DEFAULT => -6
 557         },
 558         {#State 7
 559                 DEFAULT => -5
 560         },
 561         {#State 8
 562                 DEFAULT => 0
 563         },
 564         {#State 9
 565                 ACTIONS => {
 566                         'IDENTIFIER' => 11,
 567                         'HIERARCHICAL_NAME' => 13
 568                 },
 569                 DEFAULT => -7,
 570                 GOTOS => {
 571                         'assignment_name' => 10,
 572                         'assignment' => 12,
 573                         'section_element' => 14,
 574                         'section' => 15,
 575                         'section_title' => 3
 576                 }
 577         },
 578         {#State 10
 579                 ACTIONS => {
 580                         "=" => 16
 581                 }
 582         },
 583         {#State 11
 584                 ACTIONS => {
 585                         'IDENTIFIER' => 4,
 586                         'STRING_LITERAL' => 6,
 587                         'NUMBER' => 7,
 588                         "=" => -11
 589                 },
 590                 DEFAULT => -3,
 591                 GOTOS => {
 592                         'section_name' => 5
 593                 }
 594         },
 595         {#State 12
 596                 ACTIONS => {
 597                         'IDENTIFIER' => 11,
 598                         'HIERARCHICAL_NAME' => 13
 599                 },
 600                 DEFAULT => -7,
 601                 GOTOS => {
 602                         'assignment_name' => 10,
 603                         'assignment' => 12,
 604                         'section_element' => 17,
 605                         'section' => 15,
 606                         'section_title' => 3
 607                 }
 608         },
 609         {#State 13
 610                 DEFAULT => -12
 611         },
 612         {#State 14
 613                 ACTIONS => {
 614                         "}" => 18
 615                 }
 616         },
 617         {#State 15
 618                 ACTIONS => {
 619                         'IDENTIFIER' => 11,
 620                         'HIERARCHICAL_NAME' => 13
 621                 },
 622                 DEFAULT => -7,
 623                 GOTOS => {
 624                         'assignment_name' => 10,
 625                         'assignment' => 12,
 626                         'section_element' => 19,
 627                         'section' => 15,
 628                         'section_title' => 3
 629                 }
 630         },
 631         {#State 16
 632                 ACTIONS => {
 633                         'STRING_LITERAL' => 20,
 634                         'NUMBER' => 22
 635                 },
 636                 GOTOS => {
 637                         'assignment_value' => 21
 638                 }
 639         },
 640         {#State 17
 641                 DEFAULT => -8
 642         },
 643         {#State 18
 644                 DEFAULT => -1
 645         },
 646         {#State 19
 647                 DEFAULT => -9
 648         },
 649         {#State 20
 650                 DEFAULT => -13
 651         },
 652         {#State 21
 653                 ACTIONS => {
 654                         ";" => 23
 655                 }
 656         },
 657         {#State 22
 658                 DEFAULT => -14
 659         },
 660         {#State 23
 661                 DEFAULT => -10
 662         }
 663 ],
 664                                   yyrules  =>
 665 [
 666         [#Rule 0
 667                  '$start', 2, undef
 668         ],
 669         [#Rule 1
 670                  'section', 4,
 671 sub
 672 #line 20 "PTFParser.yp"
 673 {
 674                         my $sectionStack = $_[0]->YYData->{sectionStack};
 675                         pop @{$sectionStack};
 676                 }
 677         ],
 678         [#Rule 2
 679                  'section_title', 2,
 680 sub
 681 #line 26 "PTFParser.yp"
 682 {
 683                         my $section = PTFSection->new (type => $_[1], name => $_[2]);
 684                         my $sectionStack = $_[0]->YYData->{sectionStack};
 685
 686                         if (scalar(@{$sectionStack}) == 0) {
 687                                 $_[0]->YYData->{root} = $section;
 688                         } else {
 689                                 my $parent = $sectionStack->[$#{$sectionStack}];
 690                                 $parent->addSection ($section);
 691                         }
 692
 693                         push @{$sectionStack}, $section;
 694                 }
 695         ],
 696         [#Rule 3
 697                  'section_name', 0, undef
 698         ],
 699         [#Rule 4
 700                  'section_name', 1, undef
 701         ],
 702         [#Rule 5
 703                  'section_name', 1, undef
 704         ],
 705         [#Rule 6
 706                  'section_name', 1, undef
 707         ],
 708         [#Rule 7
 709                  'section_element', 0, undef
 710         ],
 711         [#Rule 8
 712                  'section_element', 2, undef
 713         ],
 714         [#Rule 9
 715                  'section_element', 2, undef
 716         ],
 717         [#Rule 10
 718                  'assignment', 4,
 719 sub
 720 #line 52 "PTFParser.yp"
 721 {
 722                         my $sectionStack = $_[0]->YYData->{sectionStack};
 723                         my $parent= $sectionStack->[$#{$sectionStack}];
 724                         $parent->addAssignment ($_[1], $_[3]);
 725                 }
 726         ],
 727         [#Rule 11
 728                  'assignment_name', 1, undef
 729         ],
 730         [#Rule 12
 731                  'assignment_name', 1, undef
 732         ],
 733         [#Rule 13
 734                  'assignment_value', 1, undef
 735         ],
 736         [#Rule 14
 737                  'assignment_value', 1, undef
 738         ]
 739 ],
 740                                   @_);
 741     bless($self,$class);
 742 }
 743
 744 #line 67 "PTFParser.yp"
 745
 746
 747 sub _Error {
 748 # TODO: update this error function to be more useful
 749         exists $_[0]->YYData->{ERRMSG}
 750     and do {
 751         print $_[0]->YYData->{ERRMSG};
 752         delete $_[0]->YYData->{ERRMSG};
 753         return;
 754     };
 755     print "Syntax error on line $_[0]->YYData->{line}.\n";
 756 }
 757
 758 sub _Lexer {
 759         my($parser)=shift;
 760
 761         if (! $parser->YYData->{INPUT}) {
 762                 if ($parser->YYData->{INPUT} = <$fh>) {
 763                         $parser->YYData->{line} += 1;
 764                 } else {
 765                         return ('', undef);
 766                 }
 767         }
 768
 769         $parser->YYData->{INPUT} and
 770                 $parser->YYData->{INPUT} =~ s/^\s*//;
 771
 772         while (1) {
 773
 774                 # skip blank lines
 775                 if ($parser->YYData->{INPUT} =~ s/^[ \t\r\n]*$//) {
 776                         if ($parser->YYData->{INPUT} = <$fh>) {
 777                                 $parser->YYData->{line} += 1;
 778                         } else {
 779                                 return ('', undef);
 780                         }
 781                         $parser->YYData->{INPUT} and
 782                                 $parser->YYData->{INPUT} =~ s/^\s*//;
 783                         next;
 784                 }
 785
 786                 # Skip comments
 787                 if ($parser->YYData->{INPUT} =~ s/^#.*//) {
 788                         if ($parser->YYData->{INPUT} = <$fh>) {
 789                                 $parser->YYData->{line} += 1;
 790                         } else {
 791                                 return ('', undef);
 792                         }
 793                         $parser->YYData->{INPUT} and
 794                                 $parser->YYData->{INPUT} =~ s/^\s*//;
 795                         next;
 796                 }
 797
 798                 # Don't continue if the line length is 0;
 799                 if (length $parser->YYData->{INPUT} == 0) {
 800                         if ($parser->YYData->{INPUT} = <$fh>) {
 801                                 $parser->YYData->{line} += 1;
 802                         } else {
 803                                 return ('', undef);
 804                         }
 805                         $parser->YYData->{INPUT} and
 806                                 $parser->YYData->{INPUT} =~ s/^\s*//;
 807                         next;
 808                 }
 809
 810                 # tokenize input
 811                 $parser->YYData->{INPUT} =~ s/^([a-zA-Z_][a-zA-Z_0-9\/]*)//
 812                         and return('IDENTIFIER',$1);
 813                 $parser->YYData->{INPUT} =~ s/^"([^"\\]*(\\.[^"\\]*)*)"//
 814                         and return('STRING_LITERAL',$1);
 815                 $parser->YYData->{INPUT} =~ s/^"([^"\\]*(\\.[^"\\]*)*)//
 816                         and do {
 817                                 my $literal = $1;
 818
 819                                 do {
 820                                         if ($parser->YYData->{INPUT} = <$fh>) {
 821                                                 $parser->YYData->{line} += 1;
 822                                         } else {
 823                                                 return ('', undef);
 824                                         }
 825
 826                                         $parser->YYData->{INPUT} =~ s/([^"\\]*(\\.[^"\\]*)*)"//
 827                                                 and do {
 828                                                         $literal .= $1;
 829                                                         return ('STRING_LITERAL', $literal);
 830                                                 };
 831
 832                                         $parser->YYData->{INPUT} =~ s/([^"\\]*(\\.[^"\\]*)*)//
 833                                                 and $literal .= $1;
 834                                 } while (1);
 835                         };
 836                 $parser->YYData->{INPUT} =~ s/^([0-9]+)//
 837                         and return('NUMBER',$1);
 838                 $parser->YYData->{INPUT} =~ s/^([\$]{1,2}[a-zA-Z0-9 \/_]+)//
 839                         and return('HIERARCHICAL_NAME',$1);
 840                 $parser->YYData->{INPUT} =~ s/^(.)//
 841                         and return($1,$1);
 842         }
 843 }
 844
 845 sub readPTF {
 846         my $self = shift;
 847         my $filename = shift;
 848
 849         # store information for later use
 850         $self->YYData->{line} = 0;
 851         $self->YYData->{sectionStack} = [];
 852         undef $self->YYData->{root};
 853
 854         if (-e $filename) {
 855                 open (PTFFILE, $filename);
 856                 $fh = \*PTFFILE;
 857         } else {
 858                 $fh = \*STDIN;
 859         }
 860
 861         $self->YYParse (
 862                 yylex => \&_Lexer,
 863                 yyerror => \&_Error,
 864                 );
 865
 866         if (-e $filename) {
 867                 close PTFFILE;
 868         }
 869
 870         return $self->YYData->{root};
 871 }
 872
 873 1;