X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.c;h=913ed8af4bf987f2eca0a8a991b18a66d48dd758;hb=55eed6530071fdede680c5313b36f33946ae9956;hp=d763c0e15a8a408927695c8617a0a54ff5f89ee7;hpb=e45843364c6c14961f5f9e7f270e051a7c0891dc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.c b/perly.c
index d763c0e..913ed8a 100644
--- a/perly.c
+++ b/perly.c
@@ -1,6 +1,6 @@
 /*    perly.c
  *
- *    Copyright (c) 2004 Larry Wall
+ *    Copyright (c) 2004, 2005, 2006 Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -89,17 +89,11 @@ do {						\
 	YYFPRINTF Args;				\
 } while (0)
 
-#  define YYDSYMPRINT(Args)			\
-do {						\
-    if (yydebug)				\
-	yysymprint Args;			\
-} while (0)
-
 #  define YYDSYMPRINTF(Title, Token, Value)			\
 do {								\
     if (yydebug) {						\
 	YYFPRINTF (Perl_debug_log, "%s ", Title);		\
-	yysymprint (aTHX_ Perl_debug_log,  Token, Value);	\
+	yysymprint (Perl_debug_log,  Token, Value);	\
 	YYFPRINTF (Perl_debug_log, "\n");			\
     }								\
 } while (0)
@@ -109,11 +103,8 @@ do {								\
 `--------------------------------*/
 
 static void
-yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
+yysymprint(PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
 {
-    /* Pacify ``unused variable'' warnings.  */
-    (void) yyvaluep;
-
     if (yytype < YYNTOKENS) {
 	YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
 #   ifdef YYPRINT
@@ -125,10 +116,6 @@ yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
     else
 	YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
 
-    switch (yytype) {
-	default:
-	    break;
-    }
     YYFPRINTF (yyoutput, ")");
 }
 
@@ -138,7 +125,7 @@ yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
  *  meanings as the local vars in yyparse() of the same name */
 
 static void
-yy_stack_print (pTHX_ short *yyss, short *yyssp, YYSTYPE *yyvs, const char**yyns)
+yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
 {
     int i;
     int start = 1;
@@ -153,14 +140,23 @@ yy_stack_print (pTHX_ short *yyss, short *yyssp, YYSTYPE *yyvs, const char**yyns
     for (i=0; i < count; i++)
 	PerlIO_printf(Perl_debug_log, " %8d", start+i);
     PerlIO_printf(Perl_debug_log, "\nstate:");
-    for (i=0, yyss += start; i < count; i++, yyss++)
-	PerlIO_printf(Perl_debug_log, " %8d", *yyss);
+    for (i=0; i < count; i++)
+	PerlIO_printf(Perl_debug_log, " %8d", yyss[start+i]);
     PerlIO_printf(Perl_debug_log, "\ntoken:");
-    for (i=0, yyns += start; i < count; i++, yyns++)
-	PerlIO_printf(Perl_debug_log, " %8.8s", *yyns);
+    for (i=0; i < count; i++)
+	PerlIO_printf(Perl_debug_log, " %8.8s", yyns[start+i]);
     PerlIO_printf(Perl_debug_log, "\nvalue:");
-    for (i=0, yyvs += start; i < count; i++, yyvs++)
-	PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs->ival);
+    for (i=0; i < count; i++) {
+	if (yy_is_opval[yystos[yyss[start+i]]]) {
+	    PerlIO_printf(Perl_debug_log, " %8.8s",
+		  yyvs[start+i].opval
+		    ? PL_op_name[yyvs[start+i].opval->op_type]
+		    : "NULL"
+	    );
+	}
+	else
+	    PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs[start+i].ival);
+    }
     PerlIO_printf(Perl_debug_log, "\n\n");
 }
 
@@ -179,7 +175,7 @@ static void
 yy_reduce_print (pTHX_ int yyrule)
 {
     int yyi;
-    unsigned int yylineno = yyrline[yyrule];
+    const unsigned int yylineno = yyrline[yyrule];
     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
 			  yyrule - 1, yylineno);
     /* Print the symbols being reduced, and their result.  */
@@ -196,7 +192,6 @@ do {					\
 
 #else /* !DEBUGGING */
 #  define YYDPRINTF(Args)
-#  define YYDSYMPRINT(Args)
 #  define YYDSYMPRINTF(Title, Token, Value)
 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
 #  define YY_REDUCE_PRINT(Rule)
@@ -250,26 +245,6 @@ yystpcpy (pTHX_ char *yydest, const char *yysrc)
 
 #endif /* !YYERROR_VERBOSE */
 
-
-/*-----------------------------------------------.
-| Release the memory associated to this symbol.  |
-`-----------------------------------------------*/
-
-static void
-yydestruct (int yytype, YYSTYPE *yyvaluep)
-{
-    /* Pacify ``unused variable'' warnings.  */
-    (void) yyvaluep;
-
-    switch (yytype) {
-	default:
-	    break;
-    }
-}
-
-
-
-
 /*----------.
 | yyparse.  |
 `----------*/
@@ -277,6 +252,7 @@ yydestruct (int yytype, YYSTYPE *yyvaluep)
 int
 Perl_yyparse (pTHX)
 {
+    dVAR;
     int yychar; /* The lookahead symbol.  */
     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
     int yynerrs; /* Number of syntax errors so far.  */
@@ -290,8 +266,8 @@ Perl_yyparse (pTHX)
     int yytoken = 0;
 
     /* two stacks and their tools:
-	  `yyss': related to states,
-	  `yyvs': related to semantic values,
+	  yyss: related to states,
+	  yyvs: related to semantic values,
 
 	  Refer to the stacks thru separate pointers, to allow yyoverflow
 	  to reallocate them elsewhere.  */
@@ -329,6 +305,11 @@ Perl_yyparse (pTHX)
 	  rule.  */
     int yylen;
 
+#ifdef PERL_MAD
+    if (PL_madskills)
+	return madparse();
+#endif
+
     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 
     ENTER;			/* force stack free before we return */
@@ -337,8 +318,8 @@ Perl_yyparse (pTHX)
     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
 
-    yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
-    yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
+    yyss_sv = newSV(YYINITDEPTH * sizeof(short));
+    yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
     SAVEFREESV(yyss_sv);
     SAVEFREESV(yyvs_sv);
     yyss = (short *) SvPVX(yyss_sv);
@@ -347,8 +328,9 @@ Perl_yyparse (pTHX)
     yyssp = yyss;
     yyvsp = yyvs;
 #ifdef DEBUGGING
-    yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *));
+    yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
     SAVEFREESV(yyns_sv);
+    /* XXX This seems strange to cast char * to char ** */
     yyns = (const char **) SvPVX(yyns_sv);
     yynsp = yyns;
 #endif
@@ -358,8 +340,6 @@ Perl_yyparse (pTHX)
     yynerrs = 0;
     yychar = YYEMPTY;		/* Cause a token to be read.  */
 
-
-
     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 
     goto yysetstate;
@@ -378,7 +358,7 @@ Perl_yyparse (pTHX)
 
     if (yyss + yystacksize - 1 <= yyssp) {
 	 /* Get the current used size of the three stacks, in elements.  */
-	 YYSIZE_T yysize = yyssp - yyss + 1;
+	 const YYSIZE_T yysize = yyssp - yyss + 1;
 
 	 /* Extend the stack our own way.  */
 	 if (YYMAXDEPTH <= yystacksize)
@@ -393,6 +373,7 @@ Perl_yyparse (pTHX)
 	 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 #ifdef DEBUGGING
 	 SvGROW(yyns_sv, yystacksize * sizeof(char *));
+	 /* XXX This seems strange to cast char * to char ** */
 	 yyns = (const char **) SvPVX(yyns_sv);
 	 if (! yyns)
 	       goto yyoverflowlab;
@@ -434,7 +415,11 @@ Perl_yyparse (pTHX)
     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
     if (yychar == YYEMPTY) {
 	YYDPRINTF ((Perl_debug_log, "Reading a token: "));
+#ifdef PERL_MAD
+	yychar = PL_madskills ? madlex() : yylex();
+#else
 	yychar = yylex();
+#endif
 #  ifdef EBCDIC
 	if (yychar >= 0 && yychar < 255) {
 	    yychar = NATIVE_TO_ASCII(yychar);
@@ -509,7 +494,7 @@ Perl_yyparse (pTHX)
     yylen = yyr2[yyn];
 
     /* If YYLEN is nonzero, implement the default value of the action:
-      `$$ = $1'.
+      "$$ = $1".
 
       Otherwise, the following line sets YYVAL to garbage.
       This behavior is undocumented and Bison
@@ -541,7 +526,7 @@ Perl_yyparse (pTHX)
     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
 #endif
 
-    /* Now `shift' the result of the reduction.  Determine what state
+    /* Now shift the result of the reduction.  Determine what state
 	  that goes to, based on the state we popped back to and the rule
 	  number reduced by.  */
 
@@ -579,7 +564,7 @@ Perl_yyparse (pTHX)
 
 	if (YYPACT_NINF < yyn && yyn < YYLAST) {
 	    YYSIZE_T yysize = 0;
-	    int yytype = YYTRANSLATE (yychar);
+	    const int yytype = YYTRANSLATE (yychar);
 	    char *yymsg;
 	    int yyx, yycount;
 
@@ -592,9 +577,9 @@ Perl_yyparse (pTHX)
 		    yysize += yystrlen (yytname[yyx]) + 15, yycount++;
 	    yysize += yystrlen ("syntax error, unexpected ") + 1;
 	    yysize += yystrlen (yytname[yytype]);
-	    New(yymsg, yysize, char *);
+	    Newx(yymsg, yysize, char *);
 	    if (yymsg != 0) {
-		char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
+		const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
 		yyp = yystpcpy (yyp, yytname[yytype]);
 
 		if (yycount < 5) {
@@ -635,14 +620,16 @@ Perl_yyparse (pTHX)
 	    /* Pop the rest of the stack.  */
 	    while (yyss < yyssp) {
 		YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
-		yydestruct (yystos[*yyssp], yyvsp);
+		if (yy_is_opval[yystos[*yyssp]]) {
+		    YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+		    op_free(yyvsp->opval);
+		}
 		YYPOPSTACK;
 	    }
 	    YYABORT;
 	}
 
 	YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
-	yydestruct (yytoken, &yylval);
 	yychar = YYEMPTY;
 
     }
@@ -674,7 +661,10 @@ Perl_yyparse (pTHX)
 	    YYABORT;
 
 	YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
-	yydestruct (yystos[yystate], yyvsp);
+	if (yy_is_opval[yystos[*yyssp]]) {
+	    YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+	    op_free(yyvsp->opval);
+	}
 	yyvsp--;
 #ifdef DEBUGGING
 	yynsp--;
@@ -728,3 +718,13 @@ Perl_yyparse (pTHX)
 
     return yyresult;
 }
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */