Coro/Coro/clone.c

/* clone implementation, big, slow, useless, but not pointless */

static AV *
clone_av (pTHX_ AV *av)
{
  int i;
  AV *nav = newAV ();

  av_fill (nav, AvFILLp (av));

  for (i = 0; i <= AvFILLp (av); ++i)
    AvARRAY (nav)[i] = SvREFCNT_inc (AvARRAY (av)[i]);

  return nav;
}

static struct coro *
coro_clone (pTHX_ struct coro *coro)
{
  perl_slots *slot, *nslot;
  struct coro *ncoro;

  if (coro->flags & (CF_RUNNING | CF_NEW))
    croak ("Coro::State::clone cannot clone new or running states, caught");

  if (coro->cctx)
    croak ("Coro::State::clone cannot clone a state running on a custom C context, caught");

  /* TODO: maybe check slf_frame for prpeare_rransfer/check_nop? */

  slot = coro->slot;

  if (slot->curstackinfo->si_type != PERLSI_MAIN)
    croak ("Coro::State::clone cannot clone a state running on a non-main stack, caught");

  Newz (0, ncoro, 1, struct coro);
  Newz (0, nslot, 1, perl_slots);

  /* copy first, then fixup */
  *ncoro = *coro;
  *nslot = *slot;
  ncoro->slot = nslot;

  nslot->curstackinfo = new_stackinfo (slot->stack_max - slot->stack_sp + 1, slot->curstackinfo->si_cxmax);
  nslot->curstackinfo->si_type = PERLSI_MAIN;
  nslot->curstackinfo->si_cxix = slot->curstackinfo->si_cxix;
  nslot->curstack = nslot->curstackinfo->si_stack;
  ncoro->mainstack = nslot->curstack;

  nslot->stack_base = AvARRAY (nslot->curstack);
  nslot->stack_sp   = nslot->stack_base + (slot->stack_sp - slot->stack_base);
  nslot->stack_max  = nslot->stack_base + AvMAX (nslot->curstack);

  Copy (slot->stack_base, nslot->stack_base, slot->stack_sp - slot->stack_base + 1, SV *);
  Copy (slot->curstackinfo->si_cxstack, nslot->curstackinfo->si_cxstack, nslot->curstackinfo->si_cxix + 1, PERL_CONTEXT);

  New (50, nslot->tmps_stack, nslot->tmps_max, SV *);
  Copy (slot->tmps_stack, nslot->tmps_stack, slot->tmps_ix + 1, SV *);

  New (54, nslot->markstack, slot->markstack_max - slot->markstack + 1, I32);
  nslot->markstack_ptr = nslot->markstack + (slot->markstack_ptr - slot->markstack);
  nslot->markstack_max = nslot->markstack + (slot->markstack_max - slot->markstack);
  Copy (slot->markstack, nslot->markstack, slot->markstack_ptr - slot->markstack + 1, I32);

#ifdef SET_MARK_OFFSET
    //SET_MARK_OFFSET; /*TODO*/
#endif

  New (54, nslot->scopestack, slot->scopestack_max, I32);
  Copy (slot->scopestack, nslot->scopestack, slot->scopestack_ix + 1, I32);

  New (54, nslot->savestack, nslot->savestack_max, ANY);
  Copy (slot->savestack, nslot->savestack, slot->savestack_ix + 1, ANY);

#if !PERL_VERSION_ATLEAST (5,10,0)
  New (54, nslot->retstack, nslot->retstack_max, OP *);
  Copy (slot->retstack, nslot->retstack, slot->retstack_max, OP *);
#endif

  /* first fix up the padlists, by walking up our own saved state */
  {
    SV **sp = nslot->stack_sp;
    AV *av;
    CV *cv;
    int i;

    /* now do the ugly restore mess */
    while (expect_true (cv = (CV *)POPs))
      {
        /* cv will be refcnt_inc'ed twice by the following two loops */
        POPs;

        /* need to clone the padlist */
        /* this simplistic hack is most likely wrong */
        av = clone_av (aTHX_ (AV *)TOPs);
        AvREAL_off (av);

        for (i = 1; i <= AvFILLp (av); ++i)
          {
            SvREFCNT_dec (AvARRAY (av)[i]);
            AvARRAY (av)[i] = (SV *)clone_av (aTHX_ (AV *)AvARRAY (av)[i]);
            AvREIFY_only (AvARRAY (av)[i]);
          }

        TOPs = (SV *)av;

        POPs;
      }
  }

  /* easy things first, mortals */
  {
    int i;

    for (i = 0; i <= nslot->tmps_ix; ++i)
      SvREFCNT_inc (nslot->tmps_stack [i]);
  }

  /* now fix up the context stack, modelled after cx_dup */
  {
    I32 cxix = nslot->curstackinfo->si_cxix;
    PERL_CONTEXT *ccstk = nslot->curstackinfo->si_cxstack;

    while (expect_true (cxix >= 0))
      {
        PERL_CONTEXT *cx = &ccstk[cxix--];

        switch (CxTYPE (cx))
          {
            case CXt_SUBST:
              croak ("Coro::State::clone cannot clone a state inside a substitution context, caught");

            case CXt_SUB:
              if (cx->blk_sub.olddepth == 0)
                SvREFCNT_inc ((SV *)cx->blk_sub.cv);

              if (cx->blk_sub.hasargs)
                {
                  SvREFCNT_inc ((SV *)cx->blk_sub.argarray);
                  SvREFCNT_inc ((SV *)cx->blk_sub.savearray);
                }
              break;

            case CXt_EVAL:
              SvREFCNT_inc ((SV *)cx->blk_eval.old_namesv);
              SvREFCNT_inc ((SV *)cx->blk_eval.cur_text);
              break;

            case CXt_LOOP:
              /*TODO: cx->blk_loop.iterdata*/
              SvREFCNT_inc ((SV *)cx->blk_loop.itersave);
              SvREFCNT_inc ((SV *)cx->blk_loop.iterlval);
              SvREFCNT_inc ((SV *)cx->blk_loop.iterary);
              break;

            case CXt_FORMAT:
              croak ("Coro::State::clone cannot clone a state inside a format, caught");
              break;

            /* BLOCK, NULL etc. */
          }
      }
  }

  /* now fix up the save stack */
  /* modelled after ss_dup */

#define POPINT(ss,ix)   ((ss)[--(ix)].any_i32)
#define TOPINT(ss,ix)   ((ss)[ix].any_i32)
#define POPLONG(ss,ix)  ((ss)[--(ix)].any_long)
#define TOPLONG(ss,ix)  ((ss)[ix].any_long)
#define POPIV(ss,ix)    ((ss)[--(ix)].any_iv)
#define TOPIV(ss,ix)    ((ss)[ix].any_iv)
#define POPBOOL(ss,ix)  ((ss)[--(ix)].any_bool)
#define TOPBOOL(ss,ix)  ((ss)[ix].any_bool)
#define POPPTR(ss,ix)   ((ss)[--(ix)].any_ptr)
#define TOPPTR(ss,ix)   ((ss)[ix].any_ptr)
#define POPDPTR(ss,ix)  ((ss)[--(ix)].any_dptr)
#define TOPDPTR(ss,ix)  ((ss)[ix].any_dptr)
#define POPDXPTR(ss,ix) ((ss)[--(ix)].any_dxptr)
#define TOPDXPTR(ss,ix) ((ss)[ix].any_dxptr)

  {
    ANY * const ss      = nslot->savestack;
    const I32 max       = nslot->savestack_max;
    I32 ix              = nslot->savestack_ix;

    while (ix > 0)
      {
        const I32 type = POPINT (ss, ix);

        switch (type)
          {
            case SAVEt_HELEM:      /* hash element */
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              /* fall through */
            case SAVEt_ITEM:       /* normal string */
            case SAVEt_SV:         /* scalar reference */
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              /* fall through */
            case SAVEt_FREESV:
            case SAVEt_MORTALIZESV:
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              break;

            case SAVEt_SHARED_PVREF:       /* char* in shared space */
              abort ();
#if 0
              c = (char *) POPPTR (ss, ix);
              TOPPTR (ss, ix) = savesharedpv (c);
              ptr = POPPTR (ss, ix);
              TOPPTR (ss, ix) = any_dup (ptr, proto_perl);
#endif
              break;
            case SAVEt_GENERIC_SVREF:      /* generic sv */
            case SAVEt_SVREF:      /* scalar reference */
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              POPPTR (ss, ix);
              break;

            case SAVEt_HV:         /* hash reference */
            case SAVEt_AV:         /* array reference */
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              /* fall through */
            case SAVEt_COMPPAD:
            case SAVEt_NSTAB:
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              break;

            case SAVEt_INT:        /* int reference */
              POPPTR (ss, ix);
              POPINT (ss, ix);
              break;

            case SAVEt_LONG:       /* long reference */
              POPPTR (ss, ix);
              /* fall through */
            case SAVEt_CLEARSV:
              POPLONG (ss, ix);
              break;

            case SAVEt_I32:        /* I32 reference */
            case SAVEt_I16:        /* I16 reference */
            case SAVEt_I8:         /* I8 reference */
            case SAVEt_COP_ARYBASE:        /* call CopARYBASE_set */
              POPPTR (ss, ix);
              POPINT (ss, ix);
              break;

            case SAVEt_IV:         /* IV reference */
              POPPTR (ss, ix);
              POPIV (ss, ix);
              break;

            case SAVEt_HPTR:       /* HV* reference */
            case SAVEt_APTR:       /* AV* reference */
            case SAVEt_SPTR:       /* SV* reference */
              POPPTR (ss, ix);
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              break;

            case SAVEt_VPTR:       /* random* reference */
              POPPTR (ss, ix);
              POPPTR (ss, ix);
              break;
            case SAVEt_GENERIC_PVREF:      /* generic char* */
            case SAVEt_PPTR:       /* char* reference */
              POPPTR (ss, ix);
              TOPPTR (ss, ix) = savepv ((char *) POPPTR (ss, ix));
              break;

            case SAVEt_GP:         /* scalar reference */
              ((GP *) POPPTR (ss, ix))->gp_refcnt++;
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              break;

            case SAVEt_FREEOP:
              abort ();
#if 0
              ptr = POPPTR (ss, ix);
              if (ptr && (((OP *) ptr)->op_private & OPpREFCOUNTED))
                {
                  /* these are assumed to be refcounted properly */
                  OP *o;

                  switch (((OP *) ptr)->op_type)
                    {
                      case OP_LEAVESUB:
                      case OP_LEAVESUBLV:
                      case OP_LEAVEEVAL:
                      case OP_LEAVE:
                      case OP_SCOPE:
                      case OP_LEAVEWRITE:
                        TOPPTR (ss, ix) = ptr;
                        o = (OP *) ptr;
                        OP_REFCNT_LOCK;
                        (void) OpREFCNT_inc (o);
                        OP_REFCNT_UNLOCK;
                        break;
                      default:
                        TOPPTR (ss, ix) = NULL;
                        break;
                    }
                }
              else
                TOPPTR (ss, ix) = NULL;
#endif
              break;

            case SAVEt_FREEPV:
              TOPPTR (ss, ix) = savepv ((char *) POPPTR (ss, ix));
              break;

            case SAVEt_DELETE:
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              TOPPTR (ss, ix) = savepv ((char *) POPPTR (ss, ix));
              /* fall through */
            case SAVEt_STACK_POS:  /* Position on Perl stack */
              POPINT (ss, ix);
              break;

            case SAVEt_DESTRUCTOR:
              POPPTR (ss, ix);
              POPDPTR (ss, ix);
              break;

            case SAVEt_DESTRUCTOR_X:
              POPPTR (ss, ix);
              POPDXPTR (ss, ix);
              break;

            case SAVEt_REGCONTEXT:
            case SAVEt_ALLOC:
              ix = POPINT (ss, ix);
              break;

            case SAVEt_AELEM:      /* array element */
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              POPINT (ss, ix);
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              break;
            case SAVEt_OP:
              POPPTR (ss, ix);
              break;
            case SAVEt_HINTS:
              abort ();
#if 0
              {
                int i = POPINT (ss, ix);
                void *ptr = POPPTR (ss, ix);
                if (ptr)
                  ((struct refcounted_he *)ptr)->refcounted_he_refcnt++;

                if (i & HINT_LOCALIZE_HH)
                  SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              }
#endif
              break;

            case SAVEt_PADSV:
              POPLONG (ss, ix);
              POPPTR (ss, ix);
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              break;

            case SAVEt_BOOL:
              POPPTR (ss, ix);
              POPBOOL (ss, ix);
              break;

            case SAVEt_SET_SVFLAGS:
              POPINT (ss, ix);
              POPINT (ss, ix);
              SvREFCNT_inc ((SV *) POPPTR (ss, ix));
              break;

            case SAVEt_RE_STATE:
              abort ();
#if 0
              {
                const struct re_save_state *const old_state = (struct re_save_state *) (ss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
                struct re_save_state *const new_state = (struct re_save_state *) (ss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);

                Copy (old_state, new_state, 1, struct re_save_state);

                ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;

                new_state->re_state_bostr = pv_dup (old_state->re_state_bostr);
                new_state->re_state_reginput = pv_dup (old_state->re_state_reginput);
                new_state->re_state_regeol = pv_dup (old_state->re_state_regeol);
                new_state->re_state_regoffs = (regexp_paren_pair *) any_dup (old_state->re_state_regoffs, proto_perl);
                new_state->re_state_reglastparen = (U32 *) any_dup (old_state->re_state_reglastparen, proto_perl);
                new_state->re_state_reglastcloseparen = (U32 *) any_dup (old_state->re_state_reglastcloseparen, proto_perl);
                /* XXX This just has to be broken. The old save_re_context
                   code did SAVEGENERICPV(PL_reg_start_tmp);
                   PL_reg_start_tmp is char **.
                   Look above to what the dup code does for
                   SAVEt_GENERIC_PVREF
                   It can never have worked.
                   So this is merely a faithful copy of the exiting bug:  */
                new_state->re_state_reg_start_tmp = (char **) pv_dup ((char *) old_state->re_state_reg_start_tmp);
                /* I assume that it only ever "worked" because no-one called
                   (pseudo)fork while the regexp engine had re-entered itself.
                 */
#ifdef PERL_OLD_COPY_ON_WRITE
                new_state->re_state_nrs = sv_dup (old_state->re_state_nrs, param);
#endif
                new_state->re_state_reg_magic = (MAGIC *) any_dup (old_state->re_state_reg_magic, proto_perl);
                new_state->re_state_reg_oldcurpm = (PMOP *) any_dup (old_state->re_state_reg_oldcurpm, proto_perl);
                new_state->re_state_reg_curpm = (PMOP *) any_dup (old_state->re_state_reg_curpm, proto_perl);
                new_state->re_state_reg_oldsaved = pv_dup (old_state->re_state_reg_oldsaved);
                new_state->re_state_reg_poscache = pv_dup (old_state->re_state_reg_poscache);
                new_state->re_state_reg_starttry = pv_dup (old_state->re_state_reg_starttry);
                break;
              }
#endif

            case SAVEt_COMPILE_WARNINGS:
              abort ();
#if 0
              ptr = POPPTR (ss, ix);
              TOPPTR (ss, ix) = DUP_WARNINGS ((STRLEN *) ptr);
              break;
#endif

            case SAVEt_PARSER:
              abort ();
#if 0
              ptr = POPPTR (ss, ix);
              TOPPTR (ss, ix) = parser_dup ((const yy_parser *) ptr, param);
              break;
#endif
            default:
              croak ("panic: ss_dup inconsistency (%" IVdf ")", (IV) type);
          }
      }
  }

  SvREFCNT_inc (nslot->defsv);
  SvREFCNT_inc (nslot->defav);
  SvREFCNT_inc (nslot->errsv);
  SvREFCNT_inc (nslot->irsgv);

  SvREFCNT_inc (nslot->defoutgv);
  SvREFCNT_inc (nslot->rs);
  SvREFCNT_inc (nslot->compcv);
  SvREFCNT_inc (nslot->diehook);
  SvREFCNT_inc (nslot->warnhook);

  SvREFCNT_inc (ncoro->startcv);
  SvREFCNT_inc (ncoro->args);
  SvREFCNT_inc (ncoro->except);

  return ncoro;
}
Revision:	1.7
Committed:	Sat Dec 13 19:18:36 2008 UTC (15 years, 5 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rel-5_131, rel-6_13, rel-5_15, rel-5_14, rel-5_132
Changes since 1.6:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	/* clone implementation, big, slow, useless, but not pointless */
2
3			static AV *
4	root	1.5	clone_av (pTHX_ AV *av)
5	root	1.1	{
6			int i;
7			AV *nav = newAV ();
8
9			av_fill (nav, AvFILLp (av));
10
11			for (i = 0; i <= AvFILLp (av); ++i)
12			AvARRAY (nav)[i] = SvREFCNT_inc (AvARRAY (av)[i]);
13
14			return nav;
15			}
16
17			static struct coro *
18	root	1.5	coro_clone (pTHX_ struct coro *coro)
19	root	1.1	{
20			perl_slots slot, nslot;
21			struct coro *ncoro;
22
23			if (coro->flags & (CF_RUNNING \| CF_NEW))
24			croak ("Coro::State::clone cannot clone new or running states, caught");
25
26			if (coro->cctx)
27			croak ("Coro::State::clone cannot clone a state running on a custom C context, caught");
28
29	root	1.6	/* TODO: maybe check slf_frame for prpeare_rransfer/check_nop? */
30
31	root	1.1	slot = coro->slot;
32
33			if (slot->curstackinfo->si_type != PERLSI_MAIN)
34			croak ("Coro::State::clone cannot clone a state running on a non-main stack, caught");
35
36			Newz (0, ncoro, 1, struct coro);
37			Newz (0, nslot, 1, perl_slots);
38
39			/* copy first, then fixup */
40			ncoro = coro;
41			nslot = slot;
42			ncoro->slot = nslot;
43
44			nslot->curstackinfo = new_stackinfo (slot->stack_max - slot->stack_sp + 1, slot->curstackinfo->si_cxmax);
45			nslot->curstackinfo->si_type = PERLSI_MAIN;
46			nslot->curstackinfo->si_cxix = slot->curstackinfo->si_cxix;
47			nslot->curstack = nslot->curstackinfo->si_stack;
48			ncoro->mainstack = nslot->curstack;
49
50			nslot->stack_base = AvARRAY (nslot->curstack);
51			nslot->stack_sp = nslot->stack_base + (slot->stack_sp - slot->stack_base);
52			nslot->stack_max = nslot->stack_base + AvMAX (nslot->curstack);
53
54			Copy (slot->stack_base, nslot->stack_base, slot->stack_sp - slot->stack_base + 1, SV *);
55			Copy (slot->curstackinfo->si_cxstack, nslot->curstackinfo->si_cxstack, nslot->curstackinfo->si_cxix + 1, PERL_CONTEXT);
56
57			New (50, nslot->tmps_stack, nslot->tmps_max, SV *);
58			Copy (slot->tmps_stack, nslot->tmps_stack, slot->tmps_ix + 1, SV *);
59
60			New (54, nslot->markstack, slot->markstack_max - slot->markstack + 1, I32);
61			nslot->markstack_ptr = nslot->markstack + (slot->markstack_ptr - slot->markstack);
62			nslot->markstack_max = nslot->markstack + (slot->markstack_max - slot->markstack);
63			Copy (slot->markstack, nslot->markstack, slot->markstack_ptr - slot->markstack + 1, I32);
64
65			#ifdef SET_MARK_OFFSET
66			//SET_MARK_OFFSET; /TODO/
67			#endif
68
69			New (54, nslot->scopestack, slot->scopestack_max, I32);
70			Copy (slot->scopestack, nslot->scopestack, slot->scopestack_ix + 1, I32);
71
72			New (54, nslot->savestack, nslot->savestack_max, ANY);
73			Copy (slot->savestack, nslot->savestack, slot->savestack_ix + 1, ANY);
74
75			#if !PERL_VERSION_ATLEAST (5,10,0)
76	root	1.5	New (54, nslot->retstack, nslot->retstack_max, OP *);
77	root	1.1	Copy (slot->retstack, nslot->retstack, slot->retstack_max, OP *);
78			#endif
79
80			/* first fix up the padlists, by walking up our own saved state */
81			{
82			SV **sp = nslot->stack_sp;
83			AV *av;
84			CV *cv;
85			int i;
86
87			/* now do the ugly restore mess */
88			while (expect_true (cv = (CV *)POPs))
89			{
90	root	1.6	/* cv will be refcnt_inc'ed twice by the following two loops */
91	root	1.1	POPs;
92
93	root	1.6	/* need to clone the padlist */
94	root	1.7	/* this simplistic hack is most likely wrong */
95	root	1.5	av = clone_av (aTHX_ (AV *)TOPs);
96	root	1.1	AvREAL_off (av);
97
98			for (i = 1; i <= AvFILLp (av); ++i)
99			{
100			SvREFCNT_dec (AvARRAY (av)[i]);
101	root	1.5	AvARRAY (av)[i] = (SV )clone_av (aTHX_ (AV )AvARRAY (av)[i]);
102	root	1.4	AvREIFY_only (AvARRAY (av)[i]);
103	root	1.1	}
104
105			TOPs = (SV *)av;
106
107			POPs;
108			}
109			}
110
111			/* easy things first, mortals */
112			{
113			int i;
114
115			for (i = 0; i <= nslot->tmps_ix; ++i)
116			SvREFCNT_inc (nslot->tmps_stack [i]);
117			}
118
119			/* now fix up the context stack, modelled after cx_dup */
120			{
121			I32 cxix = nslot->curstackinfo->si_cxix;
122			PERL_CONTEXT *ccstk = nslot->curstackinfo->si_cxstack;
123
124			while (expect_true (cxix >= 0))
125			{
126			PERL_CONTEXT *cx = &ccstk[cxix--];
127
128			switch (CxTYPE (cx))
129			{
130			case CXt_SUBST:
131			croak ("Coro::State::clone cannot clone a state inside a substitution context, caught");
132
133			case CXt_SUB:
134			if (cx->blk_sub.olddepth == 0)
135			SvREFCNT_inc ((SV *)cx->blk_sub.cv);
136	root	1.3
137	root	1.1	if (cx->blk_sub.hasargs)
138			{
139			SvREFCNT_inc ((SV *)cx->blk_sub.argarray);
140			SvREFCNT_inc ((SV *)cx->blk_sub.savearray);
141			}
142			break;
143
144			case CXt_EVAL:
145			SvREFCNT_inc ((SV *)cx->blk_eval.old_namesv);
146			SvREFCNT_inc ((SV *)cx->blk_eval.cur_text);
147			break;
148
149			case CXt_LOOP:
150			/TODO: cx->blk_loop.iterdata/
151			SvREFCNT_inc ((SV *)cx->blk_loop.itersave);
152			SvREFCNT_inc ((SV *)cx->blk_loop.iterlval);
153			SvREFCNT_inc ((SV *)cx->blk_loop.iterary);
154			break;
155
156			case CXt_FORMAT:
157			croak ("Coro::State::clone cannot clone a state inside a format, caught");
158			break;
159
160			/* BLOCK, NULL etc. */
161			}
162			}
163			}
164
165			/* now fix up the save stack */
166			/* modelled after ss_dup */
167
168			#define POPINT(ss,ix) ((ss)[--(ix)].any_i32)
169			#define TOPINT(ss,ix) ((ss)[ix].any_i32)
170			#define POPLONG(ss,ix) ((ss)[--(ix)].any_long)
171			#define TOPLONG(ss,ix) ((ss)[ix].any_long)
172			#define POPIV(ss,ix) ((ss)[--(ix)].any_iv)
173			#define TOPIV(ss,ix) ((ss)[ix].any_iv)
174			#define POPBOOL(ss,ix) ((ss)[--(ix)].any_bool)
175			#define TOPBOOL(ss,ix) ((ss)[ix].any_bool)
176			#define POPPTR(ss,ix) ((ss)[--(ix)].any_ptr)
177			#define TOPPTR(ss,ix) ((ss)[ix].any_ptr)
178			#define POPDPTR(ss,ix) ((ss)[--(ix)].any_dptr)
179			#define TOPDPTR(ss,ix) ((ss)[ix].any_dptr)
180			#define POPDXPTR(ss,ix) ((ss)[--(ix)].any_dxptr)
181			#define TOPDXPTR(ss,ix) ((ss)[ix].any_dxptr)
182
183			{
184			ANY * const ss = nslot->savestack;
185			const I32 max = nslot->savestack_max;
186			I32 ix = nslot->savestack_ix;
187
188			while (ix > 0)
189			{
190			const I32 type = POPINT (ss, ix);
191
192			switch (type)
193			{
194			case SAVEt_HELEM: /* hash element */
195			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
196			/* fall through */
197			case SAVEt_ITEM: /* normal string */
198			case SAVEt_SV: /* scalar reference */
199			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
200			/* fall through */
201			case SAVEt_FREESV:
202			case SAVEt_MORTALIZESV:
203			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
204			break;
205
206			case SAVEt_SHARED_PVREF: /* char* in shared space */
207			abort ();
208			#if 0
209			c = (char *) POPPTR (ss, ix);
210			TOPPTR (ss, ix) = savesharedpv (c);
211			ptr = POPPTR (ss, ix);
212			TOPPTR (ss, ix) = any_dup (ptr, proto_perl);
213			#endif
214			break;
215			case SAVEt_GENERIC_SVREF: /* generic sv */
216			case SAVEt_SVREF: /* scalar reference */
217			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
218			POPPTR (ss, ix);
219			break;
220
221			case SAVEt_HV: /* hash reference */
222			case SAVEt_AV: /* array reference */
223			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
224			/* fall through */
225			case SAVEt_COMPPAD:
226			case SAVEt_NSTAB:
227			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
228			break;
229
230			case SAVEt_INT: /* int reference */
231			POPPTR (ss, ix);
232			POPINT (ss, ix);
233			break;
234
235			case SAVEt_LONG: /* long reference */
236			POPPTR (ss, ix);
237			/* fall through */
238			case SAVEt_CLEARSV:
239			POPLONG (ss, ix);
240			break;
241
242			case SAVEt_I32: /* I32 reference */
243			case SAVEt_I16: /* I16 reference */
244			case SAVEt_I8: /* I8 reference */
245			case SAVEt_COP_ARYBASE: /* call CopARYBASE_set */
246			POPPTR (ss, ix);
247			POPINT (ss, ix);
248			break;
249
250			case SAVEt_IV: /* IV reference */
251			POPPTR (ss, ix);
252			POPIV (ss, ix);
253			break;
254
255			case SAVEt_HPTR: /* HV* reference */
256			case SAVEt_APTR: /* AV* reference */
257			case SAVEt_SPTR: /* SV* reference */
258			POPPTR (ss, ix);
259			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
260			break;
261
262			case SAVEt_VPTR: /* random* reference */
263			POPPTR (ss, ix);
264			POPPTR (ss, ix);
265			break;
266			case SAVEt_GENERIC_PVREF: /* generic char* */
267			case SAVEt_PPTR: /* char* reference */
268			POPPTR (ss, ix);
269			TOPPTR (ss, ix) = savepv ((char *) POPPTR (ss, ix));
270			break;
271
272			case SAVEt_GP: /* scalar reference */
273			((GP *) POPPTR (ss, ix))->gp_refcnt++;
274			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
275			break;
276
277			case SAVEt_FREEOP:
278			abort ();
279			#if 0
280			ptr = POPPTR (ss, ix);
281			if (ptr && (((OP *) ptr)->op_private & OPpREFCOUNTED))
282			{
283			/* these are assumed to be refcounted properly */
284			OP *o;
285
286			switch (((OP *) ptr)->op_type)
287			{
288			case OP_LEAVESUB:
289			case OP_LEAVESUBLV:
290			case OP_LEAVEEVAL:
291			case OP_LEAVE:
292			case OP_SCOPE:
293			case OP_LEAVEWRITE:
294			TOPPTR (ss, ix) = ptr;
295			o = (OP *) ptr;
296			OP_REFCNT_LOCK;
297			(void) OpREFCNT_inc (o);
298			OP_REFCNT_UNLOCK;
299			break;
300			default:
301			TOPPTR (ss, ix) = NULL;
302			break;
303			}
304			}
305			else
306			TOPPTR (ss, ix) = NULL;
307			#endif
308			break;
309
310			case SAVEt_FREEPV:
311			TOPPTR (ss, ix) = savepv ((char *) POPPTR (ss, ix));
312			break;
313
314			case SAVEt_DELETE:
315			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
316			TOPPTR (ss, ix) = savepv ((char *) POPPTR (ss, ix));
317			/* fall through */
318			case SAVEt_STACK_POS: /* Position on Perl stack */
319			POPINT (ss, ix);
320			break;
321
322			case SAVEt_DESTRUCTOR:
323			POPPTR (ss, ix);
324			POPDPTR (ss, ix);
325			break;
326
327			case SAVEt_DESTRUCTOR_X:
328			POPPTR (ss, ix);
329			POPDXPTR (ss, ix);
330			break;
331
332			case SAVEt_REGCONTEXT:
333			case SAVEt_ALLOC:
334			ix = POPINT (ss, ix);
335			break;
336
337			case SAVEt_AELEM: /* array element */
338			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
339			POPINT (ss, ix);
340			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
341			break;
342			case SAVEt_OP:
343			POPPTR (ss, ix);
344			break;
345			case SAVEt_HINTS:
346			abort ();
347			#if 0
348			{
349			int i = POPINT (ss, ix);
350			void *ptr = POPPTR (ss, ix);
351			if (ptr)
352			((struct refcounted_he *)ptr)->refcounted_he_refcnt++;
353
354			if (i & HINT_LOCALIZE_HH)
355			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
356			}
357			#endif
358			break;
359
360			case SAVEt_PADSV:
361			POPLONG (ss, ix);
362			POPPTR (ss, ix);
363			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
364			break;
365
366			case SAVEt_BOOL:
367			POPPTR (ss, ix);
368			POPBOOL (ss, ix);
369			break;
370
371			case SAVEt_SET_SVFLAGS:
372			POPINT (ss, ix);
373			POPINT (ss, ix);
374			SvREFCNT_inc ((SV *) POPPTR (ss, ix));
375			break;
376
377			case SAVEt_RE_STATE:
378			abort ();
379			#if 0
380			{
381			const struct re_save_state const old_state = (struct re_save_state ) (ss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
382			struct re_save_state const new_state = (struct re_save_state ) (ss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
383
384			Copy (old_state, new_state, 1, struct re_save_state);
385
386			ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
387
388			new_state->re_state_bostr = pv_dup (old_state->re_state_bostr);
389			new_state->re_state_reginput = pv_dup (old_state->re_state_reginput);
390			new_state->re_state_regeol = pv_dup (old_state->re_state_regeol);
391			new_state->re_state_regoffs = (regexp_paren_pair *) any_dup (old_state->re_state_regoffs, proto_perl);
392			new_state->re_state_reglastparen = (U32 *) any_dup (old_state->re_state_reglastparen, proto_perl);
393			new_state->re_state_reglastcloseparen = (U32 *) any_dup (old_state->re_state_reglastcloseparen, proto_perl);
394			/* XXX This just has to be broken. The old save_re_context
395			code did SAVEGENERICPV(PL_reg_start_tmp);
396			PL_reg_start_tmp is char **.
397			Look above to what the dup code does for
398			SAVEt_GENERIC_PVREF
399			It can never have worked.
400			So this is merely a faithful copy of the exiting bug: */
401			new_state->re_state_reg_start_tmp = (char *) pv_dup ((char ) old_state->re_state_reg_start_tmp);
402			/* I assume that it only ever "worked" because no-one called
403			(pseudo)fork while the regexp engine had re-entered itself.
404			*/
405			#ifdef PERL_OLD_COPY_ON_WRITE
406			new_state->re_state_nrs = sv_dup (old_state->re_state_nrs, param);
407			#endif
408			new_state->re_state_reg_magic = (MAGIC *) any_dup (old_state->re_state_reg_magic, proto_perl);
409			new_state->re_state_reg_oldcurpm = (PMOP *) any_dup (old_state->re_state_reg_oldcurpm, proto_perl);
410			new_state->re_state_reg_curpm = (PMOP *) any_dup (old_state->re_state_reg_curpm, proto_perl);
411			new_state->re_state_reg_oldsaved = pv_dup (old_state->re_state_reg_oldsaved);
412			new_state->re_state_reg_poscache = pv_dup (old_state->re_state_reg_poscache);
413			new_state->re_state_reg_starttry = pv_dup (old_state->re_state_reg_starttry);
414			break;
415			}
416			#endif
417
418			case SAVEt_COMPILE_WARNINGS:
419			abort ();
420			#if 0
421			ptr = POPPTR (ss, ix);
422			TOPPTR (ss, ix) = DUP_WARNINGS ((STRLEN *) ptr);
423			break;
424			#endif
425
426			case SAVEt_PARSER:
427			abort ();
428			#if 0
429			ptr = POPPTR (ss, ix);
430			TOPPTR (ss, ix) = parser_dup ((const yy_parser *) ptr, param);
431			break;
432			#endif
433			default:
434			croak ("panic: ss_dup inconsistency (%" IVdf ")", (IV) type);
435			}
436			}
437			}
438
439			SvREFCNT_inc (nslot->defsv);
440			SvREFCNT_inc (nslot->defav);
441			SvREFCNT_inc (nslot->errsv);
442			SvREFCNT_inc (nslot->irsgv);
443
444			SvREFCNT_inc (nslot->defoutgv);
445			SvREFCNT_inc (nslot->rs);
446			SvREFCNT_inc (nslot->compcv);
447			SvREFCNT_inc (nslot->diehook);
448			SvREFCNT_inc (nslot->warnhook);
449
450			SvREFCNT_inc (ncoro->startcv);
451			SvREFCNT_inc (ncoro->args);
452			SvREFCNT_inc (ncoro->except);
453
454			return ncoro;
455			}