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");
}
#endif /* !YYERROR_VERBOSE */
+
+/* a snapshot of the current stack position variables for use by
+ * S_clear_yystack */
+
+typedef struct {
+ short *yyss;
+ short *yyssp;
+ YYSTYPE *yyvsp;
+ int yylen;
+} yystack_positions;
+
+/* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
+ * parse stack, thus avoiding leaks if we die */
+
+static void
+S_clear_yystack(pTHX_ const void *p)
+{
+ yystack_positions *y = (yystack_positions*) p;
+
+ if (!y->yyss)
+ return;
+ YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
+ y->yyvsp -= y->yylen; /* ignore the tokens that have just been reduced */
+ y->yyssp -= y->yylen;
+ while (y->yyssp > y->yyss) {
+ if (yy_is_opval[yystos[*y->yyssp]])
+ op_free(y->yyvsp->opval);
+ y->yyvsp--;
+ y->yyssp--;
+ }
+}
+
/*----------.
| yyparse. |
`----------*/
/* for ease of re-allocation and automatic freeing, have two SVs whose
* SvPVX points to the stacks */
SV *yyss_sv, *yyvs_sv;
+ SV *ss_save_sv;
+ yystack_positions *ss_save;
#ifdef DEBUGGING
/* maintain also a stack of token/rule names for debugging with -Dpv */
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 */
yyss_sv = newSV(YYINITDEPTH * sizeof(short));
yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
+ ss_save_sv = newSV(sizeof(yystack_positions));
SAVEFREESV(yyss_sv);
SAVEFREESV(yyvs_sv);
+ SAVEFREESV(ss_save_sv);
yyss = (short *) SvPVX(yyss_sv);
yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
+ ss_save = (yystack_positions *) SvPVX(ss_save_sv);
+
+ ss_save->yyss = NULL; /* disarm stack cleanup */
+ /* cleanup the parse stack on premature exit */
+ SAVEDESTRUCTOR_X(S_clear_yystack, (void*) ss_save);
+
/* note that elements zero of yyvs and yyns are not used */
yyssp = yyss;
yyvsp = yyvs;
yynerrs = 0;
yychar = YYEMPTY; /* Cause a token to be read. */
-
-
YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
goto yysetstate;
/* 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);
YY_REDUCE_PRINT (yyn);
+
+ /* running external code may trigger a die (eg 'use nosuchmodule'):
+ * record the current stack state so that an unwind will
+ * free all the pesky OPs lounging around on the parse stack */
+ ss_save->yyss = yyss;
+ ss_save->yyssp = yyssp;
+ ss_save->yyvsp = yyvsp;
+ ss_save->yylen = yylen;
+
switch (yyn) {
/* contains all the rule actions; auto-generated from perly.y */
/* 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;
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--;
yyreturn:
- LEAVE; /* force stack free before we return */
+ ss_save->yyss = NULL; /* disarm parse stack cleanup */
+ LEAVE; /* force stack free before we return */
return yyresult;
}