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