X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.c;h=18f8606bffd669b98605c3dbe6bb577ea442f9e9;hb=5f2d99664d8a6923d24892ffc0569f4e03e22edd;hp=6b9e37662515e4faadc641a543f4d3199102a60d;hpb=37442d52629699d89ef62d315d35efbc0facec21;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.c b/perly.c
index 6b9e376..18f8606 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,7 +103,7 @@ do {								\
 `--------------------------------*/
 
 static void
-yysymprint (pTHX_ PerlIO *yyoutput, int yytype, const YYSTYPE *yyvaluep)
+yysymprint(PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
 {
     if (yytype < YYNTOKENS) {
 	YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
@@ -189,7 +183,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,6 +243,7 @@ yystpcpy (pTHX_ char *yydest, const char *yysrc)
 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.  */
@@ -263,8 +257,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.  */
@@ -302,6 +296,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 */
@@ -310,8 +309,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);
@@ -320,8 +319,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
@@ -366,6 +366,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;
@@ -407,7 +408,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);
@@ -482,7 +487,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
@@ -514,7 +519,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.  */
 
@@ -565,7 +570,7 @@ 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) {
 		const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
 		yyp = yystpcpy (yyp, yytname[yytype]);