cloning the stack (part 1)

p4raw-id: //depot/perl@4588

diff --git a/cop.h b/cop.h
index af29ff6..88627d6 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -370,7 +370,7 @@ struct stackinfo {
     I32                        si_type;        /* type of runlevel */
     struct stackinfo * si_prev;
     struct stackinfo * si_next;
-    I32 *              si_markbase;    /* where markstack begins for us.
+    I32                        si_markoff;     /* offset where markstack begins for us.
                                         * currently used only with DEBUGGING,
                                         * but not #ifdef-ed for bincompat */
 };
@@ -382,9 +382,10 @@ typedef struct stackinfo PERL_SI;
 #define cxstack_max    (PL_curstackinfo->si_cxmax)
 
 #ifdef DEBUGGING
-#  define      SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr
+#  define      SET_MARK_OFFSET \
+    PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
 #else
-#  define      SET_MARKBASE NOOP
+#  define      SET_MARK_OFFSET NOOP
 #endif
 
 #define PUSHSTACKi(type) \
@@ -400,7 +401,7 @@ typedef struct stackinfo PERL_SI;
        AvFILLp(next->si_stack) = 0;                                    \
        SWITCHSTACK(PL_curstack,next->si_stack);                        \
        PL_curstackinfo = next;                                         \
-       SET_MARKBASE;                                                   \
+       SET_MARK_OFFSET;                                                \
     } STMT_END
 
 #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)

diff --git a/deb.c b/deb.c
index 0eaa056..36b8ca3 100644 (file)
--- a/deb.c
+++ b/deb.c
@@ -88,7 +88,7 @@ Perl_debstack(pTHX)
     dTHR;
     I32 top = PL_stack_sp - PL_stack_base;
     register I32 i = top - 30;
-    I32 *markscan = PL_curstackinfo->si_markbase;
+    I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff;
 
     if (i < 0)
        i = 0;

diff --git a/perl.c b/perl.c
index 093ac2f..9f3a8ae 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2690,7 +2690,7 @@ Perl_init_stacks(pTHX)
     PL_markstack_ptr = PL_markstack;
     PL_markstack_max = PL_markstack + REASONABLE(32);
 
-    SET_MARKBASE;
+    SET_MARK_OFFSET;
 
     New(54,PL_scopestack,REASONABLE(32),I32);
     PL_scopestack_ix = 0;

diff --git a/sv.c b/sv.c
index ae22960..41c52d8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5842,8 +5842,6 @@ Perl_sv_dup(pTHX_ SV *sstr)
     if (dstr)
        return dstr;
 
-    /* XXX TODO: sanity-check sv_dup() vs sv_dup_inc() appropriateness */
-
     /* create anew and remember what it is */
     new_SV(dstr);
     ptr_table_store(PL_ptr_table, sstr, dstr);
@@ -6151,6 +6149,63 @@ dup_pvcv:
     return dstr;
 }
 
