This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use SSize_t when extending the stack
[perl5.git] / scope.c
CommitLineData
a0d0e21e 1/* scope.c
79072805 2 *
1129b882
NC
3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
4 * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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/*
4ac71550
TC
12 * For the fashion of Minas Tirith was such that it was built on seven
13 * levels...
14 *
15 * [p.751 of _The Lord of the Rings_, V/i: "Minas Tirith"]
79072805
LW
16 */
17
ddfa107c 18/* This file contains functions to manipulate several of Perl's stacks;
166f8a29
DM
19 * in particular it contains code to push various types of things onto
20 * the savestack, then to pop them off and perform the correct restorative
21 * action for each one. This corresponds to the cleanup Perl does at
22 * each scope exit.
23 */
24
79072805 25#include "EXTERN.h"
864dbfa3 26#define PERL_IN_SCOPE_C
79072805
LW
27#include "perl.h"
28
a0d0e21e 29SV**
fc16c392 30Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n)
a0d0e21e 31{
97aff369 32 dVAR;
7918f24d
NC
33
34 PERL_ARGS_ASSERT_STACK_GROW;
35
3280af22 36 PL_stack_sp = sp;
2ce36478 37#ifndef STRESS_REALLOC
3280af22 38 av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
2ce36478 39#else
6b88bc9c 40 av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
2ce36478 41#endif
3280af22 42 return PL_stack_sp;
a0d0e21e
LW
43}
44
2ce36478
SM
45#ifndef STRESS_REALLOC
46#define GROW(old) ((old) * 3 / 2)
47#else
48#define GROW(old) ((old) + 1)
49#endif
50
e336de0d 51PERL_SI *
864dbfa3 52Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
e336de0d 53{
97aff369 54 dVAR;
e336de0d 55 PERL_SI *si;
a02a5408 56 Newx(si, 1, PERL_SI);
e336de0d
GS
57 si->si_stack = newAV();
58 AvREAL_off(si->si_stack);
59 av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0);
3280af22 60 AvALLOC(si->si_stack)[0] = &PL_sv_undef;
e336de0d
GS
61 AvFILLp(si->si_stack) = 0;
62 si->si_prev = 0;
63 si->si_next = 0;
64 si->si_cxmax = cxitems - 1;
65 si->si_cxix = -1;
e788e7d3 66 si->si_type = PERLSI_UNDEF;
a02a5408 67 Newx(si->si_cxstack, cxitems, PERL_CONTEXT);
9965345d
JH
68 /* Without any kind of initialising PUSHSUBST()
69 * in pp_subst() will read uninitialised heap. */
7e337ee0 70 PoisonNew(si->si_cxstack, cxitems, PERL_CONTEXT);
e336de0d
GS
71 return si;
72}
73
79072805 74I32
864dbfa3 75Perl_cxinc(pTHX)
79072805 76{
97aff369 77 dVAR;
a3b680e6 78 const IV old_max = cxstack_max;
2ce36478 79 cxstack_max = GROW(cxstack_max);
401a9b14 80 Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
9965345d
JH
81 /* Without any kind of initialising deep enough recursion
82 * will end up reading uninitialised PERL_CONTEXTs. */
109bf713 83 PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
79072805
LW
84 return cxstack_ix + 1;
85}
86
79072805 87void
864dbfa3 88Perl_push_scope(pTHX)
79072805 89{
97aff369 90 dVAR;
3280af22
NIS
91 if (PL_scopestack_ix == PL_scopestack_max) {
92 PL_scopestack_max = GROW(PL_scopestack_max);
93 Renew(PL_scopestack, PL_scopestack_max, I32);
d343c3ef
GG
94#ifdef DEBUGGING
95 Renew(PL_scopestack_name, PL_scopestack_max, const char*);
520bb150 96#endif
79072805 97 }
d343c3ef
GG
98#ifdef DEBUGGING
99 PL_scopestack_name[PL_scopestack_ix] = "unknown";
100#endif
3280af22 101 PL_scopestack[PL_scopestack_ix++] = PL_savestack_ix;
79072805
LW
102
103}
104
105void
864dbfa3 106Perl_pop_scope(pTHX)
79072805 107{
97aff369 108 dVAR;
35a4481c 109 const I32 oldsave = PL_scopestack[--PL_scopestack_ix];
8990e307 110 LEAVE_SCOPE(oldsave);
79072805
LW
111}
112
113void
864dbfa3 114Perl_markstack_grow(pTHX)
a0d0e21e 115{
97aff369 116 dVAR;
35a4481c
AL
117 const I32 oldmax = PL_markstack_max - PL_markstack;
118 const I32 newmax = GROW(oldmax);
a0d0e21e 119
3280af22
NIS
120 Renew(PL_markstack, newmax, I32);
121 PL_markstack_ptr = PL_markstack + oldmax;
122 PL_markstack_max = PL_markstack + newmax;
a0d0e21e
LW
123}
124
125void
864dbfa3 126Perl_savestack_grow(pTHX)
79072805 127{
97aff369 128 dVAR;
8aacddc1 129 PL_savestack_max = GROW(PL_savestack_max) + 4;
3280af22 130 Renew(PL_savestack, PL_savestack_max, ANY);
79072805
LW
131}
132
4b3c1a47
AE
133void
134Perl_savestack_grow_cnt(pTHX_ I32 need)
135{
97aff369 136 dVAR;
4b3c1a47
AE
137 PL_savestack_max = PL_savestack_ix + need;
138 Renew(PL_savestack, PL_savestack_max, ANY);
139}
140
2ce36478
SM
141#undef GROW
142
79072805 143void
e8eb279c 144Perl_tmps_grow(pTHX_ SSize_t n)
677b06e3 145{
97aff369 146 dVAR;
677b06e3
GS
147#ifndef STRESS_REALLOC
148 if (n < 128)
149 n = (PL_tmps_max < 512) ? 128 : 512;
150#endif
151 PL_tmps_max = PL_tmps_ix + n + 1;
152 Renew(PL_tmps_stack, PL_tmps_max, SV*);
153}
154
155
156void
864dbfa3 157Perl_free_tmps(pTHX)
79072805 158{
97aff369 159 dVAR;
79072805 160 /* XXX should tmps_floor live in cxstack? */
e8eb279c 161 const SSize_t myfloor = PL_tmps_floor;
3280af22 162 while (PL_tmps_ix > myfloor) { /* clean up after last statement */
22ade07d 163 SV* const sv = PL_tmps_stack[PL_tmps_ix--];
72581b5b
VP
164#ifdef PERL_POISON
165 PoisonWith(PL_tmps_stack + PL_tmps_ix + 1, 1, SV *, 0xAB);
22ade07d 166#endif
8aacddc1 167 if (sv && sv != &PL_sv_undef) {
463ee0b2 168 SvTEMP_off(sv);
4a9a56a7 169 SvREFCNT_dec_NN(sv); /* note, can modify tmps_ix!!! */
463ee0b2 170 }
79072805
LW
171 }
172}
173
76e3520e 174STATIC SV *
af7df257 175S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
79072805 176{
97aff369 177 dVAR;
75d34a09 178 SV * osv;
eb578fdb 179 SV *sv;
79072805 180
7918f24d
NC
181 PERL_ARGS_ASSERT_SAVE_SCALAR_AT;
182
75d34a09
VP
183 osv = *sptr;
184 sv = (flags & SAVEf_KEEPOLDELEM) ? osv : (*sptr = newSV(0));
185
f1f99dc1 186 if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv)) {
a0d0e21e 187 if (SvGMAGICAL(osv)) {
a0d0e21e 188 SvFLAGS(osv) |= (SvFLAGS(osv) &
c268c2a6 189 (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
a0d0e21e 190 }
75d34a09 191 if (!(flags & SAVEf_KEEPOLDELEM))
2dcac756 192 mg_localize(osv, sv, cBOOL(flags & SAVEf_SETMAGIC));
79072805 193 }
75d34a09 194
79072805
LW
195 return sv;
196}
197
dfcd3de5
NC
198void
199Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
e22024d3
NC
200{
201 dVAR;
a3444cc5
DM
202 dSS_ADD;
203 SS_ADD_PTR(ptr1);
204 SS_ADD_PTR(ptr2);
205 SS_ADD_UV(type);
206 SS_ADD_END(3);
e22024d3
NC
207}
208
7a4c00b4 209SV *
864dbfa3 210Perl_save_scalar(pTHX_ GV *gv)
7a4c00b4 211{
97aff369 212 dVAR;
fb4fc1fa 213 SV ** const sptr = &GvSVn(gv);
7918f24d
NC
214
215 PERL_ARGS_ASSERT_SAVE_SCALAR;
216
b492a59e
DM
217 if (SvGMAGICAL(*sptr)) {
218 PL_localizing = 1;
219 (void)mg_get(*sptr);
220 PL_localizing = 0;
221 }
e22024d3 222 save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(*sptr), SAVEt_SV);
af7df257 223 return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
7a4c00b4
PP
224}
225
f4dd75d9 226/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to
b9d12d37
GS
227 * restore a global SV to its prior contents, freeing new value. */
228void
864dbfa3 229Perl_save_generic_svref(pTHX_ SV **sptr)
b9d12d37 230{
97aff369 231 dVAR;
7918f24d
NC
232
233 PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF;
234
e22024d3 235 save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_GENERIC_SVREF);
b9d12d37
GS
236}
237
f4dd75d9
GS
238/* Like save_pptr(), but also Safefree()s the new value if it is different
239 * from the old one. Can be used to restore a global char* to its prior
240 * contents, freeing new value. */
241void
242Perl_save_generic_pvref(pTHX_ char **str)
243{
97aff369 244 dVAR;
7918f24d
NC
245
246 PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF;
247
e22024d3 248 save_pushptrptr(*str, str, SAVEt_GENERIC_PVREF);
f4dd75d9
GS
249}
250
05ec9bb3
NIS
251/* Like save_generic_pvref(), but uses PerlMemShared_free() rather than Safefree().
252 * Can be used to restore a shared global char* to its prior
253 * contents, freeing new value. */
254void
255Perl_save_shared_pvref(pTHX_ char **str)
256{
97aff369 257 dVAR;
7918f24d
NC
258
259 PERL_ARGS_ASSERT_SAVE_SHARED_PVREF;
260
e22024d3 261 save_pushptrptr(str, *str, SAVEt_SHARED_PVREF);
05ec9bb3
NIS
262}
263
14f338dc
DM
264/* set the SvFLAGS specified by mask to the values in val */
265
266void
267Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
268{
97aff369 269 dVAR;
a3444cc5 270 dSS_ADD;
7918f24d
NC
271
272 PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS;
273
a3444cc5
DM
274 SS_ADD_PTR(sv);
275 SS_ADD_INT(mask);
276 SS_ADD_INT(val);
277 SS_ADD_UV(SAVEt_SET_SVFLAGS);
278 SS_ADD_END(4);
14f338dc
DM
279}
280
79072805 281void
864dbfa3 282Perl_save_gp(pTHX_ GV *gv, I32 empty)
79072805 283{
97aff369 284 dVAR;
7918f24d
NC
285
286 PERL_ARGS_ASSERT_SAVE_GP;
287
10507e11 288 save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
79072805 289
5f05dabc 290 if (empty) {
12816592 291 GP *gp = Perl_newGP(aTHX_ gv);
959f7ad7 292 HV * const stash = GvSTASH(gv);
3d460042
FC
293 bool isa_changed = 0;
294
295 if (stash && HvENAME(stash)) {
296 if (GvNAMELEN(gv) == 3 && strnEQ(GvNAME(gv), "ISA", 3))
297 isa_changed = TRUE;
298 else if (GvCVu(gv))
299 /* taking a method out of circulation ("local")*/
300 mro_method_changed_in(stash);
301 }
146174a9
CB
302 if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) {
303 gp->gp_io = newIO();
304 IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
305 }
c43ae56f 306 GvGP_set(gv,gp);
3d460042 307 if (isa_changed) mro_isa_changed_in(stash);
5f05dabc
PP
308 }
309 else {
44a8e56a 310 gp_ref(GvGP(gv));
5f05dabc
PP
311 GvINTRO_on(gv);
312 }
79072805 313}
79072805 314
79072805 315AV *
864dbfa3 316Perl_save_ary(pTHX_ GV *gv)
79072805 317{
97aff369 318 dVAR;
901017d6 319 AV * const oav = GvAVn(gv);
67a38de0 320 AV *av;
fb73857a 321
7918f24d
NC
322 PERL_ARGS_ASSERT_SAVE_ARY;
323
67a38de0
NIS
324 if (!AvREAL(oav) && AvREIFY(oav))
325 av_reify(oav);
01433346 326 save_pushptrptr(SvREFCNT_inc_simple_NN(gv), oav, SAVEt_AV);
79072805 327
4608196e 328 GvAV(gv) = NULL;
fb73857a 329 av = GvAVn(gv);
0cbee0a4 330 if (SvMAGIC(oav))
9711599e 331 mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE);
fb73857a 332 return av;
79072805
LW
333}
334
335HV *
864dbfa3 336Perl_save_hash(pTHX_ GV *gv)
79072805 337{
97aff369 338 dVAR;
fb73857a
PP
339 HV *ohv, *hv;
340
7918f24d
NC
341 PERL_ARGS_ASSERT_SAVE_HASH;
342
01433346
FC
343 save_pushptrptr(
344 SvREFCNT_inc_simple_NN(gv), (ohv = GvHVn(gv)), SAVEt_HV
345 );
79072805 346
4608196e 347 GvHV(gv) = NULL;
fb73857a 348 hv = GvHVn(gv);
0cbee0a4 349 if (SvMAGIC(ohv))
9711599e 350 mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE);
fb73857a 351 return hv;
79072805
LW
352}
353
354void
5aaab254 355Perl_save_item(pTHX_ SV *item)
79072805 356{
97aff369 357 dVAR;
eb578fdb 358 SV * const sv = newSVsv(item);
79072805 359
7918f24d
NC
360 PERL_ARGS_ASSERT_SAVE_ITEM;
361
e22024d3
NC
362 save_pushptrptr(item, /* remember the pointer */
363 sv, /* remember the value */
364 SAVEt_ITEM);
79072805
LW
365}
366
367void
1409bc06 368Perl_save_bool(pTHX_ bool *boolp)
79072805 369{
97aff369 370 dVAR;
a3444cc5 371 dSS_ADD;
7918f24d 372
1409bc06 373 PERL_ARGS_ASSERT_SAVE_BOOL;
7918f24d 374
a3444cc5
DM
375 SS_ADD_PTR(boolp);
376 SS_ADD_UV(SAVEt_BOOL | (*boolp << 8));
377 SS_ADD_END(2);
1409bc06
NC
378}
379
7623d426
NC
380void
381Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type)
1409bc06
NC
382{
383 dVAR;
a3444cc5
DM
384 dSS_ADD;
385
386 SS_ADD_INT(i);
387 SS_ADD_PTR(ptr);
388 SS_ADD_UV(type);
389 SS_ADD_END(3);
79072805
LW
390}
391
392void
1409bc06 393Perl_save_int(pTHX_ int *intp)
9febdf04 394{
97aff369 395 dVAR;
d172696c 396 const int i = *intp;
9b139d09 397 UV type = ((UV)((UV)i << SAVE_TIGHT_SHIFT) | SAVEt_INT_SMALL);
d172696c
DM
398 int size = 2;
399 dSS_ADD;
7918f24d 400
1409bc06 401 PERL_ARGS_ASSERT_SAVE_INT;
7918f24d 402
d172696c
DM
403 if ((int)(type >> SAVE_TIGHT_SHIFT) != i) {
404 SS_ADD_INT(i);
405 type = SAVEt_INT;
406 size++;
407 }
408 SS_ADD_PTR(intp);
409 SS_ADD_UV(type);
410 SS_ADD_END(size);
9febdf04
RH
411}
412
413void
58188858
RGS
414Perl_save_I8(pTHX_ I8 *bytep)
415{
416 dVAR;
a3444cc5 417 dSS_ADD;
7918f24d
NC
418
419 PERL_ARGS_ASSERT_SAVE_I8;
420
a3444cc5
DM
421 SS_ADD_PTR(bytep);
422 SS_ADD_UV(SAVEt_I8 | ((UV)*bytep << 8));
423 SS_ADD_END(2);
58188858
RGS
424}
425
426void
87a84751
JH
427Perl_save_I16(pTHX_ I16 *intp)
428{
429 dVAR;
a3444cc5 430 dSS_ADD;
7918f24d
NC
431
432 PERL_ARGS_ASSERT_SAVE_I16;
433
a3444cc5
DM
434 SS_ADD_PTR(intp);
435 SS_ADD_UV(SAVEt_I16 | ((UV)*intp << 8));
436 SS_ADD_END(2);
87a84751
JH
437}
438
439void
864dbfa3 440Perl_save_I32(pTHX_ I32 *intp)
79072805 441{
97aff369 442 dVAR;
d172696c 443 const I32 i = *intp;
9b139d09 444 UV type = ((I32)((U32)i << SAVE_TIGHT_SHIFT) | SAVEt_I32_SMALL);
d172696c
DM
445 int size = 2;
446 dSS_ADD;
7918f24d
NC
447
448 PERL_ARGS_ASSERT_SAVE_I32;
449
d172696c
DM
450 if ((I32)(type >> SAVE_TIGHT_SHIFT) != i) {
451 SS_ADD_INT(i);
452 type = SAVEt_I32;
453 size++;
454 }
455 SS_ADD_PTR(intp);
456 SS_ADD_UV(type);
457 SS_ADD_END(size);
79072805
LW
458}
459
e8eb279c
FC
460void
461Perl_save_strlen(pTHX_ STRLEN *ptr)
462{
463 dVAR;
464 dSS_ADD;
465
466 PERL_ARGS_ASSERT_SAVE_STRLEN;
467
468 SS_ADD_IV(*ptr);
469 SS_ADD_PTR(ptr);
470 SS_ADD_UV(SAVEt_STRLEN);
471 SS_ADD_END(3);
472}
473
85e6fe83
LW
474/* Cannot use save_sptr() to store a char* since the SV** cast will
475 * force word-alignment and we'll miss the pointer.
476 */
477void
864dbfa3 478Perl_save_pptr(pTHX_ char **pptr)
85e6fe83 479{
97aff369 480 dVAR;
7918f24d
NC
481
482 PERL_ARGS_ASSERT_SAVE_PPTR;
483
e22024d3 484 save_pushptrptr(*pptr, pptr, SAVEt_PPTR);
85e6fe83
LW
485}
486
79072805 487void
146174a9
CB
488Perl_save_vptr(pTHX_ void *ptr)
489{
97aff369 490 dVAR;
7918f24d
NC
491
492 PERL_ARGS_ASSERT_SAVE_VPTR;
493
e22024d3 494 save_pushptrptr(*(char**)ptr, ptr, SAVEt_VPTR);
146174a9
CB
495}
496
497void
864dbfa3 498Perl_save_sptr(pTHX_ SV **sptr)
79072805 499{
97aff369 500 dVAR;
7918f24d
NC
501
502 PERL_ARGS_ASSERT_SAVE_SPTR;
503
e22024d3 504 save_pushptrptr(*sptr, sptr, SAVEt_SPTR);
79072805
LW
505}
506
c3564e5c 507void
09edbca0 508Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
c3564e5c 509{
97aff369 510 dVAR;
a3444cc5
DM
511 dSS_ADD;
512
f3548bdc 513 ASSERT_CURPAD_ACTIVE("save_padsv");
a3444cc5
DM
514 SS_ADD_PTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
515 SS_ADD_PTR(PL_comppad);
03dba561 516 SS_ADD_UV((UV)off);
a3444cc5
DM
517 SS_ADD_UV(SAVEt_PADSV_AND_MORTALIZE);
518 SS_ADD_END(4);
c3564e5c
GS
519}
520
79072805 521void
864dbfa3 522Perl_save_hptr(pTHX_ HV **hptr)
79072805 523{
97aff369 524 dVAR;
7918f24d
NC
525
526 PERL_ARGS_ASSERT_SAVE_HPTR;
527
e22024d3 528 save_pushptrptr(*hptr, hptr, SAVEt_HPTR);
79072805
LW
529}
530
531void
864dbfa3 532Perl_save_aptr(pTHX_ AV **aptr)
79072805 533{
97aff369 534 dVAR;
7918f24d
NC
535
536 PERL_ARGS_ASSERT_SAVE_APTR;
537
e22024d3 538 save_pushptrptr(*aptr, aptr, SAVEt_APTR);
79072805
LW
539}
540
541void
2fd8beea 542Perl_save_pushptr(pTHX_ void *const ptr, const int type)
8990e307 543{
97aff369 544 dVAR;
a3444cc5
DM
545 dSS_ADD;
546 SS_ADD_PTR(ptr);
547 SS_ADD_UV(type);
548 SS_ADD_END(2);
8990e307
LW
549}
550
551void
864dbfa3 552Perl_save_clearsv(pTHX_ SV **svp)
8990e307 553{
97aff369 554 dVAR;
cdcdfc56
NC
555 const UV offset = svp - PL_curpad;
556 const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
7918f24d
NC
557
558 PERL_ARGS_ASSERT_SAVE_CLEARSV;
559
f3548bdc 560 ASSERT_CURPAD_ACTIVE("save_clearsv");
623e28c6 561 SvPADSTALE_off(*svp); /* mark lexical as active */
a3444cc5 562 if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset) {
cdcdfc56
NC
563 Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
564 offset, svp, PL_curpad);
a3444cc5 565 }
cdcdfc56 566
a3444cc5
DM
567 {
568 dSS_ADD;
569 SS_ADD_UV(offset_shifted | SAVEt_CLEARSV);
570 SS_ADD_END(1);
571 }
8990e307
LW
572}
573
574void
864dbfa3 575Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
8990e307 576{
97aff369 577 dVAR;
7918f24d
NC
578
579 PERL_ARGS_ASSERT_SAVE_DELETE;
580
85a721ca 581 save_pushptri32ptr(key, klen, SvREFCNT_inc_simple(hv), SAVEt_DELETE);
8990e307
LW
582}
583
584void
af097752
VP
585Perl_save_hdelete(pTHX_ HV *hv, SV *keysv)
586{
587 STRLEN len;
588 I32 klen;
589 const char *key;
590
591 PERL_ARGS_ASSERT_SAVE_HDELETE;
592
593 key = SvPV_const(keysv, len);
594 klen = SvUTF8(keysv) ? -(I32)len : (I32)len;
595 SvREFCNT_inc_simple_void_NN(hv);
596 save_pushptri32ptr(savepvn(key, len), klen, hv, SAVEt_DELETE);
597}
598
599void
c68ec7a9
VP
600Perl_save_adelete(pTHX_ AV *av, I32 key)
601{
602 dVAR;
603
604 PERL_ARGS_ASSERT_SAVE_ADELETE;
605
606 SvREFCNT_inc_void(av);
607 save_pushi32ptr(key, av, SAVEt_ADELETE);
608}
609
610void
12ab1f58
JH
611Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
612{
613 dVAR;
a3444cc5 614 dSS_ADD;
7918f24d
NC
615
616 PERL_ARGS_ASSERT_SAVE_DESTRUCTOR;
617
a3444cc5
DM
618 SS_ADD_DPTR(f);
619 SS_ADD_PTR(p);
620 SS_ADD_UV(SAVEt_DESTRUCTOR);
621 SS_ADD_END(3);
12ab1f58
JH
622}
623
624void
146174a9
CB
625Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
626{
97aff369 627 dVAR;
a3444cc5
DM
628 dSS_ADD;
629
630 SS_ADD_DXPTR(f);
631 SS_ADD_PTR(p);
632 SS_ADD_UV(SAVEt_DESTRUCTOR_X);
633 SS_ADD_END(3);
146174a9
CB
634}
635
636void
da8315f8
NC
637Perl_save_hints(pTHX)
638{
639 dVAR;
20439bc7 640 COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
da8315f8 641 if (PL_hints & HINT_LOCALIZE_HH) {
52c7aca6
FC
642 HV *oldhh = GvHV(PL_hintgv);
643 save_pushptri32ptr(oldhh, PL_hints, save_cophh, SAVEt_HINTS);
644 GvHV(PL_hintgv) = NULL; /* in case copying dies */
645 GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh);
be84297e 646 } else {
20439bc7 647 save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS);
da8315f8 648 }
be84297e
NC
649}
650
651static void
652S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2,
653 const int type)
654{
a3444cc5
DM
655 dSS_ADD;
656 SS_ADD_PTR(ptr1);
657 SS_ADD_INT(i);
658 SS_ADD_PTR(ptr2);
659 SS_ADD_UV(type);
660 SS_ADD_END(4);
da8315f8
NC
661}
662
663void
91d1c79f 664Perl_save_aelem_flags(pTHX_ AV *av, I32 idx, SV **sptr, const U32 flags)
4e4c362e 665{
97aff369 666 dVAR;
bfc4de9f 667 SV *sv;
7918f24d 668
91d1c79f 669 PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS;
7918f24d 670
0cbee0a4 671 SvGETMAGIC(*sptr);
be84297e
NC
672 save_pushptri32ptr(SvREFCNT_inc_simple(av), idx, SvREFCNT_inc(*sptr),
673 SAVEt_AELEM);
1cdc9186
FC
674 /* The array needs to hold a reference count on its new element, so it
675 must be AvREAL. */
5dd42e15 676 if (!AvREAL(av) && AvREIFY(av))
1cdc9186 677 av_reify(av);
91d1c79f 678 save_scalar_at(sptr, flags); /* XXX - FIXME - see #60360 */
75d34a09
VP
679 if (flags & SAVEf_KEEPOLDELEM)
680 return;
bfc4de9f
DM
681 sv = *sptr;
682 /* If we're localizing a tied array element, this new sv
683 * won't actually be stored in the array - so it won't get
684 * reaped when the localize ends. Ensure it gets reaped by
685 * mortifying it instead. DAPM */
daeb922a 686 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
bfc4de9f 687 sv_2mortal(sv);
4e4c362e
GS
688}
689
690void
af7df257 691Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
4e4c362e 692{
97aff369 693 dVAR;
bfc4de9f 694 SV *sv;
7918f24d 695
af7df257 696 PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS;
7918f24d 697
0cbee0a4 698 SvGETMAGIC(*sptr);
a3444cc5
DM
699 {
700 dSS_ADD;
701 SS_ADD_PTR(SvREFCNT_inc_simple(hv));
702 SS_ADD_PTR(newSVsv(key));
703 SS_ADD_PTR(SvREFCNT_inc(*sptr));
704 SS_ADD_UV(SAVEt_HELEM);
705 SS_ADD_END(4);
706 }
af7df257 707 save_scalar_at(sptr, flags);
75d34a09
VP
708 if (flags & SAVEf_KEEPOLDELEM)
709 return;
bfc4de9f
DM
710 sv = *sptr;
711 /* If we're localizing a tied hash element, this new sv
712 * won't actually be stored in the hash - so it won't get
713 * reaped when the localize ends. Ensure it gets reaped by
714 * mortifying it instead. DAPM */
daeb922a 715 if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))
bfc4de9f 716 sv_2mortal(sv);
4e4c362e
GS
717}
718
2053acbf
NC
719SV*
720Perl_save_svref(pTHX_ SV **sptr)
721{
722 dVAR;
7918f24d
NC
723
724 PERL_ARGS_ASSERT_SAVE_SVREF;
725
2053acbf 726 SvGETMAGIC(*sptr);
e22024d3 727 save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_SVREF);
af7df257 728 return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
2053acbf
NC
729}
730
455ece5e 731I32
864dbfa3 732Perl_save_alloc(pTHX_ I32 size, I32 pad)
455ece5e 733{
97aff369 734 dVAR;
eb578fdb
KW
735 const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
736 - (char*)PL_savestack);
1be36ce0
NC
737 const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
738 const UV elems_shifted = elems << SAVE_TIGHT_SHIFT;
455ece5e 739
1be36ce0 740 if ((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)
93a641ae
DM
741 Perl_croak(aTHX_
742 "panic: save_alloc elems %"UVuf" out of range (%"IVdf"-%"IVdf")",
743 elems, (IV)size, (IV)pad);
1be36ce0
NC
744
745 SSGROW(elems + 1);
455ece5e
AD
746
747 PL_savestack_ix += elems;
1be36ce0 748 SSPUSHUV(SAVEt_ALLOC | elems_shifted);
455ece5e
AD
749 return start;
750}
751
03dba561
DM
752
753
754#define ARG0_SV MUTABLE_SV(arg0.any_ptr)
755#define ARG0_AV MUTABLE_AV(arg0.any_ptr)
756#define ARG0_HV MUTABLE_HV(arg0.any_ptr)
757#define ARG0_PTR arg0.any_ptr
758#define ARG0_PV (char*)(arg0.any_ptr)
759#define ARG0_PVP (char**)(arg0.any_ptr)
760#define ARG0_I32 (arg0.any_i32)
761
762#define ARG1_SV MUTABLE_SV(arg1.any_ptr)
763#define ARG1_AV MUTABLE_AV(arg1.any_ptr)
764#define ARG1_GV MUTABLE_GV(arg1.any_ptr)
765#define ARG1_SVP (SV**)(arg1.any_ptr)
766#define ARG1_PVP (char**)(arg1.any_ptr)
767#define ARG1_PTR arg1.any_ptr
768#define ARG1_PV (char*)(arg1.any_ptr)
769#define ARG1_I32 (arg1.any_i32)
770
771#define ARG2_SV MUTABLE_SV(arg2.any_ptr)
772#define ARG2_AV MUTABLE_AV(arg2.any_ptr)
773#define ARG2_HV MUTABLE_HV(arg2.any_ptr)
774#define ARG2_GV MUTABLE_GV(arg2.any_ptr)
775#define ARG2_PV (char*)(arg2.any_ptr)
776
462e5cf6 777void
864dbfa3 778Perl_leave_scope(pTHX_ I32 base)
79072805 779{
97aff369 780 dVAR;
03dba561 781
302c0c93 782 /* Localise the effects of the TAINT_NOT inside the loop. */
284167a5 783 bool was = TAINT_get;
79072805 784
03dba561
DM
785 ANY arg0, arg1, arg2;
786
787 /* these initialisations are logically unnecessary, but they shut up
788 * spurious 'may be used uninitialized' compiler warnings */
789 arg0.any_ptr = NULL;
790 arg1.any_ptr = NULL;
791 arg2.any_ptr = NULL;
792
79072805 793 if (base < -1)
5637ef5b 794 Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base);
1c98cc53
DM
795 DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n",
796 (long)PL_savestack_ix, (long)base));
3280af22 797 while (PL_savestack_ix > base) {
03dba561
DM
798 UV uv;
799 U8 type;
800
801 SV *refsv;
802 SV **svp;
803
c6ae7647
NC
804 TAINT_NOT;
805
03dba561
DM
806 {
807 I32 ix = PL_savestack_ix - 1;
808 ANY *p = &PL_savestack[ix];
809 uv = p->any_uv;
810 type = (U8)uv & SAVE_MASK;
811 if (type > SAVEt_ARG0_MAX) {
812 ANY *p0 = p;
813 arg0 = *--p;
814 if (type > SAVEt_ARG1_MAX) {
815 arg1 = *--p;
816 if (type > SAVEt_ARG2_MAX) {
817 arg2 = *--p;
818 }
819 }
820 ix -= (p0 - p);
821 }
822 PL_savestack_ix = ix;
823 }
824
c6bf6a65 825 switch (type) {
79072805 826 case SAVEt_ITEM: /* normal string */
03dba561 827 sv_replace(ARG1_SV, ARG0_SV);
b492a59e
DM
828 if (SvSMAGICAL(ARG1_SV)) {
829 PL_localizing = 2;
830 mg_set(ARG1_SV);
831 PL_localizing = 0;
832 }
79072805 833 break;
03dba561
DM
834
835 /* This would be a mathom, but Perl_save_svref() calls a static
836 function, S_save_scalar_at(), so has to stay in this file. */
837 case SAVEt_SVREF: /* scalar reference */
838 svp = ARG1_SVP;
839 refsv = NULL; /* what to refcnt_dec */
840 goto restore_sv;
841
8aacddc1 842 case SAVEt_SV: /* scalar reference */
03dba561
DM
843 svp = &GvSV(ARG1_GV);
844 refsv = ARG1_SV; /* what to refcnt_dec */
2053acbf 845 restore_sv:
03dba561
DM
846 {
847 SV * const sv = *svp;
848 *svp = ARG0_SV;
2053acbf 849 SvREFCNT_dec(sv);
b492a59e
DM
850 if (SvSMAGICAL(ARG0_SV)) {
851 PL_localizing = 2;
852 mg_set(ARG0_SV);
853 PL_localizing = 0;
854 }
4a9a56a7 855 SvREFCNT_dec_NN(ARG0_SV);
03dba561 856 SvREFCNT_dec(refsv);
2053acbf 857 break;
03dba561 858 }
8aacddc1 859 case SAVEt_GENERIC_PVREF: /* generic pv */
03dba561
DM
860 if (*ARG0_PVP != ARG1_PV) {
861 Safefree(*ARG0_PVP);
862 *ARG0_PVP = ARG1_PV;
f4dd75d9
GS
863 }
864 break;
05ec9bb3 865 case SAVEt_SHARED_PVREF: /* shared pv */
03dba561 866 if (*ARG1_PVP != ARG0_PV) {
5e54c26f 867#ifdef NETWARE
03dba561 868 PerlMem_free(*ARG1_PVP);
5e54c26f 869#else
03dba561 870 PerlMemShared_free(*ARG1_PVP);
5e54c26f 871#endif
03dba561 872 *ARG1_PVP = ARG0_PV;
05ec9bb3
NIS
873 }
874 break;
f83b46a0 875 case SAVEt_GVSV: /* scalar slot in GV */
03dba561 876 svp = &GvSV(ARG1_GV);
f83b46a0 877 goto restore_svp;
8aacddc1 878 case SAVEt_GENERIC_SVREF: /* generic sv */
03dba561 879 svp = ARG1_SVP;
f83b46a0 880 restore_svp:
03dba561
DM
881 {
882 SV * const sv = *svp;
883 *svp = ARG0_SV;
f4dd75d9 884 SvREFCNT_dec(sv);
03dba561 885 SvREFCNT_dec(ARG0_SV);
b9d12d37 886 break;
03dba561 887 }
db9306af 888 case SAVEt_GVSLOT: /* any slot in GV */
03dba561
DM
889 {
890 HV *const hv = GvSTASH(ARG2_GV);
891 svp = ARG1_SVP;
db9306af 892 if (hv && HvENAME(hv) && (
03dba561
DM
893 (ARG0_SV && SvTYPE(ARG0_SV) == SVt_PVCV)
894 || (*svp && SvTYPE(*svp) == SVt_PVCV)
db9306af
FC
895 ))
896 {
03dba561
DM
897 if ((char *)svp < (char *)GvGP(ARG2_GV)
898 || (char *)svp > (char *)GvGP(ARG2_GV) + sizeof(struct gp)
899 || GvREFCNT(ARG2_GV) > 1)
db9306af
FC
900 PL_sub_generation++;
901 else mro_method_changed_in(hv);
902 }
903 goto restore_svp;
03dba561 904 }
8aacddc1 905 case SAVEt_AV: /* array reference */
03dba561
DM
906 SvREFCNT_dec(GvAV(ARG1_GV));
907 GvAV(ARG1_GV) = ARG0_AV;
b492a59e
DM
908 if (SvSMAGICAL(ARG0_SV)) {
909 PL_localizing = 2;
910 mg_set(ARG0_SV);
911 PL_localizing = 0;
912 }
4a9a56a7 913 SvREFCNT_dec_NN(ARG1_GV);
8aacddc1
NIS
914 break;
915 case SAVEt_HV: /* hash reference */
03dba561
DM
916 SvREFCNT_dec(GvHV(ARG1_GV));
917 GvHV(ARG1_GV) = ARG0_HV;
b492a59e
DM
918 if (SvSMAGICAL(ARG0_SV)) {
919 PL_localizing = 2;
920 mg_set(ARG0_SV);
921 PL_localizing = 0;
922 }
4a9a56a7 923 SvREFCNT_dec_NN(ARG1_GV);
8aacddc1 924 break;
994d373a 925 case SAVEt_INT_SMALL:
03dba561 926 *(int*)ARG0_PTR = (int)(uv >> SAVE_TIGHT_SHIFT);
994d373a 927 break;
79072805 928 case SAVEt_INT: /* int reference */
03dba561 929 *(int*)ARG0_PTR = (int)ARG1_I32;
79072805 930 break;
e8eb279c
FC
931 case SAVEt_STRLEN: /* STRLEN/size_t ref */
932 *(STRLEN*)ARG0_PTR = (STRLEN)arg1.any_iv;
933 break;
9febdf04 934 case SAVEt_BOOL: /* bool reference */
03dba561 935 *(bool*)ARG0_PTR = cBOOL(uv >> 8);
9a9b5ec9
DM
936#ifdef NO_TAINT_SUPPORT
937 PERL_UNUSED_VAR(was);
938#else
03dba561 939 if (ARG0_PTR == &(TAINT_get)) {
b6f93e7a
KW
940 /* If we don't update <was>, to reflect what was saved on the
941 * stack for PL_tainted, then we will overwrite this attempt to
942 * restore it when we exit this routine. Note that this won't
943 * work if this value was saved in a wider-than necessary type,
944 * such as I32 */
03dba561 945 was = *(bool*)ARG0_PTR;
b6f93e7a 946 }
284167a5 947#endif
9febdf04 948 break;
89abef21 949 case SAVEt_I32_SMALL:
03dba561 950 *(I32*)ARG0_PTR = (I32)(uv >> SAVE_TIGHT_SHIFT);
89abef21 951 break;
79072805 952 case SAVEt_I32: /* I32 reference */
3235b7a3 953#ifdef PERL_DEBUG_READONLY_OPS
03dba561 954 if (*(I32*)ARG0_PTR != ARG1_I32)
3235b7a3 955#endif
03dba561 956 *(I32*)ARG0_PTR = ARG1_I32;
79072805
LW
957 break;
958 case SAVEt_SPTR: /* SV* reference */
03dba561 959 *(SV**)(ARG0_PTR)= ARG1_SV;
79072805 960 break;
146174a9 961 case SAVEt_VPTR: /* random* reference */
85e6fe83 962 case SAVEt_PPTR: /* char* reference */
03dba561 963 *ARG0_PVP = ARG1_PV;
85e6fe83 964 break;
79072805 965 case SAVEt_HPTR: /* HV* reference */
03dba561 966 *(HV**)ARG0_PTR = MUTABLE_HV(ARG1_PTR);
79072805
LW
967 break;
968 case SAVEt_APTR: /* AV* reference */
03dba561 969 *(AV**)ARG0_PTR = ARG1_AV;
79072805 970 break;
fb73857a 971 case SAVEt_GP: /* scalar reference */
03dba561
DM
972 {
973 HV *hv;
974 /* possibly taking a method out of circulation */
975 const bool had_method = !!GvCVu(ARG1_GV);
976 gp_free(ARG1_GV);
977 GvGP_set(ARG1_GV, (GP*)ARG0_PTR);
978 if ((hv=GvSTASH(ARG1_GV)) && HvENAME_get(hv)) {
979 if ( GvNAMELEN(ARG1_GV) == 3
980 && strnEQ(GvNAME(ARG1_GV), "ISA", 3)
981 )
982 mro_isa_changed_in(hv);
983 else if (had_method || GvCVu(ARG1_GV))
984 /* putting a method back into circulation ("local")*/
985 gv_method_changed(ARG1_GV);
3d460042 986 }
4a9a56a7 987 SvREFCNT_dec_NN(ARG1_GV);
8aacddc1 988 break;
03dba561 989 }
8990e307 990 case SAVEt_FREESV:
03dba561 991 SvREFCNT_dec(ARG0_SV);
8990e307 992 break;
3987a177 993 case SAVEt_FREECOPHH:
03dba561 994 cophh_free((COPHH *)ARG0_PTR);
3987a177 995 break;
26d9b02f 996 case SAVEt_MORTALIZESV:
03dba561 997 sv_2mortal(ARG0_SV);
26d9b02f 998 break;
8990e307 999 case SAVEt_FREEOP:
5e5ba94b 1000 ASSERT_CURPAD_LEGAL("SAVEt_FREEOP");
03dba561 1001 op_free((OP*)ARG0_PTR);
8990e307
LW
1002 break;
1003 case SAVEt_FREEPV:
03dba561 1004 Safefree(ARG0_PTR);
8990e307 1005 break;
4e09461c
DM
1006
1007 {
1008 SV **svp;
03dba561
DM
1009 I32 i;
1010 SV *sv;
1011
4e09461c
DM
1012 case SAVEt_CLEARPADRANGE:
1013 i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK);
1014 svp = &PL_curpad[uv >>
1015 (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)] + i - 1;
1016 goto clearsv;
8990e307 1017 case SAVEt_CLEARSV:
4e09461c
DM
1018 svp = &PL_curpad[uv >> SAVE_TIGHT_SHIFT];
1019 i = 1;
1020 clearsv:
1021 for (; i; i--, svp--) {
528ad060
DM
1022 sv = *svp;
1023
1024 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1025 "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
1026 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1027 (long)(svp-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
1028 (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
1029 ));
1030
1031 /* Can clear pad variable in place? */
1032 if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
1033 /*
1034 * if a my variable that was made readonly is going out of
1035 * scope, we want to remove the readonlyness so that it can
1036 * go out of scope quietly
1037 */
1038 if (SvPADMY(sv) && !SvFAKE(sv))
1039 SvREADONLY_off(sv);
1040
1041 if (SvTHINKFIRST(sv))
1042 sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF
1043 |SV_COW_DROP_PV);
1044 if (SvTYPE(sv) == SVt_PVHV)
1045 Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
1046 if (SvMAGICAL(sv))
1047 {
1048 sv_unmagic(sv, PERL_MAGIC_backref);
1049 if (SvTYPE(sv) != SVt_PVCV)
1050 mg_free(sv);
1051 }
1052
1053 switch (SvTYPE(sv)) {
1054 case SVt_NULL:
1055 break;
1056 case SVt_PVAV:
1057 av_clear(MUTABLE_AV(sv));
1058 break;
1059 case SVt_PVHV:
1060 hv_clear(MUTABLE_HV(sv));
1061 break;
1062 case SVt_PVCV:
1063 {
1064 HEK * const hek = CvNAME_HEK((CV *)sv);
1065 assert(hek);
1066 share_hek_hek(hek);
1067 cv_undef((CV *)sv);
1068 CvNAME_HEK_set(sv, hek);
1069 break;
1070 }
1071 default:
1072 SvOK_off(sv);
1073 break;
1074 }
1075 SvPADSTALE_on(sv); /* mark as no longer live */
1076 }
1077 else { /* Someone has a claim on this, so abandon it. */
1078 assert( SvFLAGS(sv) & SVs_PADMY);
1079 assert(!(SvFLAGS(sv) & SVs_PADTMP));
1080 switch (SvTYPE(sv)) { /* Console ourselves with a new value */
1081 case SVt_PVAV: *svp = MUTABLE_SV(newAV()); break;
1082 case SVt_PVHV: *svp = MUTABLE_SV(newHV()); break;
1083 case SVt_PVCV:
1084 {
1085 /* Create a stub */
1086 *svp = newSV_type(SVt_PVCV);
1087
1088 /* Share name */
1089 assert(CvNAMED(sv));
1090 CvNAME_HEK_set(*svp,
1091 share_hek_hek(CvNAME_HEK((CV *)sv)));
1092 break;
1093 }
1094 default: *svp = newSV(0); break;
1095 }
4a9a56a7 1096 SvREFCNT_dec_NN(sv); /* Cast current value to the winds. */
528ad060
DM
1097 /* preserve pad nature, but also mark as not live
1098 * for any closure capturing */
1099 SvFLAGS(*svp) |= (SVs_PADMY|SVs_PADSTALE);
1100 }
4e09461c 1101 }
8990e307 1102 break;
4e09461c 1103 }
8990e307 1104 case SAVEt_DELETE:
03dba561
DM
1105 (void)hv_delete(ARG0_HV, ARG2_PV, ARG1_I32, G_DISCARD);
1106 SvREFCNT_dec(ARG0_HV);
1107 Safefree(arg2.any_ptr);
8990e307 1108 break;
c68ec7a9 1109 case SAVEt_ADELETE:
03dba561
DM
1110 (void)av_delete(ARG0_AV, ARG1_I32, G_DISCARD);
1111 SvREFCNT_dec(ARG0_AV);
c68ec7a9 1112 break;
146174a9 1113 case SAVEt_DESTRUCTOR_X:
03dba561 1114 (*arg1.any_dxptr)(aTHX_ ARG0_PTR);
a0d0e21e
LW
1115 break;
1116 case SAVEt_REGCONTEXT:
e0fa7e2b 1117 /* regexp must have croaked */
455ece5e 1118 case SAVEt_ALLOC:
1be36ce0 1119 PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT;
a0d0e21e 1120 break;
55497cff 1121 case SAVEt_STACK_POS: /* Position on Perl stack */
03dba561 1122 PL_stack_sp = PL_stack_base + arg0.any_i32;
55497cff 1123 break;
161b7d16 1124 case SAVEt_AELEM: /* array element */
03dba561
DM
1125 svp = av_fetch(ARG2_AV, ARG1_I32, 1);
1126 if (!AvREAL(ARG2_AV) && AvREIFY(ARG2_AV)) /* undo reify guard */
1127 SvREFCNT_dec(ARG0_SV);
1128 if (svp) {
1129 SV * const sv = *svp;
3280af22 1130 if (sv && sv != &PL_sv_undef) {
03dba561 1131 if (SvTIED_mg((const SV *)ARG2_AV, PERL_MAGIC_tied))
b37c2d43 1132 SvREFCNT_inc_void_NN(sv);
03dba561 1133 refsv = ARG2_SV;
4e4c362e
GS
1134 goto restore_sv;
1135 }
1136 }
03dba561
DM
1137 SvREFCNT_dec(ARG2_AV);
1138 SvREFCNT_dec(ARG0_SV);
4e4c362e 1139 break;
161b7d16 1140 case SAVEt_HELEM: /* hash element */
03dba561
DM
1141 {
1142 HE * const he = hv_fetch_ent(ARG2_HV, ARG1_SV, 1, 0);
1143 SvREFCNT_dec(ARG1_SV);
1144 if (he) {
1145 const SV * const oval = HeVAL(he);
3280af22 1146 if (oval && oval != &PL_sv_undef) {
03dba561
DM
1147 svp = &HeVAL(he);
1148 if (SvTIED_mg((const SV *)ARG2_HV, PERL_MAGIC_tied))
1149 SvREFCNT_inc_void(*svp);
1150 refsv = ARG2_SV; /* what to refcnt_dec */
4e4c362e
GS
1151 goto restore_sv;
1152 }
1153 }
03dba561
DM
1154 SvREFCNT_dec(ARG2_HV);
1155 SvREFCNT_dec(ARG0_SV);
4e4c362e 1156 break;
03dba561 1157 }
462e5cf6 1158 case SAVEt_OP:
03dba561 1159 PL_op = (OP*)ARG0_PTR;
462e5cf6 1160 break;
25eaa213 1161 case SAVEt_HINTS:
3607ca02
FC
1162 if ((PL_hints & HINT_LOCALIZE_HH)) {
1163 while (GvHV(PL_hintgv)) {
2653c1e3 1164 HV *hv = GvHV(PL_hintgv);
045ac317 1165 GvHV(PL_hintgv) = NULL;
2653c1e3 1166 SvREFCNT_dec(MUTABLE_SV(hv));
3607ca02 1167 }
045ac317 1168 }
20439bc7 1169 cophh_free(CopHINTHASH_get(&PL_compiling));
03dba561
DM
1170 CopHINTHASH_set(&PL_compiling, (COPHH*)ARG0_PTR);
1171 *(I32*)&PL_hints = ARG1_I32;
dfa41748 1172 if (PL_hints & HINT_LOCALIZE_HH) {
ad64d0ec 1173 SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
85fbaab2 1174 GvHV(PL_hintgv) = MUTABLE_HV(SSPOPPTR);
2653c1e3
DM
1175 }
1176 if (!GvHV(PL_hintgv)) {
a3fb8386
FC
1177 /* Need to add a new one manually, else rv2hv can
1178 add one via GvHVn and it won't have the magic set. */
5b9c0671
NC
1179 HV *const hv = newHV();
1180 hv_magic(hv, NULL, PERL_MAGIC_hints);
1181 GvHV(PL_hintgv) = hv;
dfa41748 1182 }
5b9c0671 1183 assert(GvHV(PL_hintgv));
b3ac6de7 1184 break;
cb50131a 1185 case SAVEt_COMPPAD:
03dba561 1186 PL_comppad = (PAD*)ARG0_PTR;
58ed4fbe 1187 if (PL_comppad)
cb50131a
CB
1188 PL_curpad = AvARRAY(PL_comppad);
1189 else
4608196e 1190 PL_curpad = NULL;
cb50131a 1191 break;
09edbca0 1192 case SAVEt_PADSV_AND_MORTALIZE:
c3564e5c 1193 {
09edbca0 1194 SV **svp;
03dba561
DM
1195 assert (ARG1_PTR);
1196 svp = AvARRAY((PAD*)ARG1_PTR) + (PADOFFSET)arg0.any_uv;
09edbca0
NC
1197 /* This mortalizing used to be done by POPLOOP() via itersave.
1198 But as we have all the information here, we can do it here,
1199 save even having to have itersave in the struct. */
1200 sv_2mortal(*svp);
03dba561 1201 *svp = ARG2_SV;
c3564e5c
GS
1202 }
1203 break;
8b7059b1
DM
1204 case SAVEt_SAVESWITCHSTACK:
1205 {
1206 dSP;
03dba561
DM
1207 SWITCHSTACK(ARG0_AV, ARG1_AV);
1208 PL_curstackinfo->si_stack = ARG1_AV;
8b7059b1
DM
1209 }
1210 break;
14f338dc 1211 case SAVEt_SET_SVFLAGS:
03dba561
DM
1212 SvFLAGS(ARG2_SV) &= ~((U32)ARG1_I32);
1213 SvFLAGS(ARG2_SV) |= (U32)ARG0_I32;
14f338dc 1214 break;
95e06916 1215
95e06916
NC
1216 /* These are only saved in mathoms.c */
1217 case SAVEt_NSTAB:
03dba561 1218 (void)sv_clear(ARG0_SV);
95e06916 1219 break;
2053acbf 1220 case SAVEt_LONG: /* long reference */
03dba561 1221 *(long*)ARG0_PTR = arg1.any_long;
2053acbf 1222 break;
95e06916 1223 case SAVEt_IV: /* IV reference */
03dba561 1224 *(IV*)ARG0_PTR = arg1.any_iv;
95e06916
NC
1225 break;
1226
2053acbf 1227 case SAVEt_I16: /* I16 reference */
03dba561 1228 *(I16*)ARG0_PTR = (I16)(uv >> 8);
2053acbf
NC
1229 break;
1230 case SAVEt_I8: /* I8 reference */
03dba561 1231 *(I8*)ARG0_PTR = (I8)(uv >> 8);
2053acbf 1232 break;
2053acbf 1233 case SAVEt_DESTRUCTOR:
03dba561 1234 (*arg1.any_dptr)(ARG0_PTR);
2053acbf 1235 break;
68da3b2f 1236 case SAVEt_COMPILE_WARNINGS:
68da3b2f
NC
1237 if (!specialWARN(PL_compiling.cop_warnings))
1238 PerlMemShared_free(PL_compiling.cop_warnings);
72dc9ed5 1239
03dba561 1240 PL_compiling.cop_warnings = (STRLEN*)ARG0_PTR;
72dc9ed5 1241 break;
7c197c94 1242 case SAVEt_PARSER:
03dba561 1243 parser_free((yy_parser *) ARG0_PTR);
7c197c94 1244 break;
20d5dc23
FC
1245 case SAVEt_READONLY_OFF:
1246 SvREADONLY_off(ARG0_SV);
1247 break;
79072805 1248 default:
5637ef5b 1249 Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
79072805
LW
1250 }
1251 }
302c0c93 1252
284167a5 1253 TAINT_set(was);
79072805 1254}
8990e307 1255
8990e307 1256void
864dbfa3 1257Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
8990e307 1258{
97aff369 1259 dVAR;
7918f24d
NC
1260
1261 PERL_ARGS_ASSERT_CX_DUMP;
1262
35ff7856 1263#ifdef DEBUGGING
22c35a8c 1264 PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
6b35e009 1265 if (CxTYPE(cx) != CXt_SUBST) {
e8d9e9d0 1266 const char *gimme_text;
760ac839 1267 PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
146174a9
CB
1268 PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
1269 PTR2UV(cx->blk_oldcop));
760ac839
LW
1270 PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
1271 PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
146174a9
CB
1272 PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
1273 PTR2UV(cx->blk_oldpm));
e8d9e9d0
VP
1274 switch (cx->blk_gimme) {
1275 case G_VOID:
1276 gimme_text = "VOID";
1277 break;
1278 case G_SCALAR:
1279 gimme_text = "SCALAR";
1280 break;
1281 case G_ARRAY:
1282 gimme_text = "LIST";
1283 break;
1284 default:
1285 gimme_text = "UNKNOWN";
1286 break;
1287 }
1288 PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", gimme_text);
8990e307 1289 }
6b35e009 1290 switch (CxTYPE(cx)) {
8990e307
LW
1291 case CXt_NULL:
1292 case CXt_BLOCK:
1293 break;
146174a9 1294 case CXt_FORMAT:
f9c764c5
NC
1295 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%"UVxf"\n",
1296 PTR2UV(cx->blk_format.cv));
1297 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%"UVxf"\n",
1298 PTR2UV(cx->blk_format.gv));
1299 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%"UVxf"\n",
1300 PTR2UV(cx->blk_format.dfoutgv));
1301 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n",
bafb2adc 1302 (int)CxHASARGS(cx));
f9c764c5
NC
1303 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%"UVxf"\n",
1304 PTR2UV(cx->blk_format.retop));
146174a9 1305 break;
8990e307 1306 case CXt_SUB:
146174a9
CB
1307 PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
1308 PTR2UV(cx->blk_sub.cv));
760ac839 1309 PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
8990e307 1310 (long)cx->blk_sub.olddepth);
760ac839 1311 PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
bafb2adc
NC
1312 (int)CxHASARGS(cx));
1313 PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx));
f39bc417
DM
1314 PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
1315 PTR2UV(cx->blk_sub.retop));
8990e307
LW
1316 break;
1317 case CXt_EVAL:
760ac839 1318 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
85a64632 1319 (long)CxOLD_IN_EVAL(cx));
760ac839 1320 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
85a64632
NC
1321 PL_op_name[CxOLD_OP_TYPE(cx)],
1322 PL_op_desc[CxOLD_OP_TYPE(cx)]);
0f79a09d
GS
1323 if (cx->blk_eval.old_namesv)
1324 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
aa07b2f6 1325 SvPVX_const(cx->blk_eval.old_namesv));
146174a9
CB
1326 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
1327 PTR2UV(cx->blk_eval.old_eval_root));
f39bc417
DM
1328 PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n",
1329 PTR2UV(cx->blk_eval.retop));
8990e307
LW
1330 break;
1331
c6fdafd0 1332 case CXt_LOOP_LAZYIV:
d01136d6 1333 case CXt_LOOP_LAZYSV:
3b719c58
NC
1334 case CXt_LOOP_FOR:
1335 case CXt_LOOP_PLAIN:
0cbdab38 1336 PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx));
760ac839 1337 PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
8990e307 1338 (long)cx->blk_loop.resetsp);
022eaa24
NC
1339 PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
1340 PTR2UV(cx->blk_loop.my_op));
d01136d6 1341 /* XXX: not accurate for LAZYSV/IV */
146174a9 1342 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
d01136d6
BS
1343 PTR2UV(cx->blk_loop.state_u.ary.ary));
1344 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
1345 (long)cx->blk_loop.state_u.ary.ix);
146174a9
CB
1346 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
1347 PTR2UV(CxITERVAR(cx)));
8990e307
LW
1348 break;
1349
1350 case CXt_SUBST:
760ac839 1351 PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
8990e307 1352 (long)cx->sb_iters);
760ac839 1353 PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
8990e307 1354 (long)cx->sb_maxiters);
35ef4773
GS
1355 PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
1356 (long)cx->sb_rflags);
760ac839 1357 PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
c5bed6a7 1358 (long)CxONCE(cx));
760ac839 1359 PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
8990e307 1360 cx->sb_orig);
146174a9
CB
1361 PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
1362 PTR2UV(cx->sb_dstr));
1363 PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
1364 PTR2UV(cx->sb_targ));
1365 PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
1366 PTR2UV(cx->sb_s));
1367 PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
1368 PTR2UV(cx->sb_m));
1369 PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
1370 PTR2UV(cx->sb_strend));
1371 PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
1372 PTR2UV(cx->sb_rxres));
8990e307
LW
1373 break;
1374 }
65e66c80 1375#else
96a5add6 1376 PERL_UNUSED_CONTEXT;
65e66c80 1377 PERL_UNUSED_ARG(cx);
17c3b450 1378#endif /* DEBUGGING */
35ff7856 1379}
241d1a3b
NC
1380
1381/*
1382 * Local variables:
1383 * c-indentation-style: bsd
1384 * c-basic-offset: 4
14d04a33 1385 * indent-tabs-mode: nil
241d1a3b
NC
1386 * End:
1387 *
14d04a33 1388 * ex: set ts=8 sts=4 sw=4 et:
37442d52 1389 */