1*0Sstevel@tonic-gate /* scope.c
2*0Sstevel@tonic-gate *
3*0Sstevel@tonic-gate * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4*0Sstevel@tonic-gate * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
5*0Sstevel@tonic-gate *
6*0Sstevel@tonic-gate * You may distribute under the terms of either the GNU General Public
7*0Sstevel@tonic-gate * License or the Artistic License, as specified in the README file.
8*0Sstevel@tonic-gate *
9*0Sstevel@tonic-gate */
10*0Sstevel@tonic-gate
11*0Sstevel@tonic-gate /*
12*0Sstevel@tonic-gate * "For the fashion of Minas Tirith was such that it was built on seven
13*0Sstevel@tonic-gate * levels..."
14*0Sstevel@tonic-gate */
15*0Sstevel@tonic-gate
16*0Sstevel@tonic-gate #include "EXTERN.h"
17*0Sstevel@tonic-gate #define PERL_IN_SCOPE_C
18*0Sstevel@tonic-gate #include "perl.h"
19*0Sstevel@tonic-gate
20*0Sstevel@tonic-gate #if defined(PERL_FLEXIBLE_EXCEPTIONS)
21*0Sstevel@tonic-gate void *
Perl_default_protect(pTHX_ volatile JMPENV * pcur_env,int * excpt,protect_body_t body,...)22*0Sstevel@tonic-gate Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
23*0Sstevel@tonic-gate protect_body_t body, ...)
24*0Sstevel@tonic-gate {
25*0Sstevel@tonic-gate void *ret;
26*0Sstevel@tonic-gate va_list args;
27*0Sstevel@tonic-gate va_start(args, body);
28*0Sstevel@tonic-gate ret = vdefault_protect(pcur_env, excpt, body, &args);
29*0Sstevel@tonic-gate va_end(args);
30*0Sstevel@tonic-gate return ret;
31*0Sstevel@tonic-gate }
32*0Sstevel@tonic-gate
33*0Sstevel@tonic-gate void *
Perl_vdefault_protect(pTHX_ volatile JMPENV * pcur_env,int * excpt,protect_body_t body,va_list * args)34*0Sstevel@tonic-gate Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
35*0Sstevel@tonic-gate protect_body_t body, va_list *args)
36*0Sstevel@tonic-gate {
37*0Sstevel@tonic-gate int ex;
38*0Sstevel@tonic-gate void *ret;
39*0Sstevel@tonic-gate
40*0Sstevel@tonic-gate JMPENV_PUSH(ex);
41*0Sstevel@tonic-gate if (ex)
42*0Sstevel@tonic-gate ret = NULL;
43*0Sstevel@tonic-gate else
44*0Sstevel@tonic-gate ret = CALL_FPTR(body)(aTHX_ *args);
45*0Sstevel@tonic-gate *excpt = ex;
46*0Sstevel@tonic-gate JMPENV_POP;
47*0Sstevel@tonic-gate return ret;
48*0Sstevel@tonic-gate }
49*0Sstevel@tonic-gate #endif
50*0Sstevel@tonic-gate
51*0Sstevel@tonic-gate SV**
Perl_stack_grow(pTHX_ SV ** sp,SV ** p,int n)52*0Sstevel@tonic-gate Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
53*0Sstevel@tonic-gate {
54*0Sstevel@tonic-gate PL_stack_sp = sp;
55*0Sstevel@tonic-gate #ifndef STRESS_REALLOC
56*0Sstevel@tonic-gate av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
57*0Sstevel@tonic-gate #else
58*0Sstevel@tonic-gate av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
59*0Sstevel@tonic-gate #endif
60*0Sstevel@tonic-gate return PL_stack_sp;
61*0Sstevel@tonic-gate }
62*0Sstevel@tonic-gate
63*0Sstevel@tonic-gate #ifndef STRESS_REALLOC
64*0Sstevel@tonic-gate #define GROW(old) ((old) * 3 / 2)
65*0Sstevel@tonic-gate #else
66*0Sstevel@tonic-gate #define GROW(old) ((old) + 1)
67*0Sstevel@tonic-gate #endif
68*0Sstevel@tonic-gate
69*0Sstevel@tonic-gate PERL_SI *
Perl_new_stackinfo(pTHX_ I32 stitems,I32 cxitems)70*0Sstevel@tonic-gate Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
71*0Sstevel@tonic-gate {
72*0Sstevel@tonic-gate PERL_SI *si;
73*0Sstevel@tonic-gate New(56, si, 1, PERL_SI);
74*0Sstevel@tonic-gate si->si_stack = newAV();
75*0Sstevel@tonic-gate AvREAL_off(si->si_stack);
76*0Sstevel@tonic-gate av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0);
77*0Sstevel@tonic-gate AvALLOC(si->si_stack)[0] = &PL_sv_undef;
78*0Sstevel@tonic-gate AvFILLp(si->si_stack) = 0;
79*0Sstevel@tonic-gate si->si_prev = 0;
80*0Sstevel@tonic-gate si->si_next = 0;
81*0Sstevel@tonic-gate si->si_cxmax = cxitems - 1;
82*0Sstevel@tonic-gate si->si_cxix = -1;
83*0Sstevel@tonic-gate si->si_type = PERLSI_UNDEF;
84*0Sstevel@tonic-gate New(56, si->si_cxstack, cxitems, PERL_CONTEXT);
85*0Sstevel@tonic-gate /* Without any kind of initialising PUSHSUBST()
86*0Sstevel@tonic-gate * in pp_subst() will read uninitialised heap. */
87*0Sstevel@tonic-gate Poison(si->si_cxstack, cxitems, PERL_CONTEXT);
88*0Sstevel@tonic-gate return si;
89*0Sstevel@tonic-gate }
90*0Sstevel@tonic-gate
91*0Sstevel@tonic-gate I32
Perl_cxinc(pTHX)92*0Sstevel@tonic-gate Perl_cxinc(pTHX)
93*0Sstevel@tonic-gate {
94*0Sstevel@tonic-gate IV old_max = cxstack_max;
95*0Sstevel@tonic-gate cxstack_max = GROW(cxstack_max);
96*0Sstevel@tonic-gate Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */
97*0Sstevel@tonic-gate /* Without any kind of initialising deep enough recursion
98*0Sstevel@tonic-gate * will end up reading uninitialised PERL_CONTEXTs. */
99*0Sstevel@tonic-gate Poison(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
100*0Sstevel@tonic-gate return cxstack_ix + 1;
101*0Sstevel@tonic-gate }
102*0Sstevel@tonic-gate
103*0Sstevel@tonic-gate void
Perl_push_return(pTHX_ OP * retop)104*0Sstevel@tonic-gate Perl_push_return(pTHX_ OP *retop)
105*0Sstevel@tonic-gate {
106*0Sstevel@tonic-gate if (PL_retstack_ix == PL_retstack_max) {
107*0Sstevel@tonic-gate PL_retstack_max = GROW(PL_retstack_max);
108*0Sstevel@tonic-gate Renew(PL_retstack, PL_retstack_max, OP*);
109*0Sstevel@tonic-gate }
110*0Sstevel@tonic-gate PL_retstack[PL_retstack_ix++] = retop;
111*0Sstevel@tonic-gate }
112*0Sstevel@tonic-gate
113*0Sstevel@tonic-gate OP *
Perl_pop_return(pTHX)114*0Sstevel@tonic-gate Perl_pop_return(pTHX)
115*0Sstevel@tonic-gate {
116*0Sstevel@tonic-gate if (PL_retstack_ix > 0)
117*0Sstevel@tonic-gate return PL_retstack[--PL_retstack_ix];
118*0Sstevel@tonic-gate else
119*0Sstevel@tonic-gate return Nullop;
120*0Sstevel@tonic-gate }
121*0Sstevel@tonic-gate
122*0Sstevel@tonic-gate void
Perl_push_scope(pTHX)123*0Sstevel@tonic-gate Perl_push_scope(pTHX)
124*0Sstevel@tonic-gate {
125*0Sstevel@tonic-gate if (PL_scopestack_ix == PL_scopestack_max) {
126*0Sstevel@tonic-gate PL_scopestack_max = GROW(PL_scopestack_max);
127*0Sstevel@tonic-gate Renew(PL_scopestack, PL_scopestack_max, I32);
128*0Sstevel@tonic-gate }
129*0Sstevel@tonic-gate PL_scopestack[PL_scopestack_ix++] = PL_savestack_ix;
130*0Sstevel@tonic-gate
131*0Sstevel@tonic-gate }
132*0Sstevel@tonic-gate
133*0Sstevel@tonic-gate void
Perl_pop_scope(pTHX)134*0Sstevel@tonic-gate Perl_pop_scope(pTHX)
135*0Sstevel@tonic-gate {
136*0Sstevel@tonic-gate I32 oldsave = PL_scopestack[--PL_scopestack_ix];
137*0Sstevel@tonic-gate LEAVE_SCOPE(oldsave);
138*0Sstevel@tonic-gate }
139*0Sstevel@tonic-gate
140*0Sstevel@tonic-gate void
Perl_markstack_grow(pTHX)141*0Sstevel@tonic-gate Perl_markstack_grow(pTHX)
142*0Sstevel@tonic-gate {
143*0Sstevel@tonic-gate I32 oldmax = PL_markstack_max - PL_markstack;
144*0Sstevel@tonic-gate I32 newmax = GROW(oldmax);
145*0Sstevel@tonic-gate
146*0Sstevel@tonic-gate Renew(PL_markstack, newmax, I32);
147*0Sstevel@tonic-gate PL_markstack_ptr = PL_markstack + oldmax;
148*0Sstevel@tonic-gate PL_markstack_max = PL_markstack + newmax;
149*0Sstevel@tonic-gate }
150*0Sstevel@tonic-gate
151*0Sstevel@tonic-gate void
Perl_savestack_grow(pTHX)152*0Sstevel@tonic-gate Perl_savestack_grow(pTHX)
153*0Sstevel@tonic-gate {
154*0Sstevel@tonic-gate PL_savestack_max = GROW(PL_savestack_max) + 4;
155*0Sstevel@tonic-gate Renew(PL_savestack, PL_savestack_max, ANY);
156*0Sstevel@tonic-gate }
157*0Sstevel@tonic-gate
158*0Sstevel@tonic-gate void
Perl_savestack_grow_cnt(pTHX_ I32 need)159*0Sstevel@tonic-gate Perl_savestack_grow_cnt(pTHX_ I32 need)
160*0Sstevel@tonic-gate {
161*0Sstevel@tonic-gate PL_savestack_max = PL_savestack_ix + need;
162*0Sstevel@tonic-gate Renew(PL_savestack, PL_savestack_max, ANY);
163*0Sstevel@tonic-gate }
164*0Sstevel@tonic-gate
165*0Sstevel@tonic-gate #undef GROW
166*0Sstevel@tonic-gate
167*0Sstevel@tonic-gate void
Perl_tmps_grow(pTHX_ I32 n)168*0Sstevel@tonic-gate Perl_tmps_grow(pTHX_ I32 n)
169*0Sstevel@tonic-gate {
170*0Sstevel@tonic-gate #ifndef STRESS_REALLOC
171*0Sstevel@tonic-gate if (n < 128)
172*0Sstevel@tonic-gate n = (PL_tmps_max < 512) ? 128 : 512;
173*0Sstevel@tonic-gate #endif
174*0Sstevel@tonic-gate PL_tmps_max = PL_tmps_ix + n + 1;
175*0Sstevel@tonic-gate Renew(PL_tmps_stack, PL_tmps_max, SV*);
176*0Sstevel@tonic-gate }
177*0Sstevel@tonic-gate
178*0Sstevel@tonic-gate
179*0Sstevel@tonic-gate void
Perl_free_tmps(pTHX)180*0Sstevel@tonic-gate Perl_free_tmps(pTHX)
181*0Sstevel@tonic-gate {
182*0Sstevel@tonic-gate /* XXX should tmps_floor live in cxstack? */
183*0Sstevel@tonic-gate I32 myfloor = PL_tmps_floor;
184*0Sstevel@tonic-gate while (PL_tmps_ix > myfloor) { /* clean up after last statement */
185*0Sstevel@tonic-gate SV* sv = PL_tmps_stack[PL_tmps_ix];
186*0Sstevel@tonic-gate PL_tmps_stack[PL_tmps_ix--] = Nullsv;
187*0Sstevel@tonic-gate if (sv && sv != &PL_sv_undef) {
188*0Sstevel@tonic-gate SvTEMP_off(sv);
189*0Sstevel@tonic-gate SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */
190*0Sstevel@tonic-gate }
191*0Sstevel@tonic-gate }
192*0Sstevel@tonic-gate }
193*0Sstevel@tonic-gate
194*0Sstevel@tonic-gate STATIC SV *
S_save_scalar_at(pTHX_ SV ** sptr)195*0Sstevel@tonic-gate S_save_scalar_at(pTHX_ SV **sptr)
196*0Sstevel@tonic-gate {
197*0Sstevel@tonic-gate register SV *sv;
198*0Sstevel@tonic-gate SV *osv = *sptr;
199*0Sstevel@tonic-gate
200*0Sstevel@tonic-gate sv = *sptr = NEWSV(0,0);
201*0Sstevel@tonic-gate if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
202*0Sstevel@tonic-gate sv_upgrade(sv, SvTYPE(osv));
203*0Sstevel@tonic-gate if (SvGMAGICAL(osv)) {
204*0Sstevel@tonic-gate MAGIC* mg;
205*0Sstevel@tonic-gate bool oldtainted = PL_tainted;
206*0Sstevel@tonic-gate mg_get(osv); /* note, can croak! */
207*0Sstevel@tonic-gate if (PL_tainting && PL_tainted &&
208*0Sstevel@tonic-gate (mg = mg_find(osv, PERL_MAGIC_taint))) {
209*0Sstevel@tonic-gate SAVESPTR(mg->mg_obj);
210*0Sstevel@tonic-gate mg->mg_obj = osv;
211*0Sstevel@tonic-gate }
212*0Sstevel@tonic-gate SvFLAGS(osv) |= (SvFLAGS(osv) &
213*0Sstevel@tonic-gate (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
214*0Sstevel@tonic-gate PL_tainted = oldtainted;
215*0Sstevel@tonic-gate }
216*0Sstevel@tonic-gate SvMAGIC(sv) = SvMAGIC(osv);
217*0Sstevel@tonic-gate SvFLAGS(sv) |= SvMAGICAL(osv);
218*0Sstevel@tonic-gate /* XXX SvMAGIC() is *shared* between osv and sv. This can
219*0Sstevel@tonic-gate * lead to coredumps when both SVs are destroyed without one
220*0Sstevel@tonic-gate * of their SvMAGIC() slots being NULLed. */
221*0Sstevel@tonic-gate PL_localizing = 1;
222*0Sstevel@tonic-gate SvSETMAGIC(sv);
223*0Sstevel@tonic-gate PL_localizing = 0;
224*0Sstevel@tonic-gate }
225*0Sstevel@tonic-gate return sv;
226*0Sstevel@tonic-gate }
227*0Sstevel@tonic-gate
228*0Sstevel@tonic-gate SV *
Perl_save_scalar(pTHX_ GV * gv)229*0Sstevel@tonic-gate Perl_save_scalar(pTHX_ GV *gv)
230*0Sstevel@tonic-gate {
231*0Sstevel@tonic-gate SV **sptr = &GvSV(gv);
232*0Sstevel@tonic-gate SSCHECK(3);
233*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(gv));
234*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(*sptr));
235*0Sstevel@tonic-gate SSPUSHINT(SAVEt_SV);
236*0Sstevel@tonic-gate return save_scalar_at(sptr);
237*0Sstevel@tonic-gate }
238*0Sstevel@tonic-gate
239*0Sstevel@tonic-gate SV*
Perl_save_svref(pTHX_ SV ** sptr)240*0Sstevel@tonic-gate Perl_save_svref(pTHX_ SV **sptr)
241*0Sstevel@tonic-gate {
242*0Sstevel@tonic-gate SSCHECK(3);
243*0Sstevel@tonic-gate SSPUSHPTR(sptr);
244*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(*sptr));
245*0Sstevel@tonic-gate SSPUSHINT(SAVEt_SVREF);
246*0Sstevel@tonic-gate return save_scalar_at(sptr);
247*0Sstevel@tonic-gate }
248*0Sstevel@tonic-gate
249*0Sstevel@tonic-gate /* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to
250*0Sstevel@tonic-gate * restore a global SV to its prior contents, freeing new value. */
251*0Sstevel@tonic-gate void
Perl_save_generic_svref(pTHX_ SV ** sptr)252*0Sstevel@tonic-gate Perl_save_generic_svref(pTHX_ SV **sptr)
253*0Sstevel@tonic-gate {
254*0Sstevel@tonic-gate SSCHECK(3);
255*0Sstevel@tonic-gate SSPUSHPTR(sptr);
256*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(*sptr));
257*0Sstevel@tonic-gate SSPUSHINT(SAVEt_GENERIC_SVREF);
258*0Sstevel@tonic-gate }
259*0Sstevel@tonic-gate
260*0Sstevel@tonic-gate /* Like save_pptr(), but also Safefree()s the new value if it is different
261*0Sstevel@tonic-gate * from the old one. Can be used to restore a global char* to its prior
262*0Sstevel@tonic-gate * contents, freeing new value. */
263*0Sstevel@tonic-gate void
Perl_save_generic_pvref(pTHX_ char ** str)264*0Sstevel@tonic-gate Perl_save_generic_pvref(pTHX_ char **str)
265*0Sstevel@tonic-gate {
266*0Sstevel@tonic-gate SSCHECK(3);
267*0Sstevel@tonic-gate SSPUSHPTR(str);
268*0Sstevel@tonic-gate SSPUSHPTR(*str);
269*0Sstevel@tonic-gate SSPUSHINT(SAVEt_GENERIC_PVREF);
270*0Sstevel@tonic-gate }
271*0Sstevel@tonic-gate
272*0Sstevel@tonic-gate /* Like save_generic_pvref(), but uses PerlMemShared_free() rather than Safefree().
273*0Sstevel@tonic-gate * Can be used to restore a shared global char* to its prior
274*0Sstevel@tonic-gate * contents, freeing new value. */
275*0Sstevel@tonic-gate void
Perl_save_shared_pvref(pTHX_ char ** str)276*0Sstevel@tonic-gate Perl_save_shared_pvref(pTHX_ char **str)
277*0Sstevel@tonic-gate {
278*0Sstevel@tonic-gate SSCHECK(3);
279*0Sstevel@tonic-gate SSPUSHPTR(str);
280*0Sstevel@tonic-gate SSPUSHPTR(*str);
281*0Sstevel@tonic-gate SSPUSHINT(SAVEt_SHARED_PVREF);
282*0Sstevel@tonic-gate }
283*0Sstevel@tonic-gate
284*0Sstevel@tonic-gate void
Perl_save_gp(pTHX_ GV * gv,I32 empty)285*0Sstevel@tonic-gate Perl_save_gp(pTHX_ GV *gv, I32 empty)
286*0Sstevel@tonic-gate {
287*0Sstevel@tonic-gate SSGROW(6);
288*0Sstevel@tonic-gate SSPUSHIV((IV)SvLEN(gv));
289*0Sstevel@tonic-gate SvLEN(gv) = 0; /* forget that anything was allocated here */
290*0Sstevel@tonic-gate SSPUSHIV((IV)SvCUR(gv));
291*0Sstevel@tonic-gate SSPUSHPTR(SvPVX(gv));
292*0Sstevel@tonic-gate SvPOK_off(gv);
293*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(gv));
294*0Sstevel@tonic-gate SSPUSHPTR(GvGP(gv));
295*0Sstevel@tonic-gate SSPUSHINT(SAVEt_GP);
296*0Sstevel@tonic-gate
297*0Sstevel@tonic-gate if (empty) {
298*0Sstevel@tonic-gate register GP *gp;
299*0Sstevel@tonic-gate
300*0Sstevel@tonic-gate Newz(602, gp, 1, GP);
301*0Sstevel@tonic-gate
302*0Sstevel@tonic-gate if (GvCVu(gv))
303*0Sstevel@tonic-gate PL_sub_generation++; /* taking a method out of circulation */
304*0Sstevel@tonic-gate if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) {
305*0Sstevel@tonic-gate gp->gp_io = newIO();
306*0Sstevel@tonic-gate IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
307*0Sstevel@tonic-gate }
308*0Sstevel@tonic-gate GvGP(gv) = gp_ref(gp);
309*0Sstevel@tonic-gate GvSV(gv) = NEWSV(72,0);
310*0Sstevel@tonic-gate GvLINE(gv) = CopLINE(PL_curcop);
311*0Sstevel@tonic-gate GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
312*0Sstevel@tonic-gate GvEGV(gv) = gv;
313*0Sstevel@tonic-gate }
314*0Sstevel@tonic-gate else {
315*0Sstevel@tonic-gate gp_ref(GvGP(gv));
316*0Sstevel@tonic-gate GvINTRO_on(gv);
317*0Sstevel@tonic-gate }
318*0Sstevel@tonic-gate }
319*0Sstevel@tonic-gate
320*0Sstevel@tonic-gate AV *
Perl_save_ary(pTHX_ GV * gv)321*0Sstevel@tonic-gate Perl_save_ary(pTHX_ GV *gv)
322*0Sstevel@tonic-gate {
323*0Sstevel@tonic-gate AV *oav = GvAVn(gv);
324*0Sstevel@tonic-gate AV *av;
325*0Sstevel@tonic-gate
326*0Sstevel@tonic-gate if (!AvREAL(oav) && AvREIFY(oav))
327*0Sstevel@tonic-gate av_reify(oav);
328*0Sstevel@tonic-gate SSCHECK(3);
329*0Sstevel@tonic-gate SSPUSHPTR(gv);
330*0Sstevel@tonic-gate SSPUSHPTR(oav);
331*0Sstevel@tonic-gate SSPUSHINT(SAVEt_AV);
332*0Sstevel@tonic-gate
333*0Sstevel@tonic-gate GvAV(gv) = Null(AV*);
334*0Sstevel@tonic-gate av = GvAVn(gv);
335*0Sstevel@tonic-gate if (SvMAGIC(oav)) {
336*0Sstevel@tonic-gate SvMAGIC(av) = SvMAGIC(oav);
337*0Sstevel@tonic-gate SvFLAGS((SV*)av) |= SvMAGICAL(oav);
338*0Sstevel@tonic-gate SvMAGICAL_off(oav);
339*0Sstevel@tonic-gate SvMAGIC(oav) = 0;
340*0Sstevel@tonic-gate PL_localizing = 1;
341*0Sstevel@tonic-gate SvSETMAGIC((SV*)av);
342*0Sstevel@tonic-gate PL_localizing = 0;
343*0Sstevel@tonic-gate }
344*0Sstevel@tonic-gate return av;
345*0Sstevel@tonic-gate }
346*0Sstevel@tonic-gate
347*0Sstevel@tonic-gate HV *
Perl_save_hash(pTHX_ GV * gv)348*0Sstevel@tonic-gate Perl_save_hash(pTHX_ GV *gv)
349*0Sstevel@tonic-gate {
350*0Sstevel@tonic-gate HV *ohv, *hv;
351*0Sstevel@tonic-gate
352*0Sstevel@tonic-gate SSCHECK(3);
353*0Sstevel@tonic-gate SSPUSHPTR(gv);
354*0Sstevel@tonic-gate SSPUSHPTR(ohv = GvHVn(gv));
355*0Sstevel@tonic-gate SSPUSHINT(SAVEt_HV);
356*0Sstevel@tonic-gate
357*0Sstevel@tonic-gate GvHV(gv) = Null(HV*);
358*0Sstevel@tonic-gate hv = GvHVn(gv);
359*0Sstevel@tonic-gate if (SvMAGIC(ohv)) {
360*0Sstevel@tonic-gate SvMAGIC(hv) = SvMAGIC(ohv);
361*0Sstevel@tonic-gate SvFLAGS((SV*)hv) |= SvMAGICAL(ohv);
362*0Sstevel@tonic-gate SvMAGICAL_off(ohv);
363*0Sstevel@tonic-gate SvMAGIC(ohv) = 0;
364*0Sstevel@tonic-gate PL_localizing = 1;
365*0Sstevel@tonic-gate SvSETMAGIC((SV*)hv);
366*0Sstevel@tonic-gate PL_localizing = 0;
367*0Sstevel@tonic-gate }
368*0Sstevel@tonic-gate return hv;
369*0Sstevel@tonic-gate }
370*0Sstevel@tonic-gate
371*0Sstevel@tonic-gate void
Perl_save_item(pTHX_ register SV * item)372*0Sstevel@tonic-gate Perl_save_item(pTHX_ register SV *item)
373*0Sstevel@tonic-gate {
374*0Sstevel@tonic-gate register SV *sv = NEWSV(0,0);
375*0Sstevel@tonic-gate
376*0Sstevel@tonic-gate sv_setsv(sv,item);
377*0Sstevel@tonic-gate SSCHECK(3);
378*0Sstevel@tonic-gate SSPUSHPTR(item); /* remember the pointer */
379*0Sstevel@tonic-gate SSPUSHPTR(sv); /* remember the value */
380*0Sstevel@tonic-gate SSPUSHINT(SAVEt_ITEM);
381*0Sstevel@tonic-gate }
382*0Sstevel@tonic-gate
383*0Sstevel@tonic-gate void
Perl_save_int(pTHX_ int * intp)384*0Sstevel@tonic-gate Perl_save_int(pTHX_ int *intp)
385*0Sstevel@tonic-gate {
386*0Sstevel@tonic-gate SSCHECK(3);
387*0Sstevel@tonic-gate SSPUSHINT(*intp);
388*0Sstevel@tonic-gate SSPUSHPTR(intp);
389*0Sstevel@tonic-gate SSPUSHINT(SAVEt_INT);
390*0Sstevel@tonic-gate }
391*0Sstevel@tonic-gate
392*0Sstevel@tonic-gate void
Perl_save_long(pTHX_ long int * longp)393*0Sstevel@tonic-gate Perl_save_long(pTHX_ long int *longp)
394*0Sstevel@tonic-gate {
395*0Sstevel@tonic-gate SSCHECK(3);
396*0Sstevel@tonic-gate SSPUSHLONG(*longp);
397*0Sstevel@tonic-gate SSPUSHPTR(longp);
398*0Sstevel@tonic-gate SSPUSHINT(SAVEt_LONG);
399*0Sstevel@tonic-gate }
400*0Sstevel@tonic-gate
401*0Sstevel@tonic-gate void
Perl_save_bool(pTHX_ bool * boolp)402*0Sstevel@tonic-gate Perl_save_bool(pTHX_ bool *boolp)
403*0Sstevel@tonic-gate {
404*0Sstevel@tonic-gate SSCHECK(3);
405*0Sstevel@tonic-gate SSPUSHBOOL(*boolp);
406*0Sstevel@tonic-gate SSPUSHPTR(boolp);
407*0Sstevel@tonic-gate SSPUSHINT(SAVEt_BOOL);
408*0Sstevel@tonic-gate }
409*0Sstevel@tonic-gate
410*0Sstevel@tonic-gate void
Perl_save_I32(pTHX_ I32 * intp)411*0Sstevel@tonic-gate Perl_save_I32(pTHX_ I32 *intp)
412*0Sstevel@tonic-gate {
413*0Sstevel@tonic-gate SSCHECK(3);
414*0Sstevel@tonic-gate SSPUSHINT(*intp);
415*0Sstevel@tonic-gate SSPUSHPTR(intp);
416*0Sstevel@tonic-gate SSPUSHINT(SAVEt_I32);
417*0Sstevel@tonic-gate }
418*0Sstevel@tonic-gate
419*0Sstevel@tonic-gate void
Perl_save_I16(pTHX_ I16 * intp)420*0Sstevel@tonic-gate Perl_save_I16(pTHX_ I16 *intp)
421*0Sstevel@tonic-gate {
422*0Sstevel@tonic-gate SSCHECK(3);
423*0Sstevel@tonic-gate SSPUSHINT(*intp);
424*0Sstevel@tonic-gate SSPUSHPTR(intp);
425*0Sstevel@tonic-gate SSPUSHINT(SAVEt_I16);
426*0Sstevel@tonic-gate }
427*0Sstevel@tonic-gate
428*0Sstevel@tonic-gate void
Perl_save_I8(pTHX_ I8 * bytep)429*0Sstevel@tonic-gate Perl_save_I8(pTHX_ I8 *bytep)
430*0Sstevel@tonic-gate {
431*0Sstevel@tonic-gate SSCHECK(3);
432*0Sstevel@tonic-gate SSPUSHINT(*bytep);
433*0Sstevel@tonic-gate SSPUSHPTR(bytep);
434*0Sstevel@tonic-gate SSPUSHINT(SAVEt_I8);
435*0Sstevel@tonic-gate }
436*0Sstevel@tonic-gate
437*0Sstevel@tonic-gate void
Perl_save_iv(pTHX_ IV * ivp)438*0Sstevel@tonic-gate Perl_save_iv(pTHX_ IV *ivp)
439*0Sstevel@tonic-gate {
440*0Sstevel@tonic-gate SSCHECK(3);
441*0Sstevel@tonic-gate SSPUSHIV(*ivp);
442*0Sstevel@tonic-gate SSPUSHPTR(ivp);
443*0Sstevel@tonic-gate SSPUSHINT(SAVEt_IV);
444*0Sstevel@tonic-gate }
445*0Sstevel@tonic-gate
446*0Sstevel@tonic-gate /* Cannot use save_sptr() to store a char* since the SV** cast will
447*0Sstevel@tonic-gate * force word-alignment and we'll miss the pointer.
448*0Sstevel@tonic-gate */
449*0Sstevel@tonic-gate void
Perl_save_pptr(pTHX_ char ** pptr)450*0Sstevel@tonic-gate Perl_save_pptr(pTHX_ char **pptr)
451*0Sstevel@tonic-gate {
452*0Sstevel@tonic-gate SSCHECK(3);
453*0Sstevel@tonic-gate SSPUSHPTR(*pptr);
454*0Sstevel@tonic-gate SSPUSHPTR(pptr);
455*0Sstevel@tonic-gate SSPUSHINT(SAVEt_PPTR);
456*0Sstevel@tonic-gate }
457*0Sstevel@tonic-gate
458*0Sstevel@tonic-gate void
Perl_save_vptr(pTHX_ void * ptr)459*0Sstevel@tonic-gate Perl_save_vptr(pTHX_ void *ptr)
460*0Sstevel@tonic-gate {
461*0Sstevel@tonic-gate SSCHECK(3);
462*0Sstevel@tonic-gate SSPUSHPTR(*(char**)ptr);
463*0Sstevel@tonic-gate SSPUSHPTR(ptr);
464*0Sstevel@tonic-gate SSPUSHINT(SAVEt_VPTR);
465*0Sstevel@tonic-gate }
466*0Sstevel@tonic-gate
467*0Sstevel@tonic-gate void
Perl_save_sptr(pTHX_ SV ** sptr)468*0Sstevel@tonic-gate Perl_save_sptr(pTHX_ SV **sptr)
469*0Sstevel@tonic-gate {
470*0Sstevel@tonic-gate SSCHECK(3);
471*0Sstevel@tonic-gate SSPUSHPTR(*sptr);
472*0Sstevel@tonic-gate SSPUSHPTR(sptr);
473*0Sstevel@tonic-gate SSPUSHINT(SAVEt_SPTR);
474*0Sstevel@tonic-gate }
475*0Sstevel@tonic-gate
476*0Sstevel@tonic-gate void
Perl_save_padsv(pTHX_ PADOFFSET off)477*0Sstevel@tonic-gate Perl_save_padsv(pTHX_ PADOFFSET off)
478*0Sstevel@tonic-gate {
479*0Sstevel@tonic-gate SSCHECK(4);
480*0Sstevel@tonic-gate ASSERT_CURPAD_ACTIVE("save_padsv");
481*0Sstevel@tonic-gate SSPUSHPTR(PL_curpad[off]);
482*0Sstevel@tonic-gate SSPUSHPTR(PL_comppad);
483*0Sstevel@tonic-gate SSPUSHLONG((long)off);
484*0Sstevel@tonic-gate SSPUSHINT(SAVEt_PADSV);
485*0Sstevel@tonic-gate }
486*0Sstevel@tonic-gate
487*0Sstevel@tonic-gate SV **
Perl_save_threadsv(pTHX_ PADOFFSET i)488*0Sstevel@tonic-gate Perl_save_threadsv(pTHX_ PADOFFSET i)
489*0Sstevel@tonic-gate {
490*0Sstevel@tonic-gate #ifdef USE_5005THREADS
491*0Sstevel@tonic-gate SV **svp = &THREADSV(i); /* XXX Change to save by offset */
492*0Sstevel@tonic-gate DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
493*0Sstevel@tonic-gate (UV)i, svp, *svp, SvPEEK(*svp)));
494*0Sstevel@tonic-gate save_svref(svp);
495*0Sstevel@tonic-gate return svp;
496*0Sstevel@tonic-gate #else
497*0Sstevel@tonic-gate Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
498*0Sstevel@tonic-gate return 0;
499*0Sstevel@tonic-gate #endif /* USE_5005THREADS */
500*0Sstevel@tonic-gate }
501*0Sstevel@tonic-gate
502*0Sstevel@tonic-gate void
Perl_save_nogv(pTHX_ GV * gv)503*0Sstevel@tonic-gate Perl_save_nogv(pTHX_ GV *gv)
504*0Sstevel@tonic-gate {
505*0Sstevel@tonic-gate SSCHECK(2);
506*0Sstevel@tonic-gate SSPUSHPTR(gv);
507*0Sstevel@tonic-gate SSPUSHINT(SAVEt_NSTAB);
508*0Sstevel@tonic-gate }
509*0Sstevel@tonic-gate
510*0Sstevel@tonic-gate void
Perl_save_hptr(pTHX_ HV ** hptr)511*0Sstevel@tonic-gate Perl_save_hptr(pTHX_ HV **hptr)
512*0Sstevel@tonic-gate {
513*0Sstevel@tonic-gate SSCHECK(3);
514*0Sstevel@tonic-gate SSPUSHPTR(*hptr);
515*0Sstevel@tonic-gate SSPUSHPTR(hptr);
516*0Sstevel@tonic-gate SSPUSHINT(SAVEt_HPTR);
517*0Sstevel@tonic-gate }
518*0Sstevel@tonic-gate
519*0Sstevel@tonic-gate void
Perl_save_aptr(pTHX_ AV ** aptr)520*0Sstevel@tonic-gate Perl_save_aptr(pTHX_ AV **aptr)
521*0Sstevel@tonic-gate {
522*0Sstevel@tonic-gate SSCHECK(3);
523*0Sstevel@tonic-gate SSPUSHPTR(*aptr);
524*0Sstevel@tonic-gate SSPUSHPTR(aptr);
525*0Sstevel@tonic-gate SSPUSHINT(SAVEt_APTR);
526*0Sstevel@tonic-gate }
527*0Sstevel@tonic-gate
528*0Sstevel@tonic-gate void
Perl_save_freesv(pTHX_ SV * sv)529*0Sstevel@tonic-gate Perl_save_freesv(pTHX_ SV *sv)
530*0Sstevel@tonic-gate {
531*0Sstevel@tonic-gate SSCHECK(2);
532*0Sstevel@tonic-gate SSPUSHPTR(sv);
533*0Sstevel@tonic-gate SSPUSHINT(SAVEt_FREESV);
534*0Sstevel@tonic-gate }
535*0Sstevel@tonic-gate
536*0Sstevel@tonic-gate void
Perl_save_mortalizesv(pTHX_ SV * sv)537*0Sstevel@tonic-gate Perl_save_mortalizesv(pTHX_ SV *sv)
538*0Sstevel@tonic-gate {
539*0Sstevel@tonic-gate SSCHECK(2);
540*0Sstevel@tonic-gate SSPUSHPTR(sv);
541*0Sstevel@tonic-gate SSPUSHINT(SAVEt_MORTALIZESV);
542*0Sstevel@tonic-gate }
543*0Sstevel@tonic-gate
544*0Sstevel@tonic-gate void
Perl_save_freeop(pTHX_ OP * o)545*0Sstevel@tonic-gate Perl_save_freeop(pTHX_ OP *o)
546*0Sstevel@tonic-gate {
547*0Sstevel@tonic-gate SSCHECK(2);
548*0Sstevel@tonic-gate SSPUSHPTR(o);
549*0Sstevel@tonic-gate SSPUSHINT(SAVEt_FREEOP);
550*0Sstevel@tonic-gate }
551*0Sstevel@tonic-gate
552*0Sstevel@tonic-gate void
Perl_save_freepv(pTHX_ char * pv)553*0Sstevel@tonic-gate Perl_save_freepv(pTHX_ char *pv)
554*0Sstevel@tonic-gate {
555*0Sstevel@tonic-gate SSCHECK(2);
556*0Sstevel@tonic-gate SSPUSHPTR(pv);
557*0Sstevel@tonic-gate SSPUSHINT(SAVEt_FREEPV);
558*0Sstevel@tonic-gate }
559*0Sstevel@tonic-gate
560*0Sstevel@tonic-gate void
Perl_save_clearsv(pTHX_ SV ** svp)561*0Sstevel@tonic-gate Perl_save_clearsv(pTHX_ SV **svp)
562*0Sstevel@tonic-gate {
563*0Sstevel@tonic-gate ASSERT_CURPAD_ACTIVE("save_clearsv");
564*0Sstevel@tonic-gate SSCHECK(2);
565*0Sstevel@tonic-gate SSPUSHLONG((long)(svp-PL_curpad));
566*0Sstevel@tonic-gate SSPUSHINT(SAVEt_CLEARSV);
567*0Sstevel@tonic-gate }
568*0Sstevel@tonic-gate
569*0Sstevel@tonic-gate void
Perl_save_delete(pTHX_ HV * hv,char * key,I32 klen)570*0Sstevel@tonic-gate Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
571*0Sstevel@tonic-gate {
572*0Sstevel@tonic-gate SSCHECK(4);
573*0Sstevel@tonic-gate SSPUSHINT(klen);
574*0Sstevel@tonic-gate SSPUSHPTR(key);
575*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(hv));
576*0Sstevel@tonic-gate SSPUSHINT(SAVEt_DELETE);
577*0Sstevel@tonic-gate }
578*0Sstevel@tonic-gate
579*0Sstevel@tonic-gate void
Perl_save_list(pTHX_ register SV ** sarg,I32 maxsarg)580*0Sstevel@tonic-gate Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
581*0Sstevel@tonic-gate {
582*0Sstevel@tonic-gate register SV *sv;
583*0Sstevel@tonic-gate register I32 i;
584*0Sstevel@tonic-gate
585*0Sstevel@tonic-gate for (i = 1; i <= maxsarg; i++) {
586*0Sstevel@tonic-gate sv = NEWSV(0,0);
587*0Sstevel@tonic-gate sv_setsv(sv,sarg[i]);
588*0Sstevel@tonic-gate SSCHECK(3);
589*0Sstevel@tonic-gate SSPUSHPTR(sarg[i]); /* remember the pointer */
590*0Sstevel@tonic-gate SSPUSHPTR(sv); /* remember the value */
591*0Sstevel@tonic-gate SSPUSHINT(SAVEt_ITEM);
592*0Sstevel@tonic-gate }
593*0Sstevel@tonic-gate }
594*0Sstevel@tonic-gate
595*0Sstevel@tonic-gate void
Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f,void * p)596*0Sstevel@tonic-gate Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
597*0Sstevel@tonic-gate {
598*0Sstevel@tonic-gate SSCHECK(3);
599*0Sstevel@tonic-gate SSPUSHDPTR(f);
600*0Sstevel@tonic-gate SSPUSHPTR(p);
601*0Sstevel@tonic-gate SSPUSHINT(SAVEt_DESTRUCTOR);
602*0Sstevel@tonic-gate }
603*0Sstevel@tonic-gate
604*0Sstevel@tonic-gate void
Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f,void * p)605*0Sstevel@tonic-gate Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
606*0Sstevel@tonic-gate {
607*0Sstevel@tonic-gate SSCHECK(3);
608*0Sstevel@tonic-gate SSPUSHDXPTR(f);
609*0Sstevel@tonic-gate SSPUSHPTR(p);
610*0Sstevel@tonic-gate SSPUSHINT(SAVEt_DESTRUCTOR_X);
611*0Sstevel@tonic-gate }
612*0Sstevel@tonic-gate
613*0Sstevel@tonic-gate void
Perl_save_aelem(pTHX_ AV * av,I32 idx,SV ** sptr)614*0Sstevel@tonic-gate Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
615*0Sstevel@tonic-gate {
616*0Sstevel@tonic-gate SV *sv;
617*0Sstevel@tonic-gate SSCHECK(4);
618*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(av));
619*0Sstevel@tonic-gate SSPUSHINT(idx);
620*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(*sptr));
621*0Sstevel@tonic-gate SSPUSHINT(SAVEt_AELEM);
622*0Sstevel@tonic-gate /* if it gets reified later, the restore will have the wrong refcnt */
623*0Sstevel@tonic-gate if (!AvREAL(av) && AvREIFY(av))
624*0Sstevel@tonic-gate SvREFCNT_inc(*sptr);
625*0Sstevel@tonic-gate save_scalar_at(sptr);
626*0Sstevel@tonic-gate sv = *sptr;
627*0Sstevel@tonic-gate /* If we're localizing a tied array element, this new sv
628*0Sstevel@tonic-gate * won't actually be stored in the array - so it won't get
629*0Sstevel@tonic-gate * reaped when the localize ends. Ensure it gets reaped by
630*0Sstevel@tonic-gate * mortifying it instead. DAPM */
631*0Sstevel@tonic-gate if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
632*0Sstevel@tonic-gate sv_2mortal(sv);
633*0Sstevel@tonic-gate }
634*0Sstevel@tonic-gate
635*0Sstevel@tonic-gate void
Perl_save_helem(pTHX_ HV * hv,SV * key,SV ** sptr)636*0Sstevel@tonic-gate Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
637*0Sstevel@tonic-gate {
638*0Sstevel@tonic-gate SV *sv;
639*0Sstevel@tonic-gate SSCHECK(4);
640*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(hv));
641*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(key));
642*0Sstevel@tonic-gate SSPUSHPTR(SvREFCNT_inc(*sptr));
643*0Sstevel@tonic-gate SSPUSHINT(SAVEt_HELEM);
644*0Sstevel@tonic-gate save_scalar_at(sptr);
645*0Sstevel@tonic-gate sv = *sptr;
646*0Sstevel@tonic-gate /* If we're localizing a tied hash element, this new sv
647*0Sstevel@tonic-gate * won't actually be stored in the hash - so it won't get
648*0Sstevel@tonic-gate * reaped when the localize ends. Ensure it gets reaped by
649*0Sstevel@tonic-gate * mortifying it instead. DAPM */
650*0Sstevel@tonic-gate if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
651*0Sstevel@tonic-gate sv_2mortal(sv);
652*0Sstevel@tonic-gate }
653*0Sstevel@tonic-gate
654*0Sstevel@tonic-gate void
Perl_save_op(pTHX)655*0Sstevel@tonic-gate Perl_save_op(pTHX)
656*0Sstevel@tonic-gate {
657*0Sstevel@tonic-gate SSCHECK(2);
658*0Sstevel@tonic-gate SSPUSHPTR(PL_op);
659*0Sstevel@tonic-gate SSPUSHINT(SAVEt_OP);
660*0Sstevel@tonic-gate }
661*0Sstevel@tonic-gate
662*0Sstevel@tonic-gate I32
Perl_save_alloc(pTHX_ I32 size,I32 pad)663*0Sstevel@tonic-gate Perl_save_alloc(pTHX_ I32 size, I32 pad)
664*0Sstevel@tonic-gate {
665*0Sstevel@tonic-gate register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
666*0Sstevel@tonic-gate - (char*)PL_savestack);
667*0Sstevel@tonic-gate register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
668*0Sstevel@tonic-gate
669*0Sstevel@tonic-gate /* SSCHECK may not be good enough */
670*0Sstevel@tonic-gate while (PL_savestack_ix + elems + 2 > PL_savestack_max)
671*0Sstevel@tonic-gate savestack_grow();
672*0Sstevel@tonic-gate
673*0Sstevel@tonic-gate PL_savestack_ix += elems;
674*0Sstevel@tonic-gate SSPUSHINT(elems);
675*0Sstevel@tonic-gate SSPUSHINT(SAVEt_ALLOC);
676*0Sstevel@tonic-gate return start;
677*0Sstevel@tonic-gate }
678*0Sstevel@tonic-gate
679*0Sstevel@tonic-gate void
Perl_leave_scope(pTHX_ I32 base)680*0Sstevel@tonic-gate Perl_leave_scope(pTHX_ I32 base)
681*0Sstevel@tonic-gate {
682*0Sstevel@tonic-gate register SV *sv;
683*0Sstevel@tonic-gate register SV *value;
684*0Sstevel@tonic-gate register GV *gv;
685*0Sstevel@tonic-gate register AV *av;
686*0Sstevel@tonic-gate register HV *hv;
687*0Sstevel@tonic-gate register void* ptr;
688*0Sstevel@tonic-gate register char* str;
689*0Sstevel@tonic-gate I32 i;
690*0Sstevel@tonic-gate
691*0Sstevel@tonic-gate if (base < -1)
692*0Sstevel@tonic-gate Perl_croak(aTHX_ "panic: corrupt saved stack index");
693*0Sstevel@tonic-gate while (PL_savestack_ix > base) {
694*0Sstevel@tonic-gate switch (SSPOPINT) {
695*0Sstevel@tonic-gate case SAVEt_ITEM: /* normal string */
696*0Sstevel@tonic-gate value = (SV*)SSPOPPTR;
697*0Sstevel@tonic-gate sv = (SV*)SSPOPPTR;
698*0Sstevel@tonic-gate sv_replace(sv,value);
699*0Sstevel@tonic-gate PL_localizing = 2;
700*0Sstevel@tonic-gate SvSETMAGIC(sv);
701*0Sstevel@tonic-gate PL_localizing = 0;
702*0Sstevel@tonic-gate break;
703*0Sstevel@tonic-gate case SAVEt_SV: /* scalar reference */
704*0Sstevel@tonic-gate value = (SV*)SSPOPPTR;
705*0Sstevel@tonic-gate gv = (GV*)SSPOPPTR;
706*0Sstevel@tonic-gate ptr = &GvSV(gv);
707*0Sstevel@tonic-gate av = (AV*)gv; /* what to refcnt_dec */
708*0Sstevel@tonic-gate goto restore_sv;
709*0Sstevel@tonic-gate case SAVEt_GENERIC_PVREF: /* generic pv */
710*0Sstevel@tonic-gate str = (char*)SSPOPPTR;
711*0Sstevel@tonic-gate ptr = SSPOPPTR;
712*0Sstevel@tonic-gate if (*(char**)ptr != str) {
713*0Sstevel@tonic-gate Safefree(*(char**)ptr);
714*0Sstevel@tonic-gate *(char**)ptr = str;
715*0Sstevel@tonic-gate }
716*0Sstevel@tonic-gate break;
717*0Sstevel@tonic-gate case SAVEt_SHARED_PVREF: /* shared pv */
718*0Sstevel@tonic-gate str = (char*)SSPOPPTR;
719*0Sstevel@tonic-gate ptr = SSPOPPTR;
720*0Sstevel@tonic-gate if (*(char**)ptr != str) {
721*0Sstevel@tonic-gate #ifdef NETWARE
722*0Sstevel@tonic-gate PerlMem_free(*(char**)ptr);
723*0Sstevel@tonic-gate #else
724*0Sstevel@tonic-gate PerlMemShared_free(*(char**)ptr);
725*0Sstevel@tonic-gate #endif
726*0Sstevel@tonic-gate *(char**)ptr = str;
727*0Sstevel@tonic-gate }
728*0Sstevel@tonic-gate break;
729*0Sstevel@tonic-gate case SAVEt_GENERIC_SVREF: /* generic sv */
730*0Sstevel@tonic-gate value = (SV*)SSPOPPTR;
731*0Sstevel@tonic-gate ptr = SSPOPPTR;
732*0Sstevel@tonic-gate sv = *(SV**)ptr;
733*0Sstevel@tonic-gate *(SV**)ptr = value;
734*0Sstevel@tonic-gate SvREFCNT_dec(sv);
735*0Sstevel@tonic-gate SvREFCNT_dec(value);
736*0Sstevel@tonic-gate break;
737*0Sstevel@tonic-gate case SAVEt_SVREF: /* scalar reference */
738*0Sstevel@tonic-gate value = (SV*)SSPOPPTR;
739*0Sstevel@tonic-gate ptr = SSPOPPTR;
740*0Sstevel@tonic-gate av = Nullav; /* what to refcnt_dec */
741*0Sstevel@tonic-gate restore_sv:
742*0Sstevel@tonic-gate sv = *(SV**)ptr;
743*0Sstevel@tonic-gate DEBUG_S(PerlIO_printf(Perl_debug_log,
744*0Sstevel@tonic-gate "restore svref: %p %p:%s -> %p:%s\n",
745*0Sstevel@tonic-gate ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
746*0Sstevel@tonic-gate if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
747*0Sstevel@tonic-gate SvTYPE(sv) != SVt_PVGV)
748*0Sstevel@tonic-gate {
749*0Sstevel@tonic-gate (void)SvUPGRADE(value, SvTYPE(sv));
750*0Sstevel@tonic-gate SvMAGIC(value) = SvMAGIC(sv);
751*0Sstevel@tonic-gate SvFLAGS(value) |= SvMAGICAL(sv);
752*0Sstevel@tonic-gate SvMAGICAL_off(sv);
753*0Sstevel@tonic-gate SvMAGIC(sv) = 0;
754*0Sstevel@tonic-gate }
755*0Sstevel@tonic-gate /* XXX This branch is pretty bogus. This code irretrievably
756*0Sstevel@tonic-gate * clears(!) the magic on the SV (either to avoid further
757*0Sstevel@tonic-gate * croaking that might ensue when the SvSETMAGIC() below is
758*0Sstevel@tonic-gate * called, or to avoid two different SVs pointing at the same
759*0Sstevel@tonic-gate * SvMAGIC()). This needs a total rethink. --GSAR */
760*0Sstevel@tonic-gate else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
761*0Sstevel@tonic-gate SvTYPE(value) != SVt_PVGV)
762*0Sstevel@tonic-gate {
763*0Sstevel@tonic-gate SvFLAGS(value) |= (SvFLAGS(value) &
764*0Sstevel@tonic-gate (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
765*0Sstevel@tonic-gate SvMAGICAL_off(value);
766*0Sstevel@tonic-gate /* XXX this is a leak when we get here because the
767*0Sstevel@tonic-gate * mg_get() in save_scalar_at() croaked */
768*0Sstevel@tonic-gate SvMAGIC(value) = 0;
769*0Sstevel@tonic-gate }
770*0Sstevel@tonic-gate *(SV**)ptr = value;
771*0Sstevel@tonic-gate SvREFCNT_dec(sv);
772*0Sstevel@tonic-gate PL_localizing = 2;
773*0Sstevel@tonic-gate SvSETMAGIC(value);
774*0Sstevel@tonic-gate PL_localizing = 0;
775*0Sstevel@tonic-gate SvREFCNT_dec(value);
776*0Sstevel@tonic-gate if (av) /* actually an av, hv or gv */
777*0Sstevel@tonic-gate SvREFCNT_dec(av);
778*0Sstevel@tonic-gate break;
779*0Sstevel@tonic-gate case SAVEt_AV: /* array reference */
780*0Sstevel@tonic-gate av = (AV*)SSPOPPTR;
781*0Sstevel@tonic-gate gv = (GV*)SSPOPPTR;
782*0Sstevel@tonic-gate if (GvAV(gv)) {
783*0Sstevel@tonic-gate AV *goner = GvAV(gv);
784*0Sstevel@tonic-gate SvMAGIC(av) = SvMAGIC(goner);
785*0Sstevel@tonic-gate SvFLAGS((SV*)av) |= SvMAGICAL(goner);
786*0Sstevel@tonic-gate SvMAGICAL_off(goner);
787*0Sstevel@tonic-gate SvMAGIC(goner) = 0;
788*0Sstevel@tonic-gate SvREFCNT_dec(goner);
789*0Sstevel@tonic-gate }
790*0Sstevel@tonic-gate GvAV(gv) = av;
791*0Sstevel@tonic-gate if (SvMAGICAL(av)) {
792*0Sstevel@tonic-gate PL_localizing = 2;
793*0Sstevel@tonic-gate SvSETMAGIC((SV*)av);
794*0Sstevel@tonic-gate PL_localizing = 0;
795*0Sstevel@tonic-gate }
796*0Sstevel@tonic-gate break;
797*0Sstevel@tonic-gate case SAVEt_HV: /* hash reference */
798*0Sstevel@tonic-gate hv = (HV*)SSPOPPTR;
799*0Sstevel@tonic-gate gv = (GV*)SSPOPPTR;
800*0Sstevel@tonic-gate if (GvHV(gv)) {
801*0Sstevel@tonic-gate HV *goner = GvHV(gv);
802*0Sstevel@tonic-gate SvMAGIC(hv) = SvMAGIC(goner);
803*0Sstevel@tonic-gate SvFLAGS(hv) |= SvMAGICAL(goner);
804*0Sstevel@tonic-gate SvMAGICAL_off(goner);
805*0Sstevel@tonic-gate SvMAGIC(goner) = 0;
806*0Sstevel@tonic-gate SvREFCNT_dec(goner);
807*0Sstevel@tonic-gate }
808*0Sstevel@tonic-gate GvHV(gv) = hv;
809*0Sstevel@tonic-gate if (SvMAGICAL(hv)) {
810*0Sstevel@tonic-gate PL_localizing = 2;
811*0Sstevel@tonic-gate SvSETMAGIC((SV*)hv);
812*0Sstevel@tonic-gate PL_localizing = 0;
813*0Sstevel@tonic-gate }
814*0Sstevel@tonic-gate break;
815*0Sstevel@tonic-gate case SAVEt_INT: /* int reference */
816*0Sstevel@tonic-gate ptr = SSPOPPTR;
817*0Sstevel@tonic-gate *(int*)ptr = (int)SSPOPINT;
818*0Sstevel@tonic-gate break;
819*0Sstevel@tonic-gate case SAVEt_LONG: /* long reference */
820*0Sstevel@tonic-gate ptr = SSPOPPTR;
821*0Sstevel@tonic-gate *(long*)ptr = (long)SSPOPLONG;
822*0Sstevel@tonic-gate break;
823*0Sstevel@tonic-gate case SAVEt_BOOL: /* bool reference */
824*0Sstevel@tonic-gate ptr = SSPOPPTR;
825*0Sstevel@tonic-gate *(bool*)ptr = (bool)SSPOPBOOL;
826*0Sstevel@tonic-gate break;
827*0Sstevel@tonic-gate case SAVEt_I32: /* I32 reference */
828*0Sstevel@tonic-gate ptr = SSPOPPTR;
829*0Sstevel@tonic-gate *(I32*)ptr = (I32)SSPOPINT;
830*0Sstevel@tonic-gate break;
831*0Sstevel@tonic-gate case SAVEt_I16: /* I16 reference */
832*0Sstevel@tonic-gate ptr = SSPOPPTR;
833*0Sstevel@tonic-gate *(I16*)ptr = (I16)SSPOPINT;
834*0Sstevel@tonic-gate break;
835*0Sstevel@tonic-gate case SAVEt_I8: /* I8 reference */
836*0Sstevel@tonic-gate ptr = SSPOPPTR;
837*0Sstevel@tonic-gate *(I8*)ptr = (I8)SSPOPINT;
838*0Sstevel@tonic-gate break;
839*0Sstevel@tonic-gate case SAVEt_IV: /* IV reference */
840*0Sstevel@tonic-gate ptr = SSPOPPTR;
841*0Sstevel@tonic-gate *(IV*)ptr = (IV)SSPOPIV;
842*0Sstevel@tonic-gate break;
843*0Sstevel@tonic-gate case SAVEt_SPTR: /* SV* reference */
844*0Sstevel@tonic-gate ptr = SSPOPPTR;
845*0Sstevel@tonic-gate *(SV**)ptr = (SV*)SSPOPPTR;
846*0Sstevel@tonic-gate break;
847*0Sstevel@tonic-gate case SAVEt_VPTR: /* random* reference */
848*0Sstevel@tonic-gate case SAVEt_PPTR: /* char* reference */
849*0Sstevel@tonic-gate ptr = SSPOPPTR;
850*0Sstevel@tonic-gate *(char**)ptr = (char*)SSPOPPTR;
851*0Sstevel@tonic-gate break;
852*0Sstevel@tonic-gate case SAVEt_HPTR: /* HV* reference */
853*0Sstevel@tonic-gate ptr = SSPOPPTR;
854*0Sstevel@tonic-gate *(HV**)ptr = (HV*)SSPOPPTR;
855*0Sstevel@tonic-gate break;
856*0Sstevel@tonic-gate case SAVEt_APTR: /* AV* reference */
857*0Sstevel@tonic-gate ptr = SSPOPPTR;
858*0Sstevel@tonic-gate *(AV**)ptr = (AV*)SSPOPPTR;
859*0Sstevel@tonic-gate break;
860*0Sstevel@tonic-gate case SAVEt_NSTAB:
861*0Sstevel@tonic-gate gv = (GV*)SSPOPPTR;
862*0Sstevel@tonic-gate (void)sv_clear((SV*)gv);
863*0Sstevel@tonic-gate break;
864*0Sstevel@tonic-gate case SAVEt_GP: /* scalar reference */
865*0Sstevel@tonic-gate ptr = SSPOPPTR;
866*0Sstevel@tonic-gate gv = (GV*)SSPOPPTR;
867*0Sstevel@tonic-gate if (SvPVX(gv) && SvLEN(gv) > 0) {
868*0Sstevel@tonic-gate Safefree(SvPVX(gv));
869*0Sstevel@tonic-gate }
870*0Sstevel@tonic-gate SvPVX(gv) = (char *)SSPOPPTR;
871*0Sstevel@tonic-gate SvCUR(gv) = (STRLEN)SSPOPIV;
872*0Sstevel@tonic-gate SvLEN(gv) = (STRLEN)SSPOPIV;
873*0Sstevel@tonic-gate gp_free(gv);
874*0Sstevel@tonic-gate GvGP(gv) = (GP*)ptr;
875*0Sstevel@tonic-gate if (GvCVu(gv))
876*0Sstevel@tonic-gate PL_sub_generation++; /* putting a method back into circulation */
877*0Sstevel@tonic-gate SvREFCNT_dec(gv);
878*0Sstevel@tonic-gate break;
879*0Sstevel@tonic-gate case SAVEt_FREESV:
880*0Sstevel@tonic-gate ptr = SSPOPPTR;
881*0Sstevel@tonic-gate SvREFCNT_dec((SV*)ptr);
882*0Sstevel@tonic-gate break;
883*0Sstevel@tonic-gate case SAVEt_MORTALIZESV:
884*0Sstevel@tonic-gate ptr = SSPOPPTR;
885*0Sstevel@tonic-gate sv_2mortal((SV*)ptr);
886*0Sstevel@tonic-gate break;
887*0Sstevel@tonic-gate case SAVEt_FREEOP:
888*0Sstevel@tonic-gate ptr = SSPOPPTR;
889*0Sstevel@tonic-gate ASSERT_CURPAD_LEGAL("SAVEt_FREEOP"); /* XXX DAPM tmp */
890*0Sstevel@tonic-gate op_free((OP*)ptr);
891*0Sstevel@tonic-gate break;
892*0Sstevel@tonic-gate case SAVEt_FREEPV:
893*0Sstevel@tonic-gate ptr = SSPOPPTR;
894*0Sstevel@tonic-gate Safefree((char*)ptr);
895*0Sstevel@tonic-gate break;
896*0Sstevel@tonic-gate case SAVEt_CLEARSV:
897*0Sstevel@tonic-gate ptr = (void*)&PL_curpad[SSPOPLONG];
898*0Sstevel@tonic-gate sv = *(SV**)ptr;
899*0Sstevel@tonic-gate
900*0Sstevel@tonic-gate DEBUG_Xv(PerlIO_printf(Perl_debug_log,
901*0Sstevel@tonic-gate "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
902*0Sstevel@tonic-gate PTR2UV(PL_comppad), PTR2UV(PL_curpad),
903*0Sstevel@tonic-gate (long)((SV **)ptr-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
904*0Sstevel@tonic-gate (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
905*0Sstevel@tonic-gate ));
906*0Sstevel@tonic-gate
907*0Sstevel@tonic-gate /* Can clear pad variable in place? */
908*0Sstevel@tonic-gate if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
909*0Sstevel@tonic-gate /*
910*0Sstevel@tonic-gate * if a my variable that was made readonly is going out of
911*0Sstevel@tonic-gate * scope, we want to remove the readonlyness so that it can
912*0Sstevel@tonic-gate * go out of scope quietly
913*0Sstevel@tonic-gate */
914*0Sstevel@tonic-gate if (SvPADMY(sv) && !SvFAKE(sv))
915*0Sstevel@tonic-gate SvREADONLY_off(sv);
916*0Sstevel@tonic-gate
917*0Sstevel@tonic-gate if (SvTHINKFIRST(sv))
918*0Sstevel@tonic-gate sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
919*0Sstevel@tonic-gate if (SvMAGICAL(sv))
920*0Sstevel@tonic-gate mg_free(sv);
921*0Sstevel@tonic-gate
922*0Sstevel@tonic-gate switch (SvTYPE(sv)) {
923*0Sstevel@tonic-gate case SVt_NULL:
924*0Sstevel@tonic-gate break;
925*0Sstevel@tonic-gate case SVt_PVAV:
926*0Sstevel@tonic-gate av_clear((AV*)sv);
927*0Sstevel@tonic-gate break;
928*0Sstevel@tonic-gate case SVt_PVHV:
929*0Sstevel@tonic-gate hv_clear((HV*)sv);
930*0Sstevel@tonic-gate break;
931*0Sstevel@tonic-gate case SVt_PVCV:
932*0Sstevel@tonic-gate Perl_croak(aTHX_ "panic: leave_scope pad code");
933*0Sstevel@tonic-gate case SVt_RV:
934*0Sstevel@tonic-gate case SVt_IV:
935*0Sstevel@tonic-gate case SVt_NV:
936*0Sstevel@tonic-gate (void)SvOK_off(sv);
937*0Sstevel@tonic-gate break;
938*0Sstevel@tonic-gate default:
939*0Sstevel@tonic-gate (void)SvOK_off(sv);
940*0Sstevel@tonic-gate (void)SvOOK_off(sv);
941*0Sstevel@tonic-gate break;
942*0Sstevel@tonic-gate }
943*0Sstevel@tonic-gate }
944*0Sstevel@tonic-gate else { /* Someone has a claim on this, so abandon it. */
945*0Sstevel@tonic-gate U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
946*0Sstevel@tonic-gate switch (SvTYPE(sv)) { /* Console ourselves with a new value */
947*0Sstevel@tonic-gate case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break;
948*0Sstevel@tonic-gate case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break;
949*0Sstevel@tonic-gate default: *(SV**)ptr = NEWSV(0,0); break;
950*0Sstevel@tonic-gate }
951*0Sstevel@tonic-gate SvREFCNT_dec(sv); /* Cast current value to the winds. */
952*0Sstevel@tonic-gate SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
953*0Sstevel@tonic-gate }
954*0Sstevel@tonic-gate break;
955*0Sstevel@tonic-gate case SAVEt_DELETE:
956*0Sstevel@tonic-gate ptr = SSPOPPTR;
957*0Sstevel@tonic-gate hv = (HV*)ptr;
958*0Sstevel@tonic-gate ptr = SSPOPPTR;
959*0Sstevel@tonic-gate (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
960*0Sstevel@tonic-gate SvREFCNT_dec(hv);
961*0Sstevel@tonic-gate Safefree(ptr);
962*0Sstevel@tonic-gate break;
963*0Sstevel@tonic-gate case SAVEt_DESTRUCTOR:
964*0Sstevel@tonic-gate ptr = SSPOPPTR;
965*0Sstevel@tonic-gate (*SSPOPDPTR)(ptr);
966*0Sstevel@tonic-gate break;
967*0Sstevel@tonic-gate case SAVEt_DESTRUCTOR_X:
968*0Sstevel@tonic-gate ptr = SSPOPPTR;
969*0Sstevel@tonic-gate (*SSPOPDXPTR)(aTHX_ ptr);
970*0Sstevel@tonic-gate break;
971*0Sstevel@tonic-gate case SAVEt_REGCONTEXT:
972*0Sstevel@tonic-gate case SAVEt_ALLOC:
973*0Sstevel@tonic-gate i = SSPOPINT;
974*0Sstevel@tonic-gate PL_savestack_ix -= i; /* regexp must have croaked */
975*0Sstevel@tonic-gate break;
976*0Sstevel@tonic-gate case SAVEt_STACK_POS: /* Position on Perl stack */
977*0Sstevel@tonic-gate i = SSPOPINT;
978*0Sstevel@tonic-gate PL_stack_sp = PL_stack_base + i;
979*0Sstevel@tonic-gate break;
980*0Sstevel@tonic-gate case SAVEt_AELEM: /* array element */
981*0Sstevel@tonic-gate value = (SV*)SSPOPPTR;
982*0Sstevel@tonic-gate i = SSPOPINT;
983*0Sstevel@tonic-gate av = (AV*)SSPOPPTR;
984*0Sstevel@tonic-gate if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */
985*0Sstevel@tonic-gate SvREFCNT_dec(value);
986*0Sstevel@tonic-gate ptr = av_fetch(av,i,1);
987*0Sstevel@tonic-gate if (ptr) {
988*0Sstevel@tonic-gate sv = *(SV**)ptr;
989*0Sstevel@tonic-gate if (sv && sv != &PL_sv_undef) {
990*0Sstevel@tonic-gate if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
991*0Sstevel@tonic-gate (void)SvREFCNT_inc(sv);
992*0Sstevel@tonic-gate goto restore_sv;
993*0Sstevel@tonic-gate }
994*0Sstevel@tonic-gate }
995*0Sstevel@tonic-gate SvREFCNT_dec(av);
996*0Sstevel@tonic-gate SvREFCNT_dec(value);
997*0Sstevel@tonic-gate break;
998*0Sstevel@tonic-gate case SAVEt_HELEM: /* hash element */
999*0Sstevel@tonic-gate value = (SV*)SSPOPPTR;
1000*0Sstevel@tonic-gate sv = (SV*)SSPOPPTR;
1001*0Sstevel@tonic-gate hv = (HV*)SSPOPPTR;
1002*0Sstevel@tonic-gate ptr = hv_fetch_ent(hv, sv, 1, 0);
1003*0Sstevel@tonic-gate if (ptr) {
1004*0Sstevel@tonic-gate SV *oval = HeVAL((HE*)ptr);
1005*0Sstevel@tonic-gate if (oval && oval != &PL_sv_undef) {
1006*0Sstevel@tonic-gate ptr = &HeVAL((HE*)ptr);
1007*0Sstevel@tonic-gate if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
1008*0Sstevel@tonic-gate (void)SvREFCNT_inc(*(SV**)ptr);
1009*0Sstevel@tonic-gate SvREFCNT_dec(sv);
1010*0Sstevel@tonic-gate av = (AV*)hv; /* what to refcnt_dec */
1011*0Sstevel@tonic-gate goto restore_sv;
1012*0Sstevel@tonic-gate }
1013*0Sstevel@tonic-gate }
1014*0Sstevel@tonic-gate SvREFCNT_dec(hv);
1015*0Sstevel@tonic-gate SvREFCNT_dec(sv);
1016*0Sstevel@tonic-gate SvREFCNT_dec(value);
1017*0Sstevel@tonic-gate break;
1018*0Sstevel@tonic-gate case SAVEt_OP:
1019*0Sstevel@tonic-gate PL_op = (OP*)SSPOPPTR;
1020*0Sstevel@tonic-gate break;
1021*0Sstevel@tonic-gate case SAVEt_HINTS:
1022*0Sstevel@tonic-gate if ((PL_hints & HINT_LOCALIZE_HH) && GvHV(PL_hintgv)) {
1023*0Sstevel@tonic-gate SvREFCNT_dec((SV*)GvHV(PL_hintgv));
1024*0Sstevel@tonic-gate GvHV(PL_hintgv) = NULL;
1025*0Sstevel@tonic-gate }
1026*0Sstevel@tonic-gate *(I32*)&PL_hints = (I32)SSPOPINT;
1027*0Sstevel@tonic-gate if (PL_hints & HINT_LOCALIZE_HH) {
1028*0Sstevel@tonic-gate SvREFCNT_dec((SV*)GvHV(PL_hintgv));
1029*0Sstevel@tonic-gate GvHV(PL_hintgv) = (HV*)SSPOPPTR;
1030*0Sstevel@tonic-gate }
1031*0Sstevel@tonic-gate
1032*0Sstevel@tonic-gate break;
1033*0Sstevel@tonic-gate case SAVEt_COMPPAD:
1034*0Sstevel@tonic-gate PL_comppad = (PAD*)SSPOPPTR;
1035*0Sstevel@tonic-gate if (PL_comppad)
1036*0Sstevel@tonic-gate PL_curpad = AvARRAY(PL_comppad);
1037*0Sstevel@tonic-gate else
1038*0Sstevel@tonic-gate PL_curpad = Null(SV**);
1039*0Sstevel@tonic-gate break;
1040*0Sstevel@tonic-gate case SAVEt_PADSV:
1041*0Sstevel@tonic-gate {
1042*0Sstevel@tonic-gate PADOFFSET off = (PADOFFSET)SSPOPLONG;
1043*0Sstevel@tonic-gate ptr = SSPOPPTR;
1044*0Sstevel@tonic-gate if (ptr)
1045*0Sstevel@tonic-gate AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
1046*0Sstevel@tonic-gate }
1047*0Sstevel@tonic-gate break;
1048*0Sstevel@tonic-gate default:
1049*0Sstevel@tonic-gate Perl_croak(aTHX_ "panic: leave_scope inconsistency");
1050*0Sstevel@tonic-gate }
1051*0Sstevel@tonic-gate }
1052*0Sstevel@tonic-gate }
1053*0Sstevel@tonic-gate
1054*0Sstevel@tonic-gate void
Perl_cx_dump(pTHX_ PERL_CONTEXT * cx)1055*0Sstevel@tonic-gate Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
1056*0Sstevel@tonic-gate {
1057*0Sstevel@tonic-gate #ifdef DEBUGGING
1058*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
1059*0Sstevel@tonic-gate if (CxTYPE(cx) != CXt_SUBST) {
1060*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
1061*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
1062*0Sstevel@tonic-gate PTR2UV(cx->blk_oldcop));
1063*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
1064*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
1065*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
1066*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
1067*0Sstevel@tonic-gate PTR2UV(cx->blk_oldpm));
1068*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
1069*0Sstevel@tonic-gate }
1070*0Sstevel@tonic-gate switch (CxTYPE(cx)) {
1071*0Sstevel@tonic-gate case CXt_NULL:
1072*0Sstevel@tonic-gate case CXt_BLOCK:
1073*0Sstevel@tonic-gate break;
1074*0Sstevel@tonic-gate case CXt_FORMAT:
1075*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
1076*0Sstevel@tonic-gate PTR2UV(cx->blk_sub.cv));
1077*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%"UVxf"\n",
1078*0Sstevel@tonic-gate PTR2UV(cx->blk_sub.gv));
1079*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%"UVxf"\n",
1080*0Sstevel@tonic-gate PTR2UV(cx->blk_sub.dfoutgv));
1081*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
1082*0Sstevel@tonic-gate (int)cx->blk_sub.hasargs);
1083*0Sstevel@tonic-gate break;
1084*0Sstevel@tonic-gate case CXt_SUB:
1085*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
1086*0Sstevel@tonic-gate PTR2UV(cx->blk_sub.cv));
1087*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
1088*0Sstevel@tonic-gate (long)cx->blk_sub.olddepth);
1089*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
1090*0Sstevel@tonic-gate (int)cx->blk_sub.hasargs);
1091*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n",
1092*0Sstevel@tonic-gate (int)cx->blk_sub.lval);
1093*0Sstevel@tonic-gate break;
1094*0Sstevel@tonic-gate case CXt_EVAL:
1095*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
1096*0Sstevel@tonic-gate (long)cx->blk_eval.old_in_eval);
1097*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
1098*0Sstevel@tonic-gate PL_op_name[cx->blk_eval.old_op_type],
1099*0Sstevel@tonic-gate PL_op_desc[cx->blk_eval.old_op_type]);
1100*0Sstevel@tonic-gate if (cx->blk_eval.old_namesv)
1101*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
1102*0Sstevel@tonic-gate SvPVX(cx->blk_eval.old_namesv));
1103*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
1104*0Sstevel@tonic-gate PTR2UV(cx->blk_eval.old_eval_root));
1105*0Sstevel@tonic-gate break;
1106*0Sstevel@tonic-gate
1107*0Sstevel@tonic-gate case CXt_LOOP:
1108*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n",
1109*0Sstevel@tonic-gate cx->blk_loop.label);
1110*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
1111*0Sstevel@tonic-gate (long)cx->blk_loop.resetsp);
1112*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%"UVxf"\n",
1113*0Sstevel@tonic-gate PTR2UV(cx->blk_loop.redo_op));
1114*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
1115*0Sstevel@tonic-gate PTR2UV(cx->blk_loop.next_op));
1116*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%"UVxf"\n",
1117*0Sstevel@tonic-gate PTR2UV(cx->blk_loop.last_op));
1118*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
1119*0Sstevel@tonic-gate (long)cx->blk_loop.iterix);
1120*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
1121*0Sstevel@tonic-gate PTR2UV(cx->blk_loop.iterary));
1122*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
1123*0Sstevel@tonic-gate PTR2UV(CxITERVAR(cx)));
1124*0Sstevel@tonic-gate if (CxITERVAR(cx))
1125*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%"UVxf"\n",
1126*0Sstevel@tonic-gate PTR2UV(cx->blk_loop.itersave));
1127*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%"UVxf"\n",
1128*0Sstevel@tonic-gate PTR2UV(cx->blk_loop.iterlval));
1129*0Sstevel@tonic-gate break;
1130*0Sstevel@tonic-gate
1131*0Sstevel@tonic-gate case CXt_SUBST:
1132*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
1133*0Sstevel@tonic-gate (long)cx->sb_iters);
1134*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
1135*0Sstevel@tonic-gate (long)cx->sb_maxiters);
1136*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
1137*0Sstevel@tonic-gate (long)cx->sb_rflags);
1138*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
1139*0Sstevel@tonic-gate (long)cx->sb_once);
1140*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
1141*0Sstevel@tonic-gate cx->sb_orig);
1142*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
1143*0Sstevel@tonic-gate PTR2UV(cx->sb_dstr));
1144*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
1145*0Sstevel@tonic-gate PTR2UV(cx->sb_targ));
1146*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
1147*0Sstevel@tonic-gate PTR2UV(cx->sb_s));
1148*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
1149*0Sstevel@tonic-gate PTR2UV(cx->sb_m));
1150*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
1151*0Sstevel@tonic-gate PTR2UV(cx->sb_strend));
1152*0Sstevel@tonic-gate PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
1153*0Sstevel@tonic-gate PTR2UV(cx->sb_rxres));
1154*0Sstevel@tonic-gate break;
1155*0Sstevel@tonic-gate }
1156*0Sstevel@tonic-gate #endif /* DEBUGGING */
1157*0Sstevel@tonic-gate }
1158