diff options
| -rw-r--r-- | cop.h | 9 | ||||
| -rw-r--r-- | deb.c | 2 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | sv.c | 149 |
4 files changed, 123 insertions, 39 deletions
@@ -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) @@ -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; @@ -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; @@ -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; |