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

diff --git a/perly.c b/perly.c
index b18e202..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.
@@ -76,10 +76,6 @@ while (0)
 #define YYTERROR	1
 #define YYERRCODE	256
 
-/* YYLEX -- calling `yylex' with the right arguments.  */
-
-# define YYLEX yylex_r (&yylval, &yychar)
-
 /* Enable debugging if requested.  */
 #ifdef DEBUGGING
 
@@ -93,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)
@@ -113,26 +103,19 @@ 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
 	YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
 #   else
-	YYFPRINTF (yyoutput, "0x%x", yyvaluep->ival);
+	YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
 #   endif
     }
     else
 	YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
 
-    switch (yytype) {
-	default:
-	    break;
-    }
     YYFPRINTF (yyoutput, ")");
 }
 
@@ -142,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, char**yyns)
+yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
 {
     int i;
     int start = 1;
@@ -164,7 +147,7 @@ yy_stack_print (pTHX_ short *yyss, short *yyssp, YYSTYPE *yyvs, char**yyns)
 	PerlIO_printf(Perl_debug_log, " %8.8s", *yyns);
     PerlIO_printf(Perl_debug_log, "\nvalue:");
     for (i=0, yyvs += start; i < count; i++, yyvs++)
-	PerlIO_printf(Perl_debug_log, " %8x", yyvs->ival);
+	PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs->ival);
     PerlIO_printf(Perl_debug_log, "\n\n");
 }
 
@@ -183,7 +166,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.  */
@@ -200,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)
@@ -254,26 +236,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.  |
 `----------*/
@@ -281,6 +243,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.  */
@@ -294,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.  */
@@ -314,7 +277,7 @@ Perl_yyparse (pTHX)
 
 #ifdef DEBUGGING
     /* maintain also a stack of token/rule names for debugging with -Dpv */
-    char **yyns, **yynsp;
+    const char **yyns, **yynsp;
     SV *yyns_sv;
 #  define YYPOPSTACK   (yyvsp--, yyssp--, yynsp--)
 #else
@@ -333,15 +296,21 @@ Perl_yyparse (pTHX)
 	  rule.  */
     int yylen;
 
+#ifdef PERL_MAD
+    if (PL_madskills)
+	return madparse();
+#endif
+
     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 
-#ifdef USE_ITHREADS
-    /* XXX is this needed anymore? DAPM 13-Feb-04;
-     * if not, delete the correspinding LEAVE too */
     ENTER;			/* force stack free before we return */
-#endif
-    yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
-    yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
+    SAVEVPTR(PL_yycharp);
+    SAVEVPTR(PL_yylvalp);
+    PL_yycharp = &yychar; /* so PL_yyerror() can access it */
+    PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
+
+    yyss_sv = newSV(YYINITDEPTH * sizeof(short));
+    yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
     SAVEFREESV(yyss_sv);
     SAVEFREESV(yyvs_sv);
     yyss = (short *) SvPVX(yyss_sv);
@@ -350,9 +319,10 @@ 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);
-    yyns = (char **) SvPVX(yyns_sv);
+    /* XXX This seems strange to cast char * to char ** */
+    yyns = (const char **) SvPVX(yyns_sv);
     yynsp = yyns;
 #endif
 
@@ -381,7 +351,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)
@@ -396,7 +366,8 @@ Perl_yyparse (pTHX)
 	 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 #ifdef DEBUGGING
 	 SvGROW(yyns_sv, yystacksize * sizeof(char *));
-	 yyns = (char **) SvPVX(yyns_sv);
+	 /* XXX This seems strange to cast char * to char ** */
+	 yyns = (const char **) SvPVX(yyns_sv);
 	 if (! yyns)
 	       goto yyoverflowlab;
 	 yynsp = yyns + yysize - 1;
@@ -437,7 +408,16 @@ Perl_yyparse (pTHX)
     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
     if (yychar == YYEMPTY) {
 	YYDPRINTF ((Perl_debug_log, "Reading a token: "));
-	yychar = YYLEX;
+#ifdef PERL_MAD
+	yychar = PL_madskills ? madlex() : yylex();
+#else
+	yychar = yylex();
+#endif
+#  ifdef EBCDIC
+	if (yychar >= 0 && yychar < 255) {
+	    yychar = NATIVE_TO_ASCII(yychar);
+	}
+#  endif
     }
 
     if (yychar <= YYEOF) {
@@ -474,7 +454,7 @@ Perl_yyparse (pTHX)
 
     *++yyvsp = yylval;
 #ifdef DEBUGGING
-    *++yynsp = (char *)(yytname[yytoken]);
+    *++yynsp = (const char *)(yytname[yytoken]);
 #endif
 
 
@@ -507,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
@@ -536,10 +516,10 @@ Perl_yyparse (pTHX)
 
     *++yyvsp = yyval;
 #ifdef DEBUGGING
-    *++yynsp = (char *)(yytname [yyr1[yyn]]);
+    *++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.  */
 
@@ -577,7 +557,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;
 
@@ -590,9 +570,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) {
@@ -633,14 +613,12 @@ Perl_yyparse (pTHX)
 	    /* Pop the rest of the stack.  */
 	    while (yyss < yyssp) {
 		YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
-		yydestruct (yystos[*yyssp], yyvsp);
 		YYPOPSTACK;
 	    }
 	    YYABORT;
 	}
 
 	YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
-	yydestruct (yytoken, &yylval);
 	yychar = YYEMPTY;
 
     }
@@ -672,7 +650,6 @@ Perl_yyparse (pTHX)
 	    YYABORT;
 
 	YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
-	yydestruct (yystos[yystate], yyvsp);
 	yyvsp--;
 #ifdef DEBUGGING
 	yynsp--;
@@ -722,9 +699,17 @@ Perl_yyparse (pTHX)
 
   yyreturn:
 
-#ifdef USE_ITHREADS
-	LEAVE;			/* force stack free before we return */
-#endif
+    LEAVE;			/* force stack free before we return */
 
     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:
+ */