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