develooper Front page | perl.perl5.porters | Postings from October 2014

[perl #108276] C stack overflow in Perl_scalarvoid

Thread Previous | Thread Next
From:
Tony Cook via RT
Date:
October 28, 2014 00:23
Subject:
[perl #108276] C stack overflow in Perl_scalarvoid
Message ID:
rt-4.0.18-7062-1414455800-480.108276-15-0@perl.org
On Wed Jul 24 12:37:14 2013, sprout wrote:
> Would you be willing to finish this patch, either making it malloc a
> deferred stack when necessary (presumably a rare case) or using Dave
> Mitchell’s op_sibling technique?

I've attached a variant of Niels' patch, included inline below as a whitespace ignoring diff.

Without the patch C< ./perl -e eval\ "sub{".q"$a+"x\ shift\ .\ "}" 500000 > crashed deep in op_free(), with the patch it didn't.

I was a bit worried about increasing the allocation linearly would result in a performance issue, but that turned out to be faster than a simple exponential allocation (on Linux, YMMV.)

Tony

diff --git a/op.c b/op.c
index 59a3541..1460995 100644
--- a/op.c
+++ b/op.c
@@ -675,11 +675,29 @@ optree.
 =cut
 */
 
+#define DEFERRED_STEP 100
+#define DEFER(o) \
+  STMT_START { \
+    if (UNLIKELY(defer_ix == (defer_stack_alloc-1))) {    \
+        defer_stack_alloc += DEFERRED_STEP; \
+        assert(defer_stack_alloc > 0); \
+        Renew(defer_stack, defer_stack_alloc, OP *); \
+    } \
+    defer_stack[++defer_ix] = o; \
+  } STMT_END
+
+#define POP_DEFERRED() (defer_ix >= 0 ? defer_stack[defer_ix--] : (OP *)NULL)
+
 void
 Perl_op_free(pTHX_ OP *o)
 {
     dVAR;
     OPCODE type;
+    SSize_t defer_ix = -1;
+    SSize_t defer_stack_alloc = 0;
+    OP **defer_stack = NULL;
+
+    do {
 
         /* Though ops may be freed twice, freeing the op after its slab is a
            big no-no. */
@@ -687,7 +705,7 @@ Perl_op_free(pTHX_ OP *o)
         /* During the forced freeing of ops after compilation failure, kidops
            may be freed before their parents. */
         if (!o || o->op_type == OP_FREED)
-	return;
+            continue;
 
         type = o->op_type;
 
@@ -714,7 +732,7 @@ Perl_op_free(pTHX_ OP *o)
                     /* Need to find and remove any pattern match ops from the list
                        we maintain for reset().  */
                     find_and_forget_pmops(o);
-		return;
+                    continue;
                 }
                 }
                 break;
@@ -732,7 +750,16 @@ Perl_op_free(pTHX_ OP *o)
             OP *kid, *nextkid;
             for (kid = cUNOPo->op_first; kid; kid = nextkid) {
                 nextkid = OP_SIBLING(kid); /* Get before next freeing kid */
+                if (!kid || kid->op_type == OP_FREED)
+                    /* During the forced freeing of ops after
+                       compilation failure, kidops may be freed before
+                       their parents. */
+                    continue;
+                if (!(kid->op_flags & OPf_KIDS))
+                    /* If it has no kids, just free it now */
                     op_free(kid);
+                else
+                    DEFER(kid);
             }
         }
         if (type == OP_NULL)
@@ -753,8 +780,15 @@ Perl_op_free(pTHX_ OP *o)
         if (PL_op == o)
             PL_op = NULL;
 #endif
+    } while ( (o = POP_DEFERRED()) );
+
+    Safefree(defer_stack);
 }
 
+#undef DEFER
+#undef POP_DEFERRED
+#undef DEFERRED_STEP
+
 void
 Perl_op_clear(pTHX_ OP *o)
 {



---
via perlbug:  queue: perl5 status: open
https://rt.perl.org/Ticket/Display.html?id=108276

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About