This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove a comment that is no longer necessary since Perl Object bit
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index ad0e604..4dac4d0 100644 (file)
--- a/perly.y
+++ b/perly.y
  * The main job of of this grammar is to call the various newFOO()
  * functions in op.c to build a syntax tree of OP structs.
  * It relies on the lexer in toke.c to do the tokenizing.
+ *
+ * Note: due to the way that the cleanup code works WRT to freeing ops on
+ * the parse stack, it is dangerous to assign to the $n variables within
+ * an action.
  */
 
 /*  Make the parser re-entrant. */
@@ -48,7 +52,6 @@
     char *pval;
     OP *opval;
     GV *gvval;
-    AV* padval;
 #ifdef PERL_IN_MADLY_C
     TOKEN* p_tkval;
     TOKEN* i_tkval;
@@ -76,7 +79,7 @@
 %token <i_tkval> LOCAL MY MYSUB REQUIRE
 %token <i_tkval> COLONATTR
 
-%type <ival> prog progstart remember mremember savescope
+%type <ival> prog progstart remember mremember
 %type <ival>  startsub startanonsub startformsub
 /* FIXME for MAD - are these two ival? */
 %type <ival> mydefsv mintro
@@ -92,7 +95,6 @@
 %type <opval> termbinop termunop anonymous termdo
 %type <opval> switch case
 %type <p_tkval> label
-%type <padval> remempad
 
 %nonassoc <i_tkval> PREC_LOW
 %nonassoc LOOPEX
@@ -137,8 +139,8 @@ prog        :       progstart
 
 /* An ordinary block */
 block  :       '{' remember lineseq '}'
-                       { if (PL_copline > (line_t)IVAL($1))
-                             PL_copline = (line_t)IVAL($1);
+                       { if (PL_parser->copline > (line_t)IVAL($1))
+                             PL_parser->copline = (line_t)IVAL($1);
                          $$ = block_end($2, $3);
                          TOKEN_GETMAD($1,$$,'{');
                          TOKEN_GETMAD($4,$$,'}');
@@ -155,14 +157,14 @@ mydefsv:  /* NULL */      /* lexicalize $_ */
 
 progstart:
                {
-                   PL_expect = XSTATE; $$ = block_start(TRUE);
+                   PL_parser->expect = XSTATE; $$ = block_start(TRUE);
                }
        ;
 
 
 mblock :       '{' mremember lineseq '}'
-                       { if (PL_copline > (line_t)IVAL($1))
-                             PL_copline = (line_t)IVAL($1);
+                       { if (PL_parser->copline > (line_t)IVAL($1))
+                             PL_parser->copline = (line_t)IVAL($1);
                          $$ = block_end($2, $3);
                          TOKEN_GETMAD($1,$$,'{');
                          TOKEN_GETMAD($4,$$,'}');
@@ -173,9 +175,6 @@ mremember:  /* NULL */      /* start a partial lexical scope */
                        { $$ = block_start(FALSE); }
        ;
 
-savescope:     /* NULL */      /* remember stack pos in case of error */
-               { $$ = PL_savestack_ix; }
-
 /* A collection of "lines" in the program */
 lineseq        :       /* NULL */
                        { $$ = Nullop; }
@@ -186,12 +185,13 @@ lineseq   :       /* NULL */
                                    (LISTOP*)$1, (LISTOP*)$2),
                                $1);
                        }
-       |       lineseq savescope line
-                       {   LEAVE_SCOPE($2);
-                           $$ = append_list(OP_LINESEQ,
-                               (LISTOP*)$1, (LISTOP*)$3);
+       |       lineseq line
+                       {   $$ = append_list(OP_LINESEQ,
+                               (LISTOP*)$1, (LISTOP*)$2);
                            PL_pad_reset_pending = TRUE;
-                           if ($1 && $3) PL_hints |= HINT_BLOCK_SCOPE; }
+                           if ($1 && $2)
+                               PL_hints |= HINT_BLOCK_SCOPE;
+                       }
        ;
 
 /* A "line" in the program */
@@ -214,17 +214,17 @@ line      :       label cond
                              $$ = IF_MAD(
                                        newOP(OP_NULL, 0),
                                        Nullop);
-                              PL_copline = NOLINE;
+                              PL_parser->copline = NOLINE;
                              TOKEN_FREE($1);
                              TOKEN_GETMAD($2,$$,';');
                          }
-                         PL_expect = XSTATE;
+                         PL_parser->expect = XSTATE;
                        }
        |       label sideff ';'
                        {
                          $$ = newSTATEOP(0, PVAL($1), $2);
-                         PL_expect = XSTATE;
-                         DO_MAD(
+                         PL_parser->expect = XSTATE;
+                         DO_MAD({
                              /* sideff might already have a nexstate */
                              OP* op = ((LISTOP*)$$)->op_first;
                              if (op) {
@@ -234,7 +234,7 @@ line        :       label cond
                                  token_getmad($1,op,'L');
                                  token_getmad($3,op,';');
                              }
-                         )
+                         })
                        }
        ;
 
@@ -260,7 +260,7 @@ sideff      :       error
                          TOKEN_GETMAD($2,$$,'w');
                        }
        |       expr FOR expr
-                       { $$ = newFOROP(0, Nullch, (line_t)IVAL($2),
+                       { $$ = newFOROP(0, NULL, (line_t)IVAL($2),
                                        Nullop, $3, $1, Nullop);
                          TOKEN_GETMAD($2,((LISTOP*)$$)->op_first->op_sibling,'w');
                        }
@@ -274,7 +274,7 @@ else        :       /* NULL */
                          TOKEN_GETMAD($1,$$,'o');
                        }
        |       ELSIF '(' mexpr ')' mblock else
-                       { PL_copline = (line_t)IVAL($1);
+                       { PL_parser->copline = (line_t)IVAL($1);
                            $$ = newCONDOP(0, $3, scope($5), $6);
                            PL_hints |= HINT_BLOCK_SCOPE;
                          TOKEN_GETMAD($1,$$,'I');
@@ -285,7 +285,7 @@ else        :       /* NULL */
 
 /* Real conditional expressions */
 cond   :       IF '(' remember mexpr ')' mblock else
-                       { PL_copline = (line_t)IVAL($1);
+                       { PL_parser->copline = (line_t)IVAL($1);
                            $$ = block_end($3,
                                   newCONDOP(0, $4, scope($6), $7));
                          TOKEN_GETMAD($1,$$,'I');
@@ -293,7 +293,7 @@ cond        :       IF '(' remember mexpr ')' mblock else
                          TOKEN_GETMAD($5,$$,')');
                        }
        |       UNLESS '(' remember miexpr ')' mblock else
-                       { PL_copline = (line_t)IVAL($1);
+                       { PL_parser->copline = (line_t)IVAL($1);
                            $$ = block_end($3,
                                   newCONDOP(0, $4, scope($6), $7));
                          TOKEN_GETMAD($1,$$,'I');
@@ -322,7 +322,7 @@ cont        :       /* NULL */
 /* Loops: while, until, for, and a bare block */
 loop   :       label WHILE '(' remember texpr ')' mintro mblock cont
                        { OP *innerop;
-                         PL_copline = (line_t)$2;
+                         PL_parser->copline = (line_t)$2;
                            $$ = block_end($4,
                                   newSTATEOP(0, PVAL($1),
                                     innerop = newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -335,7 +335,7 @@ loop        :       label WHILE '(' remember texpr ')' mintro mblock cont
 
        |       label UNTIL '(' remember iexpr ')' mintro mblock cont
                        { OP *innerop;
-                         PL_copline = (line_t)$2;
+                         PL_parser->copline = (line_t)$2;
                            $$ = block_end($4,
                                   newSTATEOP(0, PVAL($1),
                                     innerop = newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -380,19 +380,16 @@ loop      :       label WHILE '(' remember texpr ')' mintro mblock cont
                    mblock
                        /* basically fake up an initialize-while lineseq */
                        { OP *forop;
-                         PL_copline = (line_t)IVAL($2);
+                         PL_parser->copline = (line_t)IVAL($2);
                          forop = newSTATEOP(0, PVAL($1),
                                            newWHILEOP(0, 1, (LOOP*)Nullop,
                                                IVAL($2), scalar($7),
                                                $12, $10, $9));
 #ifdef MAD
-                         if (!$5)
-                               $5 = newOP(OP_NULL, 0);
                          forop = newUNOP(OP_NULL, 0, append_elem(OP_LINESEQ,
                                newSTATEOP(0,
-                                          (($1)->tk_lval.pval
-                                          ?savepv(($1)->tk_lval.pval):Nullch),
-                                          $5),
+                                          CopLABEL_alloc(($1)->tk_lval.pval),
+                                          ($5 ? $5 : newOP(OP_NULL, 0)) ),
                                forop));
 
                          token_getmad($2,forop,'3');
@@ -404,8 +401,7 @@ loop        :       label WHILE '(' remember texpr ')' mintro mblock cont
 #else
                          if ($5) {
                                forop = append_elem(OP_LINESEQ,
-                                        newSTATEOP(0, ($1?savepv($1):Nullch),
-                                                  $5),
+                                        newSTATEOP(0, CopLABEL_alloc($1), $5),
                                        forop);
                          }
 
@@ -421,7 +417,7 @@ loop        :       label WHILE '(' remember texpr ')' mintro mblock cont
 
 /* Switch blocks */
 switch :       label GIVEN '(' remember mydefsv mexpr ')' mblock
-                       { PL_copline = (line_t) $2;
+                       { PL_parser->copline = (line_t) $2;
                            $$ = block_end($4,
                                newSTATEOP(0, PVAL($1),
                                    newGIVENOP($6, scope($8),
@@ -471,10 +467,10 @@ label     :       /* empty */
                        {
 #ifdef MAD
                          YYSTYPE tmplval;
-                         tmplval.pval = Nullch;
+                         tmplval.pval = NULL;
                          $$ = newTOKEN(OP_NULL, tmplval, 0);
 #else
-                         $$ = Nullch;
+                         $$ = NULL;
 #endif
                        }
        |       LABEL
@@ -504,15 +500,16 @@ peg       :       PEG
                        }
        ;
 
-format :       FORMAT remempad startformsub formname block
-                       { SvREFCNT_inc(PL_compcv);
+format :       FORMAT startformsub formname block
+                       { SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
-                         $$ = newFORM($3, $4, $5);
+                         $$ = newFORM($2, $3, $4);
                          prepend_madprops($1->tk_mad, $$, 'F');
                          $1->tk_mad = 0;
                          token_free($1);
 #else
-                         newFORM($3, $4, $5);
+                         newFORM($2, $3, $4);
+                         $$ = Nullop;
 #endif
                        }
        ;
@@ -522,42 +519,41 @@ formname: WORD            { $$ = $1; }
        ;
 
 /* Unimplemented "my sub foo { }" */
-mysubrout:     MYSUB remempad startsub subname proto subattrlist subbody
-                       { SvREFCNT_inc(PL_compcv);
+mysubrout:     MYSUB startsub subname proto subattrlist subbody
+                       { SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
-                         $$ = newMYSUB($3, $4, $5, $6, $7);
+                         $$ = newMYSUB($2, $3, $4, $5, $6);
                          token_getmad($1,$$,'d');
 #else
-                         newMYSUB($3, $4, $5, $6, $7);
+                         newMYSUB($2, $3, $4, $5, $6);
+                         $$ = Nullop;
 #endif
                        }
        ;
 
 /* Subroutine definition */
-subrout        :       SUB remempad startsub subname proto subattrlist subbody
-                       { SvREFCNT_inc(PL_compcv);
+subrout        :       SUB startsub subname proto subattrlist subbody
+                       { SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
-                         OP* o = newSVOP(OP_ANONCODE, 0,
-                           (SV*)newATTRSUB($3, $4, $5, $6, $7));
-                         $$ = newOP(OP_NULL,0);
-                         op_getmad(o,$$,'&');
-                         op_getmad($4,$$,'n');
-                         op_getmad($5,$$,'s');
-                         op_getmad($6,$$,'a');
-                         token_getmad($1,$$,'d');
-                         append_madprops($7->op_madprop, $$, 0);
-                         $7->op_madprop = 0;
+                         {
+                             OP* o = newSVOP(OP_ANONCODE, 0,
+                               (SV*)newATTRSUB($2, $3, $4, $5, $6));
+                             $$ = newOP(OP_NULL,0);
+                             op_getmad(o,$$,'&');
+                             op_getmad($3,$$,'n');
+                             op_getmad($4,$$,'s');
+                             op_getmad($5,$$,'a');
+                             token_getmad($1,$$,'d');
+                             append_madprops($6->op_madprop, $$, 0);
+                             $6->op_madprop = 0;
+                           }
 #else
-                         newATTRSUB($3, $4, $5, $6, $7);
+                         newATTRSUB($2, $3, $4, $5, $6);
                          $$ = Nullop;
 #endif
                        }
        ;
 
-remempad:      /* NULL */      /* remember current value of PL_comppad */
-                       { $$ = PL_comppad; }
-       ;
-
 startsub:      /* NULL */      /* start a regular subroutine scope */
                        { $$ = start_subparse(FALSE, 0);
                            SAVEFREESV(PL_compcv); }
@@ -625,7 +621,7 @@ subbody     :       block   { $$ = $1; }
                                    newOP(OP_NULL,0),
                                    Nullop
                                );
-                         PL_expect = XSTATE;
+                         PL_parser->expect = XSTATE;
                          TOKEN_GETMAD($1,$$,';');
                        }
        ;
@@ -638,22 +634,25 @@ package : PACKAGE WORD ';'
                          token_getmad($3,$$,';');
 #else
                          package($2);
+                         $$ = Nullop;
 #endif
                        }
        ;
 
-use    :       USE remempad startsub
+use    :       USE startsub
                        { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
                    WORD WORD listexpr ';'
-                       { SvREFCNT_inc(PL_compcv);
+                       { SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
-                         $$ = utilize(IVAL($1), $3, $5, $6, $7);
+                         $$ = utilize(IVAL($1), $2, $4, $5, $6);
                          token_getmad($1,$$,'o');
-                         token_getmad($8,$$,';');
-                         if (PL_rsfp_filters && AvFILLp(PL_rsfp_filters) >= 0)
+                         token_getmad($7,$$,';');
+                         if (PL_parser->rsfp_filters &&
+                                     AvFILLp(PL_parser->rsfp_filters) >= 0)
                              append_madprops(newMADPROP('!', MAD_PV, "", 0), $$, 0);
 #else
-                         utilize(IVAL($1), $3, $5, $6, $7);
+                         utilize(IVAL($1), $2, $4, $5, $6);
+                         $$ = Nullop;
 #endif
                        }
        ;
@@ -687,11 +686,12 @@ argexpr   :       argexpr ','
                        }
        |       argexpr ',' term
                        { 
+                         OP* term = $3;
                          DO_MAD(
-                             $3 = newUNOP(OP_NULL, 0, $3);
-                             token_getmad($2,$3,',');
+                             term = newUNOP(OP_NULL, 0, term);
+                             token_getmad($2,term,',');
                          )
-                         $$ = append_elem(OP_LIST, $1, $3);
+                         $$ = append_elem(OP_LIST, $1, term);
                        }
        |       term %prec PREC_LOW
        ;
@@ -748,13 +748,13 @@ listop    :       LSTOP indirob argexpr /* map {...} @args or print $fh @args */
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($4,$$,')');
                        }
-       |       LSTOPSUB remempad startanonsub block /* sub f(&@); f {foo} ... */
-                       { SvREFCNT_inc(PL_compcv);
-                         $4 = newANONATTRSUB($3, 0, Nullop, $4); }
+       |       LSTOPSUB startanonsub block /* sub f(&@);   f { foo } ... */
+                       { SvREFCNT_inc_simple_void(PL_compcv);
+                         $<opval>$ = newANONATTRSUB($2, 0, Nullop, $3); }
                    listexpr            %prec LSTOP  /* ... @bar */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                 append_elem(OP_LIST,
-                                  prepend_elem(OP_LIST, $4, $6), $1));
+                                  prepend_elem(OP_LIST, $<opval>4, $5), $1));
                        }
        ;
 
@@ -768,7 +768,7 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
                         /* In this and all the hash accessors, ';' is
                          * provided by the tokeniser */
                        { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3));
-                           PL_expect = XOPERATOR;
+                           PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'{');
                          TOKEN_GETMAD($4,$$,';');
                          TOKEN_GETMAD($5,$$,'}');
@@ -795,7 +795,7 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
                        }
        |       scalar '{' expr ';' '}'    /* $foo->{bar();} */
                        { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
-                           PL_expect = XOPERATOR;
+                           PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'{');
                          TOKEN_GETMAD($4,$$,';');
                          TOKEN_GETMAD($5,$$,'}');
@@ -804,7 +804,7 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
                        { $$ = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF($1),OP_RV2HV),
                                        jmaybe($4));
-                           PL_expect = XOPERATOR;
+                           PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'a');
                          TOKEN_GETMAD($3,$$,'{');
                          TOKEN_GETMAD($5,$$,';');
@@ -814,7 +814,7 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
                        { $$ = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF($1),OP_RV2HV),
                                        jmaybe($3));
-                           PL_expect = XOPERATOR;
+                           PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'{');
                          TOKEN_GETMAD($4,$$,';');
                          TOKEN_GETMAD($5,$$,'}');
@@ -906,14 +906,14 @@ termbinop:        term ASSIGNOP term                     /* $x = $y */
        |       term DOTDOT term                       /* $x..$y, $x...$y */
                        {
                          $$ = newRANGE(IVAL($2), scalar($1), scalar($3));
-                         DO_MAD(
+                         DO_MAD({
                              UNOP *op;
                              op = (UNOP*)$$;
                              op = (UNOP*)op->op_first; /* get to flop */
                              op = (UNOP*)op->op_first; /* get to flip */
                              op = (UNOP*)op->op_first; /* get to range */
                              token_getmad($2,(OP*)op,'o');
-                           )
+                           })
                        }
        |       term ANDAND term                       /* $x && $y */
                        { $$ = newLOGOP(OP_AND, 0, $1, $3);
@@ -1002,12 +1002,12 @@ anonymous:      '[' expr ']'
                          TOKEN_GETMAD($2,$$,';');
                          TOKEN_GETMAD($3,$$,'}');
                        }
-       |       ANONSUB remempad startanonsub proto subattrlist block %prec '('
-                       { SvREFCNT_inc(PL_compcv);
-                         $$ = newANONATTRSUB($3, $4, $5, $6);
+       |       ANONSUB startanonsub proto subattrlist block    %prec '('
+                       { SvREFCNT_inc_simple_void(PL_compcv);
+                         $$ = newANONATTRSUB($2, $3, $4, $5);
                          TOKEN_GETMAD($1,$$,'o');
-                         OP_GETMAD($4,$$,'s');
-                         OP_GETMAD($5,$$,'a');
+                         OP_GETMAD($3,$$,'s');
+                         OP_GETMAD($4,$$,'a');
                        }
 
     ;
@@ -1083,7 +1083,7 @@ term      :       termbinop
                        { $$ = $1; }
        |       LOCAL term      %prec UNIOP
                        { $$ = localize($2,IVAL($1));
-                         TOKEN_GETMAD($1,$$,'d');
+                         TOKEN_GETMAD($1,$$,'k');
                        }
        |       '(' expr ')'
                        { $$ = sawparens(IF_MAD(newUNOP(OP_NULL,0,$2), $2));
@@ -1122,7 +1122,7 @@ term      :       termbinop
                                    newLISTOP(OP_HSLICE, 0,
                                        list($3),
                                        ref(oopsHV($1), OP_HSLICE)));
-                           PL_expect = XOPERATOR;
+                           PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'{');
                          TOKEN_GETMAD($4,$$,';');
                          TOKEN_GETMAD($5,$$,'}');
@@ -1140,14 +1140,14 @@ term    :       termbinop
                        {
                          $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                append_elem(OP_LIST, $3, scalar($1)));
-                         DO_MAD(
+                         DO_MAD({
                              OP* op = $$;
                              if (op->op_type == OP_CONST) { /* defeat const fold */
                                op = (OP*)op->op_madprop->mad_val;
                              }
                              token_getmad($2,op,'(');
                              token_getmad($4,op,')');
-                         )
+                         })
                        }
        |       NOAMP WORD listexpr                  /* foo(@args) */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -1179,10 +1179,14 @@ term    :       termbinop
                        { $$ = newUNOP(IVAL($1), 0, $2);
                          TOKEN_GETMAD($1,$$,'o');
                        }
-       |       REQUIRE                              /* require, $_ implied *//* FIMXE for MAD needed? */
-                       { $$ = newOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0); }
-       |       REQUIRE term                         /* require Foo *//* FIMXE for MAD needed? */
-                       { $$ = newUNOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0, $2); }
+       |       REQUIRE                              /* require, $_ implied */
+                       { $$ = newOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0);
+                         TOKEN_GETMAD($1,$$,'o');
+                       }
+       |       REQUIRE term                         /* require Foo */
+                       { $$ = newUNOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0, $2);
+                         TOKEN_GETMAD($1,$$,'o');
+                       }
        |       UNIOPSUB
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); }
        |       UNIOPSUB term                        /* Sub treated as unop */
@@ -1286,7 +1290,7 @@ listexprcom:      /* NULL */
 /* A little bit of trickery to make "for my $foo (@bar)" actually be
    lexical */
 my_scalar:     scalar
-                       { PL_in_my = 0; $$ = my($1); }
+                       { PL_parser->in_my = 0; $$ = my($1); }
        ;
 
 amper  :       '&' indirob