This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[win32] Integrate mainline
[perl5.git] / scope.c
CommitLineData
a0d0e21e 1/* scope.c
79072805 2 *
9607fc9c 3 * Copyright (c) 1991-1997, Larry Wall
79072805
LW
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
a0d0e21e
LW
8 */
9
10/*
11 * "For the fashion of Minas Tirith was such that it was built on seven
12 * levels..."
79072805
LW
13 */
14
15#include "EXTERN.h"
16#include "perl.h"
17
a0d0e21e 18SV**
8ac85365 19stack_grow(SV **sp, SV **p, int n)
a0d0e21e 20{
11343788 21 dTHR;
a0d0e21e 22 stack_sp = sp;
1f96a9ed 23 av_extend(curstack, (p - stack_base) + (n) + 128);
a0d0e21e
LW
24 return stack_sp;
25}
26
79072805 27I32
8ac85365 28cxinc(void)
79072805 29{
11343788 30 dTHR;
79072805 31 cxstack_max = cxstack_max * 3 / 2;
c09156bb 32 Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */
79072805
LW
33 return cxstack_ix + 1;
34}
35
36void
8ac85365 37push_return(OP *retop)
79072805 38{
11343788 39 dTHR;
79072805
LW
40 if (retstack_ix == retstack_max) {
41 retstack_max = retstack_max * 3 / 2;
42 Renew(retstack, retstack_max, OP*);
43 }
44 retstack[retstack_ix++] = retop;
45}
46
47OP *
8ac85365 48pop_return(void)
79072805 49{
11343788 50 dTHR;
79072805
LW
51 if (retstack_ix > 0)
52 return retstack[--retstack_ix];
53 else
54 return Nullop;
55}
56
57void
8ac85365 58push_scope(void)
79072805 59{
11343788 60 dTHR;
79072805
LW
61 if (scopestack_ix == scopestack_max) {
62 scopestack_max = scopestack_max * 3 / 2;
63 Renew(scopestack, scopestack_max, I32);
64 }
65 scopestack[scopestack_ix++] = savestack_ix;
66
67}
68
69void
8ac85365 70pop_scope(void)
79072805 71{
11343788 72 dTHR;
79072805 73 I32 oldsave = scopestack[--scopestack_ix];
8990e307 74 LEAVE_SCOPE(oldsave);
79072805
LW
75}
76
77void
8ac85365 78markstack_grow(void)
a0d0e21e 79{
11343788 80 dTHR;
a0d0e21e
LW
81 I32 oldmax = markstack_max - markstack;
82 I32 newmax = oldmax * 3 / 2;
83
84 Renew(markstack, newmax, I32);
85 markstack_ptr = markstack + oldmax;
86 markstack_max = markstack + newmax;
87}
88
89void
8ac85365 90savestack_grow(void)
79072805 91{
11343788 92 dTHR;
79072805
LW
93 savestack_max = savestack_max * 3 / 2;
94 Renew(savestack, savestack_max, ANY);
95}
96
97void
8ac85365 98free_tmps(void)
79072805 99{
11343788 100 dTHR;
79072805
LW
101 /* XXX should tmps_floor live in cxstack? */
102 I32 myfloor = tmps_floor;
103 while (tmps_ix > myfloor) { /* clean up after last statement */
104 SV* sv = tmps_stack[tmps_ix];
105 tmps_stack[tmps_ix--] = Nullsv;
463ee0b2
LW
106 if (sv) {
107#ifdef DEBUGGING
108 SvTEMP_off(sv);
109#endif
8990e307 110 SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */
463ee0b2 111 }
79072805
LW
112 }
113}
114
7a4c00b4 115static SV *
8ac85365 116save_scalar_at(SV **sptr)
79072805 117{
11343788 118 dTHR;
79072805 119 register SV *sv;
7a4c00b4 120 SV *osv = *sptr;
79072805 121
7a4c00b4 122 sv = *sptr = NEWSV(0,0);
a0d0e21e 123 if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
79072805 124 sv_upgrade(sv, SvTYPE(osv));
a0d0e21e 125 if (SvGMAGICAL(osv)) {
748a9306
LW
126 MAGIC* mg;
127 bool oldtainted = tainted;
a0d0e21e 128 mg_get(osv);
748a9306
LW
129 if (tainting && tainted && (mg = mg_find(osv, 't'))) {
130 SAVESPTR(mg->mg_obj);
131 mg->mg_obj = osv;
132 }
a0d0e21e
LW
133 SvFLAGS(osv) |= (SvFLAGS(osv) &
134 (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
748a9306 135 tainted = oldtainted;
a0d0e21e 136 }
79072805 137 SvMAGIC(sv) = SvMAGIC(osv);
a0d0e21e 138 SvFLAGS(sv) |= SvMAGICAL(osv);
748a9306 139 localizing = 1;
79072805 140 SvSETMAGIC(sv);
748a9306 141 localizing = 0;
79072805
LW
142 }
143 return sv;
144}
145
7a4c00b4 146SV *
8ac85365 147save_scalar(GV *gv)
7a4c00b4 148{
11343788 149 dTHR;
7a4c00b4
PP
150 SSCHECK(3);
151 SSPUSHPTR(gv);
152 SSPUSHPTR(GvSV(gv));
153 SSPUSHINT(SAVEt_SV);
154 return save_scalar_at(&GvSV(gv));
155}
156
157SV*
8ac85365 158save_svref(SV **sptr)
7a4c00b4 159{
11343788 160 dTHR;
7a4c00b4
PP
161 SSCHECK(3);
162 SSPUSHPTR(sptr);
163 SSPUSHPTR(*sptr);
164 SSPUSHINT(SAVEt_SVREF);
165 return save_scalar_at(sptr);
166}
167
79072805 168void
8ac85365 169save_gp(GV *gv, I32 empty)
79072805 170{
e858de61 171 dTHR;
fb73857a
PP
172 SSCHECK(6);
173 SSPUSHIV((IV)SvLEN(gv));
174 SvLEN(gv) = 0; /* forget that anything was allocated here */
175 SSPUSHIV((IV)SvCUR(gv));
176 SSPUSHPTR(SvPVX(gv));
177 SvPOK_off(gv);
4633a7c4 178 SSPUSHPTR(SvREFCNT_inc(gv));
5f05dabc 179 SSPUSHPTR(GvGP(gv));
79072805
LW
180 SSPUSHINT(SAVEt_GP);
181
5f05dabc
PP
182 if (empty) {
183 register GP *gp;
184 Newz(602, gp, 1, GP);
44a8e56a 185 GvGP(gv) = gp_ref(gp);
5f05dabc
PP
186 GvSV(gv) = NEWSV(72,0);
187 GvLINE(gv) = curcop->cop_line;
188 GvEGV(gv) = gv;
189 }
190 else {
44a8e56a 191 gp_ref(GvGP(gv));
5f05dabc
PP
192 GvINTRO_on(gv);
193 }
79072805 194}
79072805 195
79072805 196AV *
8ac85365 197save_ary(GV *gv)
79072805 198{
11343788 199 dTHR;
fb73857a
PP
200 AV *oav, *av;
201
79072805
LW
202 SSCHECK(3);
203 SSPUSHPTR(gv);
fb73857a 204 SSPUSHPTR(oav = GvAVn(gv));
79072805
LW
205 SSPUSHINT(SAVEt_AV);
206
207 GvAV(gv) = Null(AV*);
fb73857a
PP
208 av = GvAVn(gv);
209 if (SvMAGIC(oav)) {
210 SvMAGIC(av) = SvMAGIC(oav);
211 SvFLAGS(av) |= SvMAGICAL(oav);
212 SvMAGICAL_off(oav);
213 SvMAGIC(oav) = 0;
214 localizing = 1;
215 SvSETMAGIC((SV*)av);
216 localizing = 0;
217 }
218 return av;
79072805
LW
219}
220
221HV *
8ac85365 222save_hash(GV *gv)
79072805 223{
11343788 224 dTHR;
fb73857a
PP
225 HV *ohv, *hv;
226
79072805
LW
227 SSCHECK(3);
228 SSPUSHPTR(gv);
fb73857a 229 SSPUSHPTR(ohv = GvHVn(gv));
79072805
LW
230 SSPUSHINT(SAVEt_HV);
231
232 GvHV(gv) = Null(HV*);
fb73857a
PP
233 hv = GvHVn(gv);
234 if (SvMAGIC(ohv)) {
235 SvMAGIC(hv) = SvMAGIC(ohv);
236 SvFLAGS(hv) |= SvMAGICAL(ohv);
237 SvMAGICAL_off(ohv);
238 SvMAGIC(ohv) = 0;
239 localizing = 1;
240 SvSETMAGIC((SV*)hv);
241 localizing = 0;
242 }
243 return hv;
79072805
LW
244}
245
246void
8ac85365 247save_item(register SV *item)
79072805 248{
11343788 249 dTHR;
79072805
LW
250 register SV *sv;
251
252 SSCHECK(3);
253 SSPUSHPTR(item); /* remember the pointer */
254 sv = NEWSV(0,0);
255 sv_setsv(sv,item);
256 SSPUSHPTR(sv); /* remember the value */
257 SSPUSHINT(SAVEt_ITEM);
258}
259
260void
8ac85365 261save_int(int *intp)
79072805 262{
11343788 263 dTHR;
79072805
LW
264 SSCHECK(3);
265 SSPUSHINT(*intp);
266 SSPUSHPTR(intp);
267 SSPUSHINT(SAVEt_INT);
268}
269
270void
8ac85365 271save_long(long int *longp)
85e6fe83 272{
11343788 273 dTHR;
85e6fe83
LW
274 SSCHECK(3);
275 SSPUSHLONG(*longp);
276 SSPUSHPTR(longp);
277 SSPUSHINT(SAVEt_LONG);
278}
279
280void
8ac85365 281save_I32(I32 *intp)
79072805 282{
11343788 283 dTHR;
79072805
LW
284 SSCHECK(3);
285 SSPUSHINT(*intp);
286 SSPUSHPTR(intp);
287 SSPUSHINT(SAVEt_I32);
288}
289
a0d0e21e 290void
8ac85365 291save_I16(I16 *intp)
55497cff 292{
e858de61 293 dTHR;
55497cff
PP
294 SSCHECK(3);
295 SSPUSHINT(*intp);
296 SSPUSHPTR(intp);
297 SSPUSHINT(SAVEt_I16);
298}
299
300void
8ac85365 301save_iv(IV *ivp)
a0d0e21e 302{
11343788 303 dTHR;
a0d0e21e 304 SSCHECK(3);
4aa0a1f7 305 SSPUSHIV(*ivp);
a0d0e21e
LW
306 SSPUSHPTR(ivp);
307 SSPUSHINT(SAVEt_IV);
308}
309
85e6fe83
LW
310/* Cannot use save_sptr() to store a char* since the SV** cast will
311 * force word-alignment and we'll miss the pointer.
312 */
313void
8ac85365 314save_pptr(char **pptr)
85e6fe83 315{
11343788 316 dTHR;
85e6fe83
LW
317 SSCHECK(3);
318 SSPUSHPTR(*pptr);
319 SSPUSHPTR(pptr);
320 SSPUSHINT(SAVEt_PPTR);
321}
322
79072805 323void
8ac85365 324save_sptr(SV **sptr)
79072805 325{
11343788 326 dTHR;
79072805
LW
327 SSCHECK(3);
328 SSPUSHPTR(*sptr);
329 SSPUSHPTR(sptr);
330 SSPUSHINT(SAVEt_SPTR);
331}
332
54b9620d
MB
333SV **
334save_threadsv(PADOFFSET i)
335{
336#ifdef USE_THREADS
337 dTHR;
338 SV **svp = av_fetch(thr->threadsv, i, FALSE);
339 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
340 i, svp, *svp, SvPEEK(*svp)));
341 save_svref(svp);
342 return svp;
343#else
344 croak("panic: save_threadsv called in non-threaded perl");
345 return 0;
346#endif /* USE_THREADS */
347}
348
79072805 349void
8ac85365 350save_nogv(GV *gv)
79072805 351{
11343788 352 dTHR;
79072805
LW
353 SSCHECK(2);
354 SSPUSHPTR(gv);
355 SSPUSHINT(SAVEt_NSTAB);
356}
357
358void
8ac85365 359save_hptr(HV **hptr)
79072805 360{
11343788 361 dTHR;
79072805 362 SSCHECK(3);
85e6fe83 363 SSPUSHPTR(*hptr);
79072805
LW
364 SSPUSHPTR(hptr);
365 SSPUSHINT(SAVEt_HPTR);
366}
367
368void
8ac85365 369save_aptr(AV **aptr)
79072805 370{
11343788 371 dTHR;
79072805 372 SSCHECK(3);
85e6fe83 373 SSPUSHPTR(*aptr);
79072805
LW
374 SSPUSHPTR(aptr);
375 SSPUSHINT(SAVEt_APTR);
376}
377
378void
8ac85365 379save_freesv(SV *sv)
8990e307 380{
11343788 381 dTHR;
8990e307
LW
382 SSCHECK(2);
383 SSPUSHPTR(sv);
384 SSPUSHINT(SAVEt_FREESV);
385}
386
387void
8ac85365 388save_freeop(OP *o)
8990e307 389{
11343788 390 dTHR;
8990e307 391 SSCHECK(2);
11343788 392 SSPUSHPTR(o);
8990e307
LW
393 SSPUSHINT(SAVEt_FREEOP);
394}
395
396void
8ac85365 397save_freepv(char *pv)
8990e307 398{
11343788 399 dTHR;
8990e307
LW
400 SSCHECK(2);
401 SSPUSHPTR(pv);
402 SSPUSHINT(SAVEt_FREEPV);
403}
404
405void
8ac85365 406save_clearsv(SV **svp)
8990e307 407{
11343788 408 dTHR;
8990e307 409 SSCHECK(2);
4aa0a1f7 410 SSPUSHLONG((long)(svp-curpad));
8990e307
LW
411 SSPUSHINT(SAVEt_CLEARSV);
412}
413
414void
8ac85365 415save_delete(HV *hv, char *key, I32 klen)
8990e307 416{
11343788 417 dTHR;
8990e307
LW
418 SSCHECK(4);
419 SSPUSHINT(klen);
420 SSPUSHPTR(key);
421 SSPUSHPTR(hv);
422 SSPUSHINT(SAVEt_DELETE);
423}
424
425void
8ac85365 426save_list(register SV **sarg, I32 maxsarg)
79072805 427{
11343788 428 dTHR;
79072805
LW
429 register SV *sv;
430 register I32 i;
431
432 SSCHECK(3 * maxsarg);
433 for (i = 1; i <= maxsarg; i++) {
434 SSPUSHPTR(sarg[i]); /* remember the pointer */
435 sv = NEWSV(0,0);
436 sv_setsv(sv,sarg[i]);
437 SSPUSHPTR(sv); /* remember the value */
438 SSPUSHINT(SAVEt_ITEM);
439 }
440}
441
442void
8ac85365 443save_destructor(void (*f) (void *), void *p)
a0d0e21e 444{
11343788 445 dTHR;
a0d0e21e
LW
446 SSCHECK(3);
447 SSPUSHDPTR(f);
448 SSPUSHPTR(p);
449 SSPUSHINT(SAVEt_DESTRUCTOR);
450}
451
452void
8ac85365 453save_op(void)
462e5cf6
MB
454{
455 dTHR;
456 SSCHECK(2);
457 SSPUSHPTR(op);
458 SSPUSHINT(SAVEt_OP);
459}
460
461void
8ac85365 462leave_scope(I32 base)
79072805 463{
11343788 464 dTHR;
79072805
LW
465 register SV *sv;
466 register SV *value;
467 register GV *gv;
468 register AV *av;
469 register HV *hv;
470 register void* ptr;
471
472 if (base < -1)
463ee0b2 473 croak("panic: corrupt saved stack index");
79072805
LW
474 while (savestack_ix > base) {
475 switch (SSPOPINT) {
476 case SAVEt_ITEM: /* normal string */
477 value = (SV*)SSPOPPTR;
478 sv = (SV*)SSPOPPTR;
479 sv_replace(sv,value);
748a9306 480 localizing = 2;
79072805 481 SvSETMAGIC(sv);
748a9306 482 localizing = 0;
79072805
LW
483 break;
484 case SAVEt_SV: /* scalar reference */
485 value = (SV*)SSPOPPTR;
486 gv = (GV*)SSPOPPTR;
7a4c00b4
PP
487 ptr = &GvSV(gv);
488 goto restore_sv;
79072805 489 case SAVEt_SVREF: /* scalar reference */
7a4c00b4 490 value = (SV*)SSPOPPTR;
79072805 491 ptr = SSPOPPTR;
7a4c00b4 492 restore_sv:
79072805 493 sv = *(SV**)ptr;
54b9620d
MB
494 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
495 "restore svref: %p %p:%s -> %p:%s\n",
496 ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
748a9306
LW
497 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
498 SvTYPE(sv) != SVt_PVGV)
499 {
a0d0e21e
LW
500 (void)SvUPGRADE(value, SvTYPE(sv));
501 SvMAGIC(value) = SvMAGIC(sv);
502 SvFLAGS(value) |= SvMAGICAL(sv);
503 SvMAGICAL_off(sv);
79072805 504 SvMAGIC(sv) = 0;
a0d0e21e 505 }
7a4c00b4
PP
506 else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
507 SvTYPE(value) != SVt_PVGV)
508 {
509 SvFLAGS(value) |= (SvFLAGS(value) &
510 (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
511 SvMAGICAL_off(value);
512 SvMAGIC(value) = 0;
513 }
8990e307 514 SvREFCNT_dec(sv);
a0d0e21e 515 *(SV**)ptr = value;
748a9306 516 localizing = 2;
a0d0e21e 517 SvSETMAGIC(value);
748a9306 518 localizing = 0;
79072805
LW
519 break;
520 case SAVEt_AV: /* array reference */
521 av = (AV*)SSPOPPTR;
522 gv = (GV*)SSPOPPTR;
fb73857a
PP
523 if (GvAV(gv)) {
524 AV *goner = GvAV(gv);
525 SvMAGIC(av) = SvMAGIC(goner);
526 SvFLAGS(av) |= SvMAGICAL(goner);
527 SvMAGICAL_off(goner);
528 SvMAGIC(goner) = 0;
529 SvREFCNT_dec(goner);
530 }
79072805 531 GvAV(gv) = av;
fb73857a
PP
532 if (SvMAGICAL(av)) {
533 localizing = 2;
534 SvSETMAGIC((SV*)av);
535 localizing = 0;
536 }
79072805
LW
537 break;
538 case SAVEt_HV: /* hash reference */
539 hv = (HV*)SSPOPPTR;
540 gv = (GV*)SSPOPPTR;
fb73857a
PP
541 if (GvHV(gv)) {
542 HV *goner = GvHV(gv);
543 SvMAGIC(hv) = SvMAGIC(goner);
544 SvFLAGS(hv) |= SvMAGICAL(goner);
545 SvMAGICAL_off(goner);
546 SvMAGIC(goner) = 0;
547 SvREFCNT_dec(goner);
548 }
79072805 549 GvHV(gv) = hv;
fb73857a
PP
550 if (SvMAGICAL(hv)) {
551 localizing = 2;
552 SvSETMAGIC((SV*)hv);
553 localizing = 0;
554 }
79072805
LW
555 break;
556 case SAVEt_INT: /* int reference */
557 ptr = SSPOPPTR;
558 *(int*)ptr = (int)SSPOPINT;
559 break;
85e6fe83
LW
560 case SAVEt_LONG: /* long reference */
561 ptr = SSPOPPTR;
562 *(long*)ptr = (long)SSPOPLONG;
563 break;
79072805
LW
564 case SAVEt_I32: /* I32 reference */
565 ptr = SSPOPPTR;
566 *(I32*)ptr = (I32)SSPOPINT;
567 break;
55497cff
PP
568 case SAVEt_I16: /* I16 reference */
569 ptr = SSPOPPTR;
570 *(I16*)ptr = (I16)SSPOPINT;
571 break;
a0d0e21e
LW
572 case SAVEt_IV: /* IV reference */
573 ptr = SSPOPPTR;
574 *(IV*)ptr = (IV)SSPOPIV;
575 break;
79072805
LW
576 case SAVEt_SPTR: /* SV* reference */
577 ptr = SSPOPPTR;
578 *(SV**)ptr = (SV*)SSPOPPTR;
579 break;
85e6fe83
LW
580 case SAVEt_PPTR: /* char* reference */
581 ptr = SSPOPPTR;
582 *(char**)ptr = (char*)SSPOPPTR;
583 break;
79072805
LW
584 case SAVEt_HPTR: /* HV* reference */
585 ptr = SSPOPPTR;
586 *(HV**)ptr = (HV*)SSPOPPTR;
587 break;
588 case SAVEt_APTR: /* AV* reference */
589 ptr = SSPOPPTR;
590 *(AV**)ptr = (AV*)SSPOPPTR;
591 break;
592 case SAVEt_NSTAB:
593 gv = (GV*)SSPOPPTR;
1f96a9ed 594 (void)sv_clear((SV*)gv);
79072805 595 break;
fb73857a 596 case SAVEt_GP: /* scalar reference */
79072805
LW
597 ptr = SSPOPPTR;
598 gv = (GV*)SSPOPPTR;
599 gp_free(gv);
600 GvGP(gv) = (GP*)ptr;
fb73857a
PP
601 if (SvPOK(gv) && SvLEN(gv) > 0) {
602 Safefree(SvPVX(gv));
603 }
604 SvPVX(gv) = (char *)SSPOPPTR;
605 SvCUR(gv) = (STRLEN)SSPOPIV;
606 SvLEN(gv) = (STRLEN)SSPOPIV;
4633a7c4 607 SvREFCNT_dec(gv);
79072805 608 break;
8990e307
LW
609 case SAVEt_FREESV:
610 ptr = SSPOPPTR;
611 SvREFCNT_dec((SV*)ptr);
612 break;
613 case SAVEt_FREEOP:
614 ptr = SSPOPPTR;
46fc3d4c
PP
615 if (comppad)
616 curpad = AvARRAY(comppad);
8990e307
LW
617 op_free((OP*)ptr);
618 break;
619 case SAVEt_FREEPV:
620 ptr = SSPOPPTR;
621 Safefree((char*)ptr);
622 break;
623 case SAVEt_CLEARSV:
4aa0a1f7 624 ptr = (void*)&curpad[SSPOPLONG];
8990e307 625 sv = *(SV**)ptr;
bc44cdaf
GS
626 /* Can clear pad variable in place? */
627 if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
8990e307
LW
628 if (SvTHINKFIRST(sv)) {
629 if (SvREADONLY(sv))
630 croak("panic: leave_scope clearsv");
631 if (SvROK(sv))
632 sv_unref(sv);
633 }
a0d0e21e
LW
634 if (SvMAGICAL(sv))
635 mg_free(sv);
8990e307
LW
636
637 switch (SvTYPE(sv)) {
638 case SVt_NULL:
639 break;
640 case SVt_PVAV:
44a8e56a 641 av_clear((AV*)sv);
8990e307
LW
642 break;
643 case SVt_PVHV:
44a8e56a 644 hv_clear((HV*)sv);
8990e307
LW
645 break;
646 case SVt_PVCV:
5377b701
CS
647 croak("panic: leave_scope pad code");
648 case SVt_RV:
649 case SVt_IV:
650 case SVt_NV:
651 (void)SvOK_off(sv);
8990e307
LW
652 break;
653 default:
a0d0e21e 654 (void)SvOK_off(sv);
5377b701 655 (void)SvOOK_off(sv);
8990e307
LW
656 break;
657 }
658 }
659 else { /* Someone has a claim on this, so abandon it. */
4aa0a1f7 660 U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
8990e307
LW
661 SvREFCNT_dec(sv); /* Cast current value to the winds. */
662 switch (SvTYPE(sv)) { /* Console ourselves with a new value */
663 case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break;
664 case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break;
665 default: *(SV**)ptr = NEWSV(0,0); break;
666 }
4aa0a1f7 667 SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
8990e307
LW
668 }
669 break;
670 case SAVEt_DELETE:
671 ptr = SSPOPPTR;
672 hv = (HV*)ptr;
673 ptr = SSPOPPTR;
748a9306 674 (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
adbc6bb1 675 Safefree(ptr);
8990e307 676 break;
a0d0e21e
LW
677 case SAVEt_DESTRUCTOR:
678 ptr = SSPOPPTR;
679 (*SSPOPDPTR)(ptr);
680 break;
681 case SAVEt_REGCONTEXT:
8e07c86e
AD
682 {
683 I32 delta = SSPOPINT;
684 savestack_ix -= delta; /* regexp must have croaked */
685 }
a0d0e21e 686 break;
55497cff
PP
687 case SAVEt_STACK_POS: /* Position on Perl stack */
688 {
689 I32 delta = SSPOPINT;
690 stack_sp = stack_base + delta;
691 }
692 break;
462e5cf6
MB
693 case SAVEt_OP:
694 op = (OP*)SSPOPPTR;
695 break;
79072805 696 default:
463ee0b2 697 croak("panic: leave_scope inconsistency");
79072805
LW
698 }
699 }
700}
8990e307
LW
701
702#ifdef DEBUGGING
1f96a9ed 703
8990e307 704void
c09156bb 705cx_dump(PERL_CONTEXT *cx)
8990e307 706{
11343788 707 dTHR;
fb73857a 708 PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
8990e307 709 if (cx->cx_type != CXt_SUBST) {
760ac839
LW
710 PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
711 PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
712 PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
713 PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
714 PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
715 PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
716 PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
8990e307
LW
717 }
718 switch (cx->cx_type) {
719 case CXt_NULL:
720 case CXt_BLOCK:
721 break;
722 case CXt_SUB:
760ac839 723 PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%lx\n",
8990e307 724 (long)cx->blk_sub.cv);
760ac839 725 PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n",
8990e307 726 (long)cx->blk_sub.gv);
760ac839 727 PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n",
8990e307 728 (long)cx->blk_sub.dfoutgv);
760ac839 729 PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
8990e307 730 (long)cx->blk_sub.olddepth);
760ac839 731 PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
8990e307
LW
732 (int)cx->blk_sub.hasargs);
733 break;
734 case CXt_EVAL:
760ac839 735 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
8990e307 736 (long)cx->blk_eval.old_in_eval);
760ac839 737 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
c07a80fd
PP
738 op_name[cx->blk_eval.old_op_type],
739 op_desc[cx->blk_eval.old_op_type]);
760ac839 740 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
8990e307 741 cx->blk_eval.old_name);
760ac839 742 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
8990e307
LW
743 (long)cx->blk_eval.old_eval_root);
744 break;
745
746 case CXt_LOOP:
760ac839 747 PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n",
8990e307 748 cx->blk_loop.label);
760ac839 749 PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
8990e307 750 (long)cx->blk_loop.resetsp);
760ac839 751 PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n",
8990e307 752 (long)cx->blk_loop.redo_op);
760ac839 753 PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n",
8990e307 754 (long)cx->blk_loop.next_op);
760ac839 755 PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n",
8990e307 756 (long)cx->blk_loop.last_op);
760ac839 757 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
8990e307 758 (long)cx->blk_loop.iterix);
760ac839 759 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n",
8990e307 760 (long)cx->blk_loop.iterary);
760ac839 761 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n",
8990e307
LW
762 (long)cx->blk_loop.itervar);
763 if (cx->blk_loop.itervar)
760ac839 764 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n",
8990e307 765 (long)cx->blk_loop.itersave);
7a4c00b4
PP
766 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n",
767 (long)cx->blk_loop.iterlval);
8990e307
LW
768 break;
769
770 case CXt_SUBST:
760ac839 771 PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
8990e307 772 (long)cx->sb_iters);
760ac839 773 PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
8990e307 774 (long)cx->sb_maxiters);
760ac839 775 PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n",
8990e307 776 (long)cx->sb_safebase);
760ac839 777 PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
8990e307 778 (long)cx->sb_once);
760ac839 779 PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
8990e307 780 cx->sb_orig);
760ac839 781 PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n",
8990e307 782 (long)cx->sb_dstr);
760ac839 783 PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n",
8990e307 784 (long)cx->sb_targ);
760ac839 785 PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n",
8990e307 786 (long)cx->sb_s);
760ac839 787 PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n",
8990e307 788 (long)cx->sb_m);
760ac839 789 PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n",
8990e307 790 (long)cx->sb_strend);
c90c0ff4
PP
791 PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n",
792 (long)cx->sb_rxres);
8990e307
LW
793 break;
794 }
795}
796#endif