This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Generate the deprecation warnings for all uses $* or $#.
[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**
864dbfa3 30Perl_stack_grow(pTHX_ SV **sp, SV **p, int 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
864dbfa3 144Perl_tmps_grow(pTHX_ I32 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? */
35a4481c 161 const I32 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 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 308 }
309 else {
44a8e56a 310 gp_ref(GvGP(gv));
5f05dabc 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 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
85e6fe83
LW
460/* Cannot use save_sptr() to store a char* since the SV** cast will
461 * force word-alignment and we'll miss the pointer.
462 */
463void
864dbfa3 464Perl_save_pptr(pTHX_ char **pptr)
85e6fe83 465{
97aff369 466 dVAR;
7918f24d
NC
467
468 PERL_ARGS_ASSERT_SAVE_PPTR;
469
e22024d3 470 save_pushptrptr(*pptr, pptr, SAVEt_PPTR);
85e6fe83
LW
471}
472
79072805 473void
146174a9
CB
474Perl_save_vptr(pTHX_ void *ptr)
475{
97aff369 476 dVAR;
7918f24d
NC
477
478 PERL_ARGS_ASSERT_SAVE_VPTR;
479
e22024d3 480 save_pushptrptr(*(char**)ptr, ptr, SAVEt_VPTR);
146174a9
CB
481}
482
483void
864dbfa3 484Perl_save_sptr(pTHX_ SV **sptr)
79072805 485{
97aff369 486 dVAR;
7918f24d
NC
487
488 PERL_ARGS_ASSERT_SAVE_SPTR;
489
e22024d3 490 save_pushptrptr(*sptr, sptr, SAVEt_SPTR);
79072805
LW
491}
492
c3564e5c 493void
09edbca0 494Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
c3564e5c 495{
97aff369 496 dVAR;
a3444cc5
DM
497 dSS_ADD;
498
f3548bdc 499 ASSERT_CURPAD_ACTIVE("save_padsv");
a3444cc5
DM
500 SS_ADD_PTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
501 SS_ADD_PTR(PL_comppad);
03dba561 502 SS_ADD_UV((UV)off);
a3444cc5
DM
503 SS_ADD_UV(SAVEt_PADSV_AND_MORTALIZE);
504 SS_ADD_END(4);
c3564e5c
GS
505}
506
79072805 507void
864dbfa3 508Perl_save_hptr(pTHX_ HV **hptr)
79072805 509{
97aff369 510 dVAR;
7918f24d
NC
511
512 PERL_ARGS_ASSERT_SAVE_HPTR;
513
e22024d3 514 save_pushptrptr(*hptr, hptr, SAVEt_HPTR);
79072805
LW
515}
516
517void
864dbfa3 518Perl_save_aptr(pTHX_ AV **aptr)
79072805 519{
97aff369 520 dVAR;
7918f24d
NC
521
522 PERL_ARGS_ASSERT_SAVE_APTR;
523
e22024d3 524 save_pushptrptr(*aptr, aptr, SAVEt_APTR);
79072805
LW
525}
526
527void
2fd8beea 528Perl_save_pushptr(pTHX_ void *const ptr, const int type)
8990e307 529{
97aff369 530 dVAR;
a3444cc5
DM
531 dSS_ADD;
532 SS_ADD_PTR(ptr);
533 SS_ADD_UV(type);
534 SS_ADD_END(2);
8990e307
LW
535}
536
537void
864dbfa3 538Perl_save_clearsv(pTHX_ SV **svp)
8990e307 539{
97aff369 540 dVAR;
cdcdfc56
NC
541 const UV offset = svp - PL_curpad;
542 const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
7918f24d
NC
543
544 PERL_ARGS_ASSERT_SAVE_CLEARSV;
545
f3548bdc 546 ASSERT_CURPAD_ACTIVE("save_clearsv");
623e28c6 547 SvPADSTALE_off(*svp); /* mark lexical as active */
a3444cc5 548 if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset) {
cdcdfc56
NC
549 Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
550 offset, svp, PL_curpad);
a3444cc5 551 }
cdcdfc56 552
a3444cc5
DM
553 {
554 dSS_ADD;
555 SS_ADD_UV(offset_shifted | SAVEt_CLEARSV);
556 SS_ADD_END(1);
557 }
8990e307
LW
558}
559
560void
864dbfa3 561Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
8990e307 562{
97aff369 563 dVAR;
7918f24d
NC
564
565 PERL_ARGS_ASSERT_SAVE_DELETE;
566
85a721ca 567 save_pushptri32ptr(key, klen, SvREFCNT_inc_simple(hv), SAVEt_DELETE);
8990e307
LW
568}
569
570void
af097752
VP
571Perl_save_hdelete(pTHX_ HV *hv, SV *keysv)
572{
573 STRLEN len;
574 I32 klen;
575 const char *key;
576
577 PERL_ARGS_ASSERT_SAVE_HDELETE;
578
579 key = SvPV_const(keysv, len);
580 klen = SvUTF8(keysv) ? -(I32)len : (I32)len;
581 SvREFCNT_inc_simple_void_NN(hv);
582 save_pushptri32ptr(savepvn(key, len), klen, hv, SAVEt_DELETE);
583}
584
585void
c68ec7a9
VP
586Perl_save_adelete(pTHX_ AV *av, I32 key)
587{
588 dVAR;
589
590 PERL_ARGS_ASSERT_SAVE_ADELETE;
591
592 SvREFCNT_inc_void(av);
593 save_pushi32ptr(key, av, SAVEt_ADELETE);
594}
595
596void
12ab1f58
JH
597Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
598{
599 dVAR;
a3444cc5 600 dSS_ADD;
7918f24d
NC
601
602 PERL_ARGS_ASSERT_SAVE_DESTRUCTOR;
603
a3444cc5
DM
604 SS_ADD_DPTR(f);
605 SS_ADD_PTR(p);
606 SS_ADD_UV(SAVEt_DESTRUCTOR);
607 SS_ADD_END(3);
12ab1f58
JH
608}
609
610void
146174a9
CB
611Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
612{
97aff369 613 dVAR;
a3444cc5
DM
614 dSS_ADD;
615
616 SS_ADD_DXPTR(f);
617 SS_ADD_PTR(p);
618 SS_ADD_UV(SAVEt_DESTRUCTOR_X);
619 SS_ADD_END(3);
146174a9
CB
620}
621
622void
da8315f8
NC
623Perl_save_hints(pTHX)
624{
625 dVAR;
20439bc7 626 COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
da8315f8 627 if (PL_hints & HINT_LOCALIZE_HH) {
52c7aca6
FC
628 HV *oldhh = GvHV(PL_hintgv);
629 save_pushptri32ptr(oldhh, PL_hints, save_cophh, SAVEt_HINTS);
630 GvHV(PL_hintgv) = NULL; /* in case copying dies */
631 GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh);
be84297e 632 } else {
20439bc7 633 save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS);
da8315f8 634 }
be84297e
NC
635}
636
637static void
638S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2,
639 const int type)
640{
a3444cc5
DM
641 dSS_ADD;
642 SS_ADD_PTR(ptr1);
643 SS_ADD_INT(i);
644 SS_ADD_PTR(ptr2);
645 SS_ADD_UV(type);
646 SS_ADD_END(4);
da8315f8
NC
647}
648
649void
91d1c79f 650Perl_save_aelem_flags(pTHX_ AV *av, I32 idx, SV **sptr, const U32 flags)
4e4c362e 651{
97aff369 652 dVAR;
bfc4de9f 653 SV *sv;
7918f24d 654
91d1c79f 655 PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS;
7918f24d 656
0cbee0a4 657 SvGETMAGIC(*sptr);
be84297e
NC
658 save_pushptri32ptr(SvREFCNT_inc_simple(av), idx, SvREFCNT_inc(*sptr),
659 SAVEt_AELEM);
1cdc9186
FC
660 /* The array needs to hold a reference count on its new element, so it
661 must be AvREAL. */
5dd42e15 662 if (!AvREAL(av) && AvREIFY(av))
1cdc9186 663 av_reify(av);
91d1c79f 664 save_scalar_at(sptr, flags); /* XXX - FIXME - see #60360 */
75d34a09
VP
665 if (flags & SAVEf_KEEPOLDELEM)
666 return;
bfc4de9f
DM
667 sv = *sptr;
668 /* If we're localizing a tied array element, this new sv
669 * won't actually be stored in the array - so it won't get
670 * reaped when the localize ends. Ensure it gets reaped by
671 * mortifying it instead. DAPM */
daeb922a 672 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
bfc4de9f 673 sv_2mortal(sv);
4e4c362e
GS
674}
675
676void
af7df257 677Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
4e4c362e 678{
97aff369 679 dVAR;
bfc4de9f 680 SV *sv;
7918f24d 681
af7df257 682 PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS;
7918f24d 683
0cbee0a4 684 SvGETMAGIC(*sptr);
a3444cc5
DM
685 {
686 dSS_ADD;
687 SS_ADD_PTR(SvREFCNT_inc_simple(hv));
688 SS_ADD_PTR(newSVsv(key));
689 SS_ADD_PTR(SvREFCNT_inc(*sptr));
690 SS_ADD_UV(SAVEt_HELEM);
691 SS_ADD_END(4);
692 }
af7df257 693 save_scalar_at(sptr, flags);
75d34a09
VP
694 if (flags & SAVEf_KEEPOLDELEM)
695 return;
bfc4de9f
DM
696 sv = *sptr;
697 /* If we're localizing a tied hash element, this new sv
698 * won't actually be stored in the hash - so it won't get
699 * reaped when the localize ends. Ensure it gets reaped by
700 * mortifying it instead. DAPM */
daeb922a 701 if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))
bfc4de9f 702 sv_2mortal(sv);
4e4c362e
GS
703}
704
2053acbf
NC
705SV*
706Perl_save_svref(pTHX_ SV **sptr)
707{
708 dVAR;
7918f24d
NC
709
710 PERL_ARGS_ASSERT_SAVE_SVREF;
711
2053acbf 712 SvGETMAGIC(*sptr);
e22024d3 713 save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_SVREF);
af7df257 714 return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
2053acbf
NC
715}
716
455ece5e 717I32
864dbfa3 718Perl_save_alloc(pTHX_ I32 size, I32 pad)
455ece5e 719{
97aff369 720 dVAR;
eb578fdb
KW
721 const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
722 - (char*)PL_savestack);
1be36ce0
NC
723 const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
724 const UV elems_shifted = elems << SAVE_TIGHT_SHIFT;
455ece5e 725
1be36ce0 726 if ((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)
93a641ae
DM
727 Perl_croak(aTHX_
728 "panic: save_alloc elems %"UVuf" out of range (%"IVdf"-%"IVdf")",
729 elems, (IV)size, (IV)pad);
1be36ce0
NC
730
731 SSGROW(elems + 1);
455ece5e
AD
732
733 PL_savestack_ix += elems;
1be36ce0 734 SSPUSHUV(SAVEt_ALLOC | elems_shifted);
455ece5e
AD
735 return start;
736}
737
03dba561
DM
738
739
740#define ARG0_SV MUTABLE_SV(arg0.any_ptr)
741#define ARG0_AV MUTABLE_AV(arg0.any_ptr)
742#define ARG0_HV MUTABLE_HV(arg0.any_ptr)
743#define ARG0_PTR arg0.any_ptr
744#define ARG0_PV (char*)(arg0.any_ptr)
745#define ARG0_PVP (char**)(arg0.any_ptr)
746#define ARG0_I32 (arg0.any_i32)
747
748#define ARG1_SV MUTABLE_SV(arg1.any_ptr)
749#define ARG1_AV MUTABLE_AV(arg1.any_ptr)
750#define ARG1_GV MUTABLE_GV(arg1.any_ptr)
751#define ARG1_SVP (SV**)(arg1.any_ptr)
752#define ARG1_PVP (char**)(arg1.any_ptr)
753#define ARG1_PTR arg1.any_ptr
754#define ARG1_PV (char*)(arg1.any_ptr)
755#define ARG1_I32 (arg1.any_i32)
756
757#define ARG2_SV MUTABLE_SV(arg2.any_ptr)
758#define ARG2_AV MUTABLE_AV(arg2.any_ptr)
759#define ARG2_HV MUTABLE_HV(arg2.any_ptr)
760#define ARG2_GV MUTABLE_GV(arg2.any_ptr)
761#define ARG2_PV (char*)(arg2.any_ptr)
762
462e5cf6 763void
864dbfa3 764Perl_leave_scope(pTHX_ I32 base)
79072805 765{
97aff369 766 dVAR;
03dba561 767
302c0c93 768 /* Localise the effects of the TAINT_NOT inside the loop. */
284167a5 769 bool was = TAINT_get;
79072805 770
03dba561
DM
771 ANY arg0, arg1, arg2;
772
773 /* these initialisations are logically unnecessary, but they shut up
774 * spurious 'may be used uninitialized' compiler warnings */
775 arg0.any_ptr = NULL;
776 arg1.any_ptr = NULL;
777 arg2.any_ptr = NULL;
778
79072805 779 if (base < -1)
5637ef5b 780 Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base);
1c98cc53
DM
781 DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n",
782 (long)PL_savestack_ix, (long)base));
3280af22 783 while (PL_savestack_ix > base) {
03dba561
DM
784 UV uv;
785 U8 type;
786
787 SV *refsv;
788 SV **svp;
789
c6ae7647
NC
790 TAINT_NOT;
791
03dba561
DM
792 {
793 I32 ix = PL_savestack_ix - 1;
794 ANY *p = &PL_savestack[ix];
795 uv = p->any_uv;
796 type = (U8)uv & SAVE_MASK;
797 if (type > SAVEt_ARG0_MAX) {
798 ANY *p0 = p;
799 arg0 = *--p;
800 if (type > SAVEt_ARG1_MAX) {
801 arg1 = *--p;
802 if (type > SAVEt_ARG2_MAX) {
803 arg2 = *--p;
804 }
805 }
806 ix -= (p0 - p);
807 }
808 PL_savestack_ix = ix;
809 }
810
c6bf6a65 811 switch (type) {
79072805 812 case SAVEt_ITEM: /* normal string */
03dba561 813 sv_replace(ARG1_SV, ARG0_SV);
b492a59e
DM
814 if (SvSMAGICAL(ARG1_SV)) {
815 PL_localizing = 2;
816 mg_set(ARG1_SV);
817 PL_localizing = 0;
818 }
79072805 819 break;
03dba561
DM
820
821 /* This would be a mathom, but Perl_save_svref() calls a static
822 function, S_save_scalar_at(), so has to stay in this file. */
823 case SAVEt_SVREF: /* scalar reference */
824 svp = ARG1_SVP;
825 refsv = NULL; /* what to refcnt_dec */
826 goto restore_sv;
827
8aacddc1 828 case SAVEt_SV: /* scalar reference */
03dba561
DM
829 svp = &GvSV(ARG1_GV);
830 refsv = ARG1_SV; /* what to refcnt_dec */
2053acbf 831 restore_sv:
03dba561
DM
832 {
833 SV * const sv = *svp;
834 *svp = ARG0_SV;
2053acbf 835 SvREFCNT_dec(sv);
b492a59e
DM
836 if (SvSMAGICAL(ARG0_SV)) {
837 PL_localizing = 2;
838 mg_set(ARG0_SV);
839 PL_localizing = 0;
840 }
4a9a56a7 841 SvREFCNT_dec_NN(ARG0_SV);
03dba561 842 SvREFCNT_dec(refsv);
2053acbf 843 break;
03dba561 844 }
8aacddc1 845 case SAVEt_GENERIC_PVREF: /* generic pv */
03dba561
DM
846 if (*ARG0_PVP != ARG1_PV) {
847 Safefree(*ARG0_PVP);
848 *ARG0_PVP = ARG1_PV;
f4dd75d9
GS
849 }
850 break;
05ec9bb3 851 case SAVEt_SHARED_PVREF: /* shared pv */
03dba561 852 if (*ARG1_PVP != ARG0_PV) {
5e54c26f 853#ifdef NETWARE
03dba561 854 PerlMem_free(*ARG1_PVP);
5e54c26f 855#else
03dba561 856 PerlMemShared_free(*ARG1_PVP);
5e54c26f 857#endif
03dba561 858 *ARG1_PVP = ARG0_PV;
05ec9bb3
NIS
859 }
860 break;
f83b46a0 861 case SAVEt_GVSV: /* scalar slot in GV */
03dba561 862 svp = &GvSV(ARG1_GV);
f83b46a0 863 goto restore_svp;
8aacddc1 864 case SAVEt_GENERIC_SVREF: /* generic sv */
03dba561 865 svp = ARG1_SVP;
f83b46a0 866 restore_svp:
03dba561
DM
867 {
868 SV * const sv = *svp;
869 *svp = ARG0_SV;
f4dd75d9 870 SvREFCNT_dec(sv);
03dba561 871 SvREFCNT_dec(ARG0_SV);
b9d12d37 872 break;
03dba561 873 }
db9306af 874 case SAVEt_GVSLOT: /* any slot in GV */
03dba561
DM
875 {
876 HV *const hv = GvSTASH(ARG2_GV);
877 svp = ARG1_SVP;
db9306af 878 if (hv && HvENAME(hv) && (
03dba561
DM
879 (ARG0_SV && SvTYPE(ARG0_SV) == SVt_PVCV)
880 || (*svp && SvTYPE(*svp) == SVt_PVCV)
db9306af
FC
881 ))
882 {
03dba561
DM
883 if ((char *)svp < (char *)GvGP(ARG2_GV)
884 || (char *)svp > (char *)GvGP(ARG2_GV) + sizeof(struct gp)
885 || GvREFCNT(ARG2_GV) > 1)
db9306af
FC
886 PL_sub_generation++;
887 else mro_method_changed_in(hv);
888 }
889 goto restore_svp;
03dba561 890 }
8aacddc1 891 case SAVEt_AV: /* array reference */
03dba561
DM
892 SvREFCNT_dec(GvAV(ARG1_GV));
893 GvAV(ARG1_GV) = ARG0_AV;
b492a59e
DM
894 if (SvSMAGICAL(ARG0_SV)) {
895 PL_localizing = 2;
896 mg_set(ARG0_SV);
897 PL_localizing = 0;
898 }
4a9a56a7 899 SvREFCNT_dec_NN(ARG1_GV);
8aacddc1
NIS
900 break;
901 case SAVEt_HV: /* hash reference */
03dba561
DM
902 SvREFCNT_dec(GvHV(ARG1_GV));
903 GvHV(ARG1_GV) = ARG0_HV;
b492a59e
DM
904 if (SvSMAGICAL(ARG0_SV)) {
905 PL_localizing = 2;
906 mg_set(ARG0_SV);
907 PL_localizing = 0;
908 }
4a9a56a7 909 SvREFCNT_dec_NN(ARG1_GV);
8aacddc1 910 break;
994d373a 911 case SAVEt_INT_SMALL:
03dba561 912 *(int*)ARG0_PTR = (int)(uv >> SAVE_TIGHT_SHIFT);
994d373a 913 break;
79072805 914 case SAVEt_INT: /* int reference */
03dba561 915 *(int*)ARG0_PTR = (int)ARG1_I32;
79072805 916 break;
9febdf04 917 case SAVEt_BOOL: /* bool reference */
03dba561 918 *(bool*)ARG0_PTR = cBOOL(uv >> 8);
284167a5 919#if !NO_TAINT_SUPPORT
03dba561 920 if (ARG0_PTR == &(TAINT_get)) {
b6f93e7a
KW
921 /* If we don't update <was>, to reflect what was saved on the
922 * stack for PL_tainted, then we will overwrite this attempt to
923 * restore it when we exit this routine. Note that this won't
924 * work if this value was saved in a wider-than necessary type,
925 * such as I32 */
03dba561 926 was = *(bool*)ARG0_PTR;
b6f93e7a 927 }
284167a5 928#endif
9febdf04 929 break;
89abef21 930 case SAVEt_I32_SMALL:
03dba561 931 *(I32*)ARG0_PTR = (I32)(uv >> SAVE_TIGHT_SHIFT);
89abef21 932 break;
79072805 933 case SAVEt_I32: /* I32 reference */
3235b7a3 934#ifdef PERL_DEBUG_READONLY_OPS
03dba561 935 if (*(I32*)ARG0_PTR != ARG1_I32)
3235b7a3 936#endif
03dba561 937 *(I32*)ARG0_PTR = ARG1_I32;
79072805
LW
938 break;
939 case SAVEt_SPTR: /* SV* reference */
03dba561 940 *(SV**)(ARG0_PTR)= ARG1_SV;
79072805 941 break;
146174a9 942 case SAVEt_VPTR: /* random* reference */
85e6fe83 943 case SAVEt_PPTR: /* char* reference */
03dba561 944 *ARG0_PVP = ARG1_PV;
85e6fe83 945 break;
79072805 946 case SAVEt_HPTR: /* HV* reference */
03dba561 947 *(HV**)ARG0_PTR = MUTABLE_HV(ARG1_PTR);
79072805
LW
948 break;
949 case SAVEt_APTR: /* AV* reference */
03dba561 950 *(AV**)ARG0_PTR = ARG1_AV;
79072805 951 break;
fb73857a 952 case SAVEt_GP: /* scalar reference */
03dba561
DM
953 {
954 HV *hv;
955 /* possibly taking a method out of circulation */
956 const bool had_method = !!GvCVu(ARG1_GV);
957 gp_free(ARG1_GV);
958 GvGP_set(ARG1_GV, (GP*)ARG0_PTR);
959 if ((hv=GvSTASH(ARG1_GV)) && HvENAME_get(hv)) {
960 if ( GvNAMELEN(ARG1_GV) == 3
961 && strnEQ(GvNAME(ARG1_GV), "ISA", 3)
962 )
963 mro_isa_changed_in(hv);
964 else if (had_method || GvCVu(ARG1_GV))
965 /* putting a method back into circulation ("local")*/
966 gv_method_changed(ARG1_GV);
3d460042 967 }
4a9a56a7 968 SvREFCNT_dec_NN(ARG1_GV);
8aacddc1 969 break;
03dba561 970 }
8990e307 971 case SAVEt_FREESV:
03dba561 972 SvREFCNT_dec(ARG0_SV);
8990e307 973 break;
3987a177 974 case SAVEt_FREECOPHH:
03dba561 975 cophh_free((COPHH *)ARG0_PTR);
3987a177 976 break;
26d9b02f 977 case SAVEt_MORTALIZESV:
03dba561 978 sv_2mortal(ARG0_SV);
26d9b02f 979 break;
8990e307 980 case SAVEt_FREEOP:
5e5ba94b 981 ASSERT_CURPAD_LEGAL("SAVEt_FREEOP");
03dba561 982 op_free((OP*)ARG0_PTR);
8990e307
LW
983 break;
984 case SAVEt_FREEPV:
03dba561 985 Safefree(ARG0_PTR);
8990e307 986 break;
4e09461c
DM
987
988 {
989 SV **svp;
03dba561
DM
990 I32 i;
991 SV *sv;
992
4e09461c
DM
993 case SAVEt_CLEARPADRANGE:
994 i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK);
995 svp = &PL_curpad[uv >>
996 (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)] + i - 1;
997 goto clearsv;
8990e307 998 case SAVEt_CLEARSV:
4e09461c
DM
999 svp = &PL_curpad[uv >> SAVE_TIGHT_SHIFT];
1000 i = 1;
1001 clearsv:
1002 for (; i; i--, svp--) {
528ad060
DM
1003 sv = *svp;
1004
1005 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1006 "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
1007 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1008 (long)(svp-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
1009 (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
1010 ));
1011
1012 /* Can clear pad variable in place? */
1013 if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
1014 /*
1015 * if a my variable that was made readonly is going out of
1016 * scope, we want to remove the readonlyness so that it can
1017 * go out of scope quietly
1018 */
1019 if (SvPADMY(sv) && !SvFAKE(sv))
1020 SvREADONLY_off(sv);
1021
1022 if (SvTHINKFIRST(sv))
1023 sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF
1024 |SV_COW_DROP_PV);
1025 if (SvTYPE(sv) == SVt_PVHV)
1026 Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
1027 if (SvMAGICAL(sv))
1028 {
1029 sv_unmagic(sv, PERL_MAGIC_backref);
1030 if (SvTYPE(sv) != SVt_PVCV)
1031 mg_free(sv);
1032 }
1033
1034 switch (SvTYPE(sv)) {
1035 case SVt_NULL:
1036 break;
1037 case SVt_PVAV:
1038 av_clear(MUTABLE_AV(sv));
1039 break;
1040 case SVt_PVHV:
1041 hv_clear(MUTABLE_HV(sv));
1042 break;
1043 case SVt_PVCV:
1044 {
1045 HEK * const hek = CvNAME_HEK((CV *)sv);
1046 assert(hek);
1047 share_hek_hek(hek);
1048 cv_undef((CV *)sv);
1049 CvNAME_HEK_set(sv, hek);
1050 break;
1051 }
1052 default:
1053 SvOK_off(sv);
1054 break;
1055 }
1056 SvPADSTALE_on(sv); /* mark as no longer live */
1057 }
1058 else { /* Someone has a claim on this, so abandon it. */
1059 assert( SvFLAGS(sv) & SVs_PADMY);
1060 assert(!(SvFLAGS(sv) & SVs_PADTMP));
1061 switch (SvTYPE(sv)) { /* Console ourselves with a new value */
1062 case SVt_PVAV: *svp = MUTABLE_SV(newAV()); break;
1063 case SVt_PVHV: *svp = MUTABLE_SV(newHV()); break;
1064 case SVt_PVCV:
1065 {
1066 /* Create a stub */
1067 *svp = newSV_type(SVt_PVCV);
1068
1069 /* Share name */
1070 assert(CvNAMED(sv));
1071 CvNAME_HEK_set(*svp,
1072 share_hek_hek(CvNAME_HEK((CV *)sv)));
1073 break;
1074 }
1075 default: *svp = newSV(0); break;
1076 }
4a9a56a7 1077 SvREFCNT_dec_NN(sv); /* Cast current value to the winds. */
528ad060
DM
1078 /* preserve pad nature, but also mark as not live
1079 * for any closure capturing */
1080 SvFLAGS(*svp) |= (SVs_PADMY|SVs_PADSTALE);
1081 }
4e09461c 1082 }
8990e307 1083 break;
4e09461c 1084 }
8990e307 1085 case SAVEt_DELETE:
03dba561
DM
1086 (void)hv_delete(ARG0_HV, ARG2_PV, ARG1_I32, G_DISCARD);
1087 SvREFCNT_dec(ARG0_HV);
1088 Safefree(arg2.any_ptr);
8990e307 1089 break;
c68ec7a9 1090 case SAVEt_ADELETE:
03dba561
DM
1091 (void)av_delete(ARG0_AV, ARG1_I32, G_DISCARD);
1092 SvREFCNT_dec(ARG0_AV);
c68ec7a9 1093 break;
146174a9 1094 case SAVEt_DESTRUCTOR_X:
03dba561 1095 (*arg1.any_dxptr)(aTHX_ ARG0_PTR);
a0d0e21e
LW
1096 break;
1097 case SAVEt_REGCONTEXT:
e0fa7e2b 1098 /* regexp must have croaked */
455ece5e 1099 case SAVEt_ALLOC:
1be36ce0 1100 PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT;
a0d0e21e 1101 break;
55497cff 1102 case SAVEt_STACK_POS: /* Position on Perl stack */
03dba561 1103 PL_stack_sp = PL_stack_base + arg0.any_i32;
55497cff 1104 break;
ea8d6ae1 1105 case SAVEt_STACK_CXPOS: /* blk_oldsp on context stack */
03dba561 1106 cxstack[ARG0_I32].blk_oldsp = ARG1_I32;
ea8d6ae1 1107 break;
161b7d16 1108 case SAVEt_AELEM: /* array element */
03dba561
DM
1109 svp = av_fetch(ARG2_AV, ARG1_I32, 1);
1110 if (!AvREAL(ARG2_AV) && AvREIFY(ARG2_AV)) /* undo reify guard */
1111 SvREFCNT_dec(ARG0_SV);
1112 if (svp) {
1113 SV * const sv = *svp;
3280af22 1114 if (sv && sv != &PL_sv_undef) {
03dba561 1115 if (SvTIED_mg((const SV *)ARG2_AV, PERL_MAGIC_tied))
b37c2d43 1116 SvREFCNT_inc_void_NN(sv);
03dba561 1117 refsv = ARG2_SV;
4e4c362e
GS
1118 goto restore_sv;
1119 }
1120 }
03dba561
DM
1121 SvREFCNT_dec(ARG2_AV);
1122 SvREFCNT_dec(ARG0_SV);
4e4c362e 1123 break;
161b7d16 1124 case SAVEt_HELEM: /* hash element */
03dba561
DM
1125 {
1126 HE * const he = hv_fetch_ent(ARG2_HV, ARG1_SV, 1, 0);
1127 SvREFCNT_dec(ARG1_SV);
1128 if (he) {
1129 const SV * const oval = HeVAL(he);
3280af22 1130 if (oval && oval != &PL_sv_undef) {
03dba561
DM
1131 svp = &HeVAL(he);
1132 if (SvTIED_mg((const SV *)ARG2_HV, PERL_MAGIC_tied))
1133 SvREFCNT_inc_void(*svp);
1134 refsv = ARG2_SV; /* what to refcnt_dec */
4e4c362e
GS
1135 goto restore_sv;
1136 }
1137 }
03dba561
DM
1138 SvREFCNT_dec(ARG2_HV);
1139 SvREFCNT_dec(ARG0_SV);
4e4c362e 1140 break;
03dba561 1141 }
462e5cf6 1142 case SAVEt_OP:
03dba561 1143 PL_op = (OP*)ARG0_PTR;
462e5cf6 1144 break;
25eaa213 1145 case SAVEt_HINTS:
3607ca02
FC
1146 if ((PL_hints & HINT_LOCALIZE_HH)) {
1147 while (GvHV(PL_hintgv)) {
2653c1e3 1148 HV *hv = GvHV(PL_hintgv);
045ac317 1149 GvHV(PL_hintgv) = NULL;
2653c1e3 1150 SvREFCNT_dec(MUTABLE_SV(hv));
3607ca02 1151 }
045ac317 1152 }
20439bc7 1153 cophh_free(CopHINTHASH_get(&PL_compiling));
03dba561
DM
1154 CopHINTHASH_set(&PL_compiling, (COPHH*)ARG0_PTR);
1155 *(I32*)&PL_hints = ARG1_I32;
dfa41748 1156 if (PL_hints & HINT_LOCALIZE_HH) {
ad64d0ec 1157 SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
85fbaab2 1158 GvHV(PL_hintgv) = MUTABLE_HV(SSPOPPTR);
2653c1e3
DM
1159 }
1160 if (!GvHV(PL_hintgv)) {
a3fb8386
FC
1161 /* Need to add a new one manually, else rv2hv can
1162 add one via GvHVn and it won't have the magic set. */
5b9c0671
NC
1163 HV *const hv = newHV();
1164 hv_magic(hv, NULL, PERL_MAGIC_hints);
1165 GvHV(PL_hintgv) = hv;
dfa41748 1166 }
5b9c0671 1167 assert(GvHV(PL_hintgv));
b3ac6de7 1168 break;
cb50131a 1169 case SAVEt_COMPPAD:
03dba561 1170 PL_comppad = (PAD*)ARG0_PTR;
58ed4fbe 1171 if (PL_comppad)
cb50131a
CB
1172 PL_curpad = AvARRAY(PL_comppad);
1173 else
4608196e 1174 PL_curpad = NULL;
cb50131a 1175 break;
09edbca0 1176 case SAVEt_PADSV_AND_MORTALIZE:
c3564e5c 1177 {
09edbca0 1178 SV **svp;
03dba561
DM
1179 assert (ARG1_PTR);
1180 svp = AvARRAY((PAD*)ARG1_PTR) + (PADOFFSET)arg0.any_uv;
09edbca0
NC
1181 /* This mortalizing used to be done by POPLOOP() via itersave.
1182 But as we have all the information here, we can do it here,
1183 save even having to have itersave in the struct. */
1184 sv_2mortal(*svp);
03dba561 1185 *svp = ARG2_SV;
c3564e5c
GS
1186 }
1187 break;
8b7059b1
DM
1188 case SAVEt_SAVESWITCHSTACK:
1189 {
1190 dSP;
03dba561
DM
1191 SWITCHSTACK(ARG0_AV, ARG1_AV);
1192 PL_curstackinfo->si_stack = ARG1_AV;
8b7059b1
DM
1193 }
1194 break;
14f338dc 1195 case SAVEt_SET_SVFLAGS:
03dba561
DM
1196 SvFLAGS(ARG2_SV) &= ~((U32)ARG1_I32);
1197 SvFLAGS(ARG2_SV) |= (U32)ARG0_I32;
14f338dc 1198 break;
95e06916 1199
95e06916
NC
1200 /* These are only saved in mathoms.c */
1201 case SAVEt_NSTAB:
03dba561 1202 (void)sv_clear(ARG0_SV);
95e06916 1203 break;
2053acbf 1204 case SAVEt_LONG: /* long reference */
03dba561 1205 *(long*)ARG0_PTR = arg1.any_long;
2053acbf 1206 break;
95e06916 1207 case SAVEt_IV: /* IV reference */
03dba561 1208 *(IV*)ARG0_PTR = arg1.any_iv;
95e06916
NC
1209 break;
1210
2053acbf 1211 case SAVEt_I16: /* I16 reference */
03dba561 1212 *(I16*)ARG0_PTR = (I16)(uv >> 8);
2053acbf
NC
1213 break;
1214 case SAVEt_I8: /* I8 reference */
03dba561 1215 *(I8*)ARG0_PTR = (I8)(uv >> 8);
2053acbf 1216 break;
2053acbf 1217 case SAVEt_DESTRUCTOR:
03dba561 1218 (*arg1.any_dptr)(ARG0_PTR);
2053acbf 1219 break;
68da3b2f 1220 case SAVEt_COMPILE_WARNINGS:
68da3b2f
NC
1221 if (!specialWARN(PL_compiling.cop_warnings))
1222 PerlMemShared_free(PL_compiling.cop_warnings);
72dc9ed5 1223
03dba561 1224 PL_compiling.cop_warnings = (STRLEN*)ARG0_PTR;
72dc9ed5 1225 break;
1ade1aa1
NC
1226 case SAVEt_RE_STATE:
1227 {
1228 const struct re_save_state *const state
1229 = (struct re_save_state *)
1230 (PL_savestack + PL_savestack_ix
1231 - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
1232 PL_savestack_ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
1233
1ade1aa1
NC
1234 if (PL_reg_poscache != state->re_state_reg_poscache) {
1235 Safefree(PL_reg_poscache);
1ade1aa1 1236 }
46ab3289 1237 Copy(state, &PL_reg_state, 1, struct re_save_state);
1ade1aa1
NC
1238 }
1239 break;
7c197c94 1240 case SAVEt_PARSER:
03dba561 1241 parser_free((yy_parser *) ARG0_PTR);
7c197c94 1242 break;
79072805 1243 default:
5637ef5b 1244 Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
79072805
LW
1245 }
1246 }
302c0c93 1247
284167a5 1248 TAINT_set(was);
f410a211
NC
1249
1250 PERL_ASYNC_CHECK();
79072805 1251}
8990e307 1252
8990e307 1253void
864dbfa3 1254Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
8990e307 1255{
97aff369 1256 dVAR;
7918f24d
NC
1257
1258 PERL_ARGS_ASSERT_CX_DUMP;
1259
35ff7856 1260#ifdef DEBUGGING
22c35a8c 1261 PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
6b35e009 1262 if (CxTYPE(cx) != CXt_SUBST) {
e8d9e9d0 1263 const char *gimme_text;
760ac839 1264 PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
146174a9
CB
1265 PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
1266 PTR2UV(cx->blk_oldcop));
760ac839
LW
1267 PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
1268 PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
146174a9
CB
1269 PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
1270 PTR2UV(cx->blk_oldpm));
e8d9e9d0
VP
1271 switch (cx->blk_gimme) {
1272 case G_VOID:
1273 gimme_text = "VOID";
1274 break;
1275 case G_SCALAR:
1276 gimme_text = "SCALAR";
1277 break;
1278 case G_ARRAY:
1279 gimme_text = "LIST";
1280 break;
1281 default:
1282 gimme_text = "UNKNOWN";
1283 break;
1284 }
1285 PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", gimme_text);
8990e307 1286 }
6b35e009 1287 switch (CxTYPE(cx)) {
8990e307
LW
1288 case CXt_NULL:
1289 case CXt_BLOCK:
1290 break;
146174a9 1291 case CXt_FORMAT:
f9c764c5
NC
1292 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%"UVxf"\n",
1293 PTR2UV(cx->blk_format.cv));
1294 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%"UVxf"\n",
1295 PTR2UV(cx->blk_format.gv));
1296 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%"UVxf"\n",
1297 PTR2UV(cx->blk_format.dfoutgv));
1298 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n",
bafb2adc 1299 (int)CxHASARGS(cx));
f9c764c5
NC
1300 PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%"UVxf"\n",
1301 PTR2UV(cx->blk_format.retop));
146174a9 1302 break;
8990e307 1303 case CXt_SUB:
146174a9
CB
1304 PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
1305 PTR2UV(cx->blk_sub.cv));
760ac839 1306 PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
8990e307 1307 (long)cx->blk_sub.olddepth);
760ac839 1308 PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
bafb2adc
NC
1309 (int)CxHASARGS(cx));
1310 PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx));
f39bc417
DM
1311 PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
1312 PTR2UV(cx->blk_sub.retop));
8990e307
LW
1313 break;
1314 case CXt_EVAL:
760ac839 1315 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
85a64632 1316 (long)CxOLD_IN_EVAL(cx));
760ac839 1317 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
85a64632
NC
1318 PL_op_name[CxOLD_OP_TYPE(cx)],
1319 PL_op_desc[CxOLD_OP_TYPE(cx)]);
0f79a09d
GS
1320 if (cx->blk_eval.old_namesv)
1321 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
aa07b2f6 1322 SvPVX_const(cx->blk_eval.old_namesv));
146174a9
CB
1323 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
1324 PTR2UV(cx->blk_eval.old_eval_root));
f39bc417
DM
1325 PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n",
1326 PTR2UV(cx->blk_eval.retop));
8990e307
LW
1327 break;
1328
c6fdafd0 1329 case CXt_LOOP_LAZYIV:
d01136d6 1330 case CXt_LOOP_LAZYSV:
3b719c58
NC
1331 case CXt_LOOP_FOR:
1332 case CXt_LOOP_PLAIN:
0cbdab38 1333 PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx));
760ac839 1334 PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
8990e307 1335 (long)cx->blk_loop.resetsp);
022eaa24
NC
1336 PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
1337 PTR2UV(cx->blk_loop.my_op));
d01136d6 1338 /* XXX: not accurate for LAZYSV/IV */
146174a9 1339 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
d01136d6
BS
1340 PTR2UV(cx->blk_loop.state_u.ary.ary));
1341 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
1342 (long)cx->blk_loop.state_u.ary.ix);
146174a9
CB
1343 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
1344 PTR2UV(CxITERVAR(cx)));
8990e307
LW
1345 break;
1346
1347 case CXt_SUBST:
760ac839 1348 PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
8990e307 1349 (long)cx->sb_iters);
760ac839 1350 PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
8990e307 1351 (long)cx->sb_maxiters);
35ef4773
GS
1352 PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
1353 (long)cx->sb_rflags);
760ac839 1354 PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
c5bed6a7 1355 (long)CxONCE(cx));
760ac839 1356 PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
8990e307 1357 cx->sb_orig);
146174a9
CB
1358 PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
1359 PTR2UV(cx->sb_dstr));
1360 PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
1361 PTR2UV(cx->sb_targ));
1362 PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
1363 PTR2UV(cx->sb_s));
1364 PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
1365 PTR2UV(cx->sb_m));
1366 PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
1367 PTR2UV(cx->sb_strend));
1368 PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
1369 PTR2UV(cx->sb_rxres));
8990e307
LW
1370 break;
1371 }
65e66c80 1372#else
96a5add6 1373 PERL_UNUSED_CONTEXT;
65e66c80 1374 PERL_UNUSED_ARG(cx);
17c3b450 1375#endif /* DEBUGGING */
35ff7856 1376}
241d1a3b
NC
1377
1378/*
1379 * Local variables:
1380 * c-indentation-style: bsd
1381 * c-basic-offset: 4
14d04a33 1382 * indent-tabs-mode: nil
241d1a3b
NC
1383 * End:
1384 *
14d04a33 1385 * ex: set ts=8 sts=4 sw=4 et:
37442d52 1386 */