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