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