1 ####################################################################
3 # This file was generated using Parse::Yapp version 1.05.
5 # Don't edit this file, use source file instead.
7 # ANY CHANGE MADE HERE WILL BE LOST !
9 ####################################################################
14 @ISA= qw
( Parse
::Yapp
::Driver
);
15 #Included Parse/Yapp/Driver.pm file----------------------------------------
18 # Module Parse::Yapp::Driver
20 # This module is part of the Parse::Yapp package available on your
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.
26 # This notice should remain unchanged.
28 # (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
29 # (see the pod text in Parse::Yapp module for use and distribution rights)
32 package Parse
::Yapp
::Driver
;
38 use vars qw
( $VERSION $COMPATIBLE $FILENAME );
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
=> '');
50 my(@params)=('LEX','RULES','STATES');
54 my($errst,$nberr,$token,$value,$check,$dotpos);
55 my($self)={ ERROR
=> \
&_Error
,
65 _CheckParams
( [], \
%params, \
@_, $self );
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.";
74 and $class=ref($class);
83 _CheckParams
( \
@params, \
%params, \
@_, $self );
87 $retval = eval '$self->_DBParse()';#Do not create stab entry on compile
91 $retval = $self->_Parse();
122 ${$$self{ERRST
}} != 0;
128 ${$$self{CHECK}}='ABORT';
135 ${$$self{CHECK}}='ACCEPT';
142 ${$$self{CHECK}}='ERROR';
148 my($index)= $_[0] - ${$$self{DOTPOS
}} - 1;
151 and -$index <= @
{$$self{STACK
}}
152 and return $$self{STACK
}[$index][1];
154 undef; #Invalid index
161 and ${$$self{TOKEN
}}=$_[0];
169 and ${$$self{VALUE
}}=$_[0];
176 keys %{$self->{STATES
}[$self->{STACK
}[-1][0]]{ACTIONS
}}
192 my($mandatory,$checklist,$inarray,$outhash)=@_;
196 while(($prm,$value)=splice(@
$inarray,0,2)) {
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;
206 exists($$outhash{$_})
207 or croak
("Missing mandatory parameter '".lc($_)."'");
212 print "Parse error.\n";
219 exists(${__PACKAGE__
.'::'}{_DBParse
})#Already loaded ?
224 open(DRV
,"<$fname") or die "Report this as a BUG: Cannot open $fname";
226 /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/
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 !!!
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' };
249 #DBG> my($debug)=$$self{DEBUG};
250 #DBG> my($dbgerror)=0;
252 #DBG> my($ShowCurToken) = sub {
254 #DBG> for (split('',$$token)) {
255 #DBG> $tok.= (ord($_) < 32 or ord($_) > 126)
256 #DBG> ? sprintf('<%02X>',ord($_))
264 ($$token,$$value)=(undef,undef);
265 @
$stack=( [ 0, undef ] );
269 my($actions,$act,$stateno);
271 $stateno=$$stack[-1][0];
272 $actions=$$states[$stateno];
274 #DBG> print STDERR ('-' x 40),"\n";
276 #DBG> and print STDERR "In state $stateno:\n";
278 #DBG> and print STDERR "Stack:[".
279 #DBG> join(',',map { $$_[0] } @$stack).
283 if (exists($$actions{ACTIONS
})) {
287 ($$token,$$value)=&$lex($self);
289 #DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n";
292 $act= exists($$actions{ACTIONS
}{$$token})
293 ?
$$actions{ACTIONS
}{$$token}
294 : exists($$actions{DEFAULT
})
299 $act=$$actions{DEFAULT
};
301 #DBG> and print STDERR "Don't need token.\n";
311 #DBG> and print STDERR "Shift and go to state $act.\n";
319 #DBG> and $$errstatus == 0
321 #DBG> print STDERR "**End of Error recovery.\n";
327 push(@
$stack,[ $act, $$value ]);
329 $$token ne '' #Don't eat the eof
330 and $$token=$$value=undef;
335 my($lhs,$len,$code,@sempar,$semval);
336 ($lhs,$len,$code)=@
{$$rules[-$act]};
340 #DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
343 or $self->YYAccept();
347 unpack('A1',$lhs) eq '@' #In line rule
349 $lhs =~ /^\@[0-9]+\-([0-9]+)$/
350 or die "In line rule name '$lhs' ill formed: ".
351 "report it as a BUG.\n";
356 ?
map { $$_[1] } @
$stack[ -$$dotpos .. -1 ]
359 $semval = $code ?
&$code( $self, @sempar )
360 : @sempar ?
$sempar[0] : undef;
362 splice(@
$stack,-$len,$len);
368 #DBG> and print STDERR "Accept.\n";
377 #DBG> and print STDERR "Abort.\n";
384 #DBG> and print STDERR "Back to state $$stack[-1][0], then ";
389 #DBG> and print STDERR
390 #DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
394 #DBG> and $$errstatus == 0
396 #DBG> print STDERR "**End of Error recovery.\n";
401 [ $$states[$$stack[-1][0]]{GOTOS
}{$lhs}, $semval ]);
407 #DBG> and print STDERR "Forced Error recovery.\n";
419 $$errstatus # if 0, then YYErrok has been called
420 or next; # so continue parsing
424 #DBG> print STDERR "**Entering Error recovery.\n";
432 $$errstatus == 3 #The next token is not valid: discard it
434 $$token eq '' # End of input: no hope
437 #DBG> and print STDERR "**At eof: aborting.\n";
442 #DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";
444 $$token=$$value=undef;
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)) {
455 #DBG> and print STDERR "**Pop state $$stack[-1][0].\n";
464 #DBG> and print STDERR "**No state left on stack: aborting.\n";
469 #shift the error token
472 #DBG> and print STDERR "**Shift \$error token and go to state ".
473 #DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}.
476 push(@
$stack, [ $$states[$$stack[-1][0]]{ACTIONS
}{error
}, undef ]);
481 croak
("Error in driver logic. Please, report it as a BUG");
484 #DO NOT remove comment
489 #End of include--------------------------------------------------
492 #line 1 "PTFParser.yp"
494 # Altera PTF file parser
496 # Copyright (c) 2004 Microtronix Datacom Ltd.
503 #global variables should go here.
505 #my $line = 0; # for error messages
506 #my @sectionStack = (); # used to keep track of ptf sections
514 and $class=ref($class);
516 my($self)=$class->SUPER::new
( yyversion
=> '1.05',
531 'STRING_LITERAL' => 6,
567 'HIERARCHICAL_NAME' => 13
571 'assignment_name' => 10,
573 'section_element' => 14,
586 'STRING_LITERAL' => 6,
598 'HIERARCHICAL_NAME' => 13
602 'assignment_name' => 10,
604 'section_element' => 17,
620 'HIERARCHICAL_NAME' => 13
624 'assignment_name' => 10,
626 'section_element' => 19,
633 'STRING_LITERAL' => 20,
637 'assignment_value' => 21
672 #line 20 "PTFParser.yp"
674 my $sectionStack = $_[0]->YYData->{sectionStack
};
675 pop @
{$sectionStack};
681 #line 26 "PTFParser.yp"
683 my $section = PTFSection
->new (type
=> $_[1], name
=> $_[2]);
684 my $sectionStack = $_[0]->YYData->{sectionStack
};
686 if (scalar(@
{$sectionStack}) == 0) {
687 $_[0]->YYData->{root
} = $section;
689 my $parent = $sectionStack->[$#{$sectionStack}];
690 $parent->addSection ($section);
693 push @
{$sectionStack}, $section;
697 'section_name', 0, undef
700 'section_name', 1, undef
703 'section_name', 1, undef
706 'section_name', 1, undef
709 'section_element', 0, undef
712 'section_element', 2, undef
715 'section_element', 2, undef
720 #line 52 "PTFParser.yp"
722 my $sectionStack = $_[0]->YYData->{sectionStack
};
723 my $parent= $sectionStack->[$#{$sectionStack}];
724 $parent->addAssignment ($_[1], $_[3]);
728 'assignment_name', 1, undef
731 'assignment_name', 1, undef
734 'assignment_value', 1, undef
737 'assignment_value', 1, undef
744 #line 67 "PTFParser.yp"
748 # TODO: update this error function to be more useful
749 exists $_[0]->YYData->{ERRMSG
}
751 print $_[0]->YYData->{ERRMSG
};
752 delete $_[0]->YYData->{ERRMSG
};
755 print "Syntax error on line $_[0]->YYData->{line}.\n";
761 if (! $parser->YYData->{INPUT
}) {
762 if ($parser->YYData->{INPUT
} = <$fh>) {
763 $parser->YYData->{line
} += 1;
769 $parser->YYData->{INPUT
} and
770 $parser->YYData->{INPUT
} =~ s/^\s*//;
775 if ($parser->YYData->{INPUT
} =~ s/^[ \t\r\n]*$//) {
776 if ($parser->YYData->{INPUT
} = <$fh>) {
777 $parser->YYData->{line
} += 1;
781 $parser->YYData->{INPUT
} and
782 $parser->YYData->{INPUT
} =~ s/^\s*//;
787 if ($parser->YYData->{INPUT
} =~ s/^#.*//) {
788 if ($parser->YYData->{INPUT
} = <$fh>) {
789 $parser->YYData->{line
} += 1;
793 $parser->YYData->{INPUT
} and
794 $parser->YYData->{INPUT
} =~ s/^\s*//;
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;
805 $parser->YYData->{INPUT
} and
806 $parser->YYData->{INPUT
} =~ s/^\s*//;
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/^"([^"\\]*(\\.[^"\\]*)*)//
820 if ($parser->YYData->{INPUT
} = <$fh>) {
821 $parser->YYData->{line
} += 1;
826 $parser->YYData->{INPUT
} =~ s/([^"\\]*(\\.[^"\\]*)*)"//
829 return ('STRING_LITERAL', $literal);
832 $parser->YYData->{INPUT
} =~ s/([^"\\]*(\\.[^"\\]*)*)//
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/^(.)//
847 my $filename = shift;
849 # store information for later use
850 $self->YYData->{line
} = 0;
851 $self->YYData->{sectionStack
} = [];
852 undef $self->YYData->{root
};
855 open (PTFFILE
, $filename);
870 return $self->YYData->{root
};