diff options
| -rw-r--r-- | madly.tab | 27 | ||||
| -rw-r--r-- | perly.c | 8 | ||||
| -rw-r--r-- | perly.tab | 27 | ||||
| -rw-r--r-- | regen_perly.pl | 42 |
4 files changed, 104 insertions, 0 deletions
@@ -876,3 +876,30 @@ static const unsigned char yystos[] = 60, 96, 96, 105, 105, 99, 96, 88, 96, 108, 105, 4, 112, 105, 113, 87, 87, 96, 96, 102 }; +/* which symbols are of type opval */ +static const int yy_is_opval[] = +{ + 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 1, 0, 0, 0, 1, 0, + 0, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 0, 1, 1, 1, 1, 1, + 1, 0, 1, 1, 1, 1, 1, + 1, 0, 0, 0, 1, + 1, 1, 1, 1, 1, 1, 0, + 1, 1, 1, 0, 1, 1, 1, + 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 0 + +}; @@ -613,6 +613,10 @@ Perl_yyparse (pTHX) /* Pop the rest of the stack. */ while (yyss < yyssp) { YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp); + if (yy_is_opval[yystos[*yyssp]]) { + YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); + op_free(yyvsp->opval); + } YYPOPSTACK; } YYABORT; @@ -650,6 +654,10 @@ Perl_yyparse (pTHX) YYABORT; YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp); + if (yy_is_opval[yystos[*yyssp]]) { + YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); + op_free(yyvsp->opval); + } yyvsp--; #ifdef DEBUGGING yynsp--; @@ -884,3 +884,30 @@ static const unsigned char yystos[] = 96, 105, 105, 99, 96, 78, 96, 108, 105, 81, 112, 105, 113, 77, 77, 96, 96, 102 }; +/* which symbols are of type opval */ +static const int yy_is_opval[] = +{ + 0, 0, 0, 0, 1, 1, 1, + 1, 1, 1, 1, 1, 1, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 1, 0, 0, 0, 1, + 0, 0, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 0, 1, 1, 1, + 1, 1, 1, 0, 0, 0, 1, + 1, 0, 0, 0, 0, + 1, 1, 1, 1, 1, 0, + 0, 0, 1, 1, 1, 0, 1, 1, + 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 0 + +}; diff --git a/regen_perly.pl b/regen_perly.pl index af92aa890c..95e209bc6c 100644 --- a/regen_perly.pl +++ b/regen_perly.pl @@ -11,6 +11,7 @@ # #line directives plus adding a #ifdef PERL_CORE # # perly.tab the parser table C definitions extracted from the bison output +# plus an extra table generated by this script. # # perly.act the action case statements extracted from the bison output # @@ -87,6 +88,8 @@ close CTMPFILE; my ($actlines, $tablines) = extract($clines); +$tablines .= make_opval_tab($y_file, $tablines); + chmod 0644, $act_file; open ACTFILE, ">$act_file" or die "can't open $act_file: $!\n"; print ACTFILE $actlines; @@ -169,6 +172,45 @@ sub extract { return $actlines. "\n", $tablines. "\n"; } +# read a .y file and extract a list of all the token names and +# non-terminal names that are declared to be of type opval +# then scan the string $tablines for the table yytname which gives +# the token index of each token/non-terminal, then use this to +# create a new table, indexed by token number, which indicates +# whether that token is of type opval. +# +# ie given +# %token <opval> A B +# %type <opval> C D +# +# and yytname[] = { "A" "B", "C", "D", "E", "F" }; +# +# then return +# static const int yy_is_opval[] = { 1, 1, 1, 1, 0, 0 } + +sub make_opval_tab { + my ($y_file, $tablines) = @_; + my %tokens; + open my $fh, '<', $y_file or die "Can't open $y_file: $!\n"; + while (<$fh>) { + next unless s/^%(token|type)\s+<opval>\s+//; + $tokens{$_} =1 for (split ' ', $_); + } + + $tablines =~ /^\Qstatic const char *const yytname[] =\E\n + {\n + (.*?) + ^}; + /xsm + or die "Can't extract yytname[] from table string\n"; + my $fields = $1; + $fields =~ s/"([^"]+)"/$tokens{$1}||0/ge; + return + "/* which symbols are of type opval */\n" . + "static const int yy_is_opval[] =\n{\n" . $fields . "\n};\n"; +} + + sub my_system { system(@_); if ($? == -1) { |