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