+PERL_CONTEXT *
+Perl_cx_dup(pTHX_ PERL_CONTEXT *cx, I32 ix, I32 max)
+{
+    PERL_CONTEXT *ncx;
+
+    if (!cx)
+       return (PERL_CONTEXT*)NULL;
+
+    /* look for it in the table first */
+    ncx = ptr_table_fetch(PL_ptr_table, cx);
+    if (ncx)
+       return ncx;
+
+    /* create anew and remember what it is */
+    Newz(56, ncx, max + 1, PERL_CONTEXT);
+    ptr_table_store(PL_ptr_table, si, nsi);
+
+    /* ... */
+
+    return ncx;
+}
+
+PERL_SI *
+Perl_stackinfo_dup(pTHX_ PERL_SI *si)
+{
+    PERL_SI *nsi;
+
+    if (!si)
+       return (PERL_SI*)NULL;
+
+    /* look for it in the table first */
+    nsi = ptr_table_fetch(PL_ptr_table, si);
+    if (nsi)
+       return nsi;
+
+    /* create anew and remember what it is */
+    Newz(56, nsi, 1, PERL_SI);
+    ptr_table_store(PL_ptr_table, si, nsi);
+
+    nsi->si_stack      = av_dup_inc(si->si_stack);
+    nsi->si_cxix       = si->si_cxix;
+    nsi->si_cxmax      = si->si_cxmax;
+    nsi->si_cxstack    = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax);
+    nsi->si_type       = si->si_type;
+    nsi->si_prev       = stackinfo_dup(si->si_prev);
+    nsi->si_next       = stackinfo_dup(si->si_next);
+    nsi->si_markoff    = si->si_markoff;
+
+    return nsi;
+}
+
+ANY *
+Perl_savestack_dup(pTHX_ ANY *ss, I32 ix, I32 max)
+{
+    /* ... */
+}
+
 PerlInterpreter *
 perl_clone_using(PerlInterpreter *proto_perl, UV flags,
                 struct IPerlMem* ipM, struct IPerlEnv* ipE,
@@ -6572,37 +6627,65 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* thrdvar.h stuff */
 
-/*    PL_curstackinfo  = clone_stackinfo(proto_perl->Tcurstackinfo);
-    clone_stacks();
-    PL_mainstack       = av_dup(proto_perl->Tmainstack);
-    PL_curstack                = av_dup(proto_perl->Tcurstack);
-
-    PL_stack_max       = (SV**)0;
-    PL_stack_base      = (SV**)0;
-    PL_stack_sp                = (SV**)0;
-
-    PL_scopestack      = (I32*)0;
-    PL_scopestack_ix   = (I32)0;
-    PL_scopestack_max  = (I32)0;
-
-    PL_savestack       = (ANY*)0;
-    PL_savestack_ix    = (I32)0;
-    PL_savestack_max   = (I32)0;
-
-    PL_tmps_stack      = (SV**)0;
-    PL_tmps_ix         = (I32)-1;
-    PL_tmps_floor      = (I32)-1;
-    PL_tmps_max                = (I32)0;
-
-    PL_markstack       = (I32*)0;
-    PL_markstack_ptr   = (I32*)0;
-    PL_markstack_max   = (I32*)0;
-
-    PL_retstack                = (OP**)0;
-    PL_retstack_ix     = (I32)0;
-    PL_retstack_max    = (I32)0;
-*/     /* XXXXXX */
-    init_stacks();
+    if (flags & 1) {
+       /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
+       PL_tmps_ix              = proto_perl->Ttmps_ix;
+       PL_tmps_max             = proto_perl->Ttmps_max;
+       PL_tmps_floor           = proto_perl->Ttmps_floor;
+       Newz(50, PL_tmps_stack, PL_tmps_max, SV*);
+       i = 0;
+       while (i <= PL_tmps_ix) {
+           PL_tmps_stack[i]    = sv_dup_inc(proto_perl->Ttmps_stack[i]);
+           ++i;
+       }
+
+       /* next PUSHMARK() sets *(PL_markstack_ptr+1) */
+       PL_markstack_max = proto_perl->Tmarkstack_max;
+       Newz(54, PL_markstack, PL_markstack_max, I32);
+       PL_markstack_ptr        = PL_markstack + (proto_perl->Tmarkstack
+                                                 - proto_perl->Tmarkstack_ptr);
+       Copy(proto_perl->Tmarkstack, PL_markstack,
+            PL_markstack_ptr - PL_markstack + 1, I32);
+
+       /* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix]
+        * NOTE: unlike the others! */
+       PL_scopestack_ix        = proto_perl->Tscopestack_ix;
+       PL_scopestack_max       = proto_perl->Tscopestack_max;
+       Newz(54, PL_scopestack, PL_scopestack_max, I32);
+       Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
+
+       /* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix]
+        * NOTE: unlike the others! */
+       PL_savestack_ix         = proto_perl->Tsavestack_ix;
+       PL_savestack_max        = proto_perl->Tsavestack_max;
+       /*Newz(54, PL_savestack, PL_savestack_max, ANY);*/
+       PL_savestack            = savestack_dup(proto_perl->Tsavestack,
+                                               PL_savestack_ix,
+                                               PL_savestack_max);
+
+       /* next push_return() sets PL_retstack[PL_retstack_ix]
+        * NOTE: unlike the others! */
+       PL_retstack_ix          = proto_perl->Tretstack_ix;
+       PL_retstack_max         = proto_perl->Tretstack_max;
+       Newz(54, PL_retstack, PL_retstack_max, OP*);
+       Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32);
+
+       /* NOTE: stackinfo_dup() looks at PL_markstack */
+       PL_curstackinfo         = stackinfo_dup(proto_perl->Tcurstackinfo);
+
+       /* PL_curstack          = PL_curstackinfo->si_stack; */
+       PL_curstack             = av_dup(proto_perl->Tcurstack);
+       PL_mainstack            = av_dup(proto_perl->Tmainstack);
+
+       /* next PUSHs() etc. set *(PL_stack_sp+1) */
+       PL_stack_base           = AvARRAY(PL_curstack);
+       PL_stack_sp             = PL_stack_base + (proto_perl->Tstack_sp
+                                                  - proto_perl->Tstack_base);
+       PL_stack_max            = PL_stack_base + AvMAX(PL_curstack);
+    }
+    else {
+       init_stacks();
+    }
 
     PL_start_env       = proto_perl->Tstart_env;       /* XXXXXX */
     PL_top_env         = &PL_start_env;