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