This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Filter patch to toke.c:
[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
333void
8ac85365 334save_nogv(GV *gv)
79072805 335{
11343788 336 dTHR;
79072805
LW
337 SSCHECK(2);
338 SSPUSHPTR(gv);
339 SSPUSHINT(SAVEt_NSTAB);
340}
341
342void
8ac85365 343save_hptr(HV **hptr)
79072805 344{
11343788 345 dTHR;
79072805 346 SSCHECK(3);
85e6fe83 347 SSPUSHPTR(*hptr);
79072805
LW
348 SSPUSHPTR(hptr);
349 SSPUSHINT(SAVEt_HPTR);
350}
351
352void
8ac85365 353save_aptr(AV **aptr)
79072805 354{
11343788 355 dTHR;
79072805 356 SSCHECK(3);
85e6fe83 357 SSPUSHPTR(*aptr);
79072805
LW
358 SSPUSHPTR(aptr);
359 SSPUSHINT(SAVEt_APTR);
360}
361
362void
8ac85365 363save_freesv(SV *sv)
8990e307 364{
11343788 365 dTHR;
8990e307
LW
366 SSCHECK(2);
367 SSPUSHPTR(sv);
368 SSPUSHINT(SAVEt_FREESV);
369}
370
371void
8ac85365 372save_freeop(OP *o)
8990e307 373{
11343788 374 dTHR;
8990e307 375 SSCHECK(2);
11343788 376 SSPUSHPTR(o);
8990e307
LW
377 SSPUSHINT(SAVEt_FREEOP);
378}
379
380void
8ac85365 381save_freepv(char *pv)
8990e307 382{
11343788 383 dTHR;
8990e307
LW
384 SSCHECK(2);
385 SSPUSHPTR(pv);
386 SSPUSHINT(SAVEt_FREEPV);
387}
388
389void
8ac85365 390save_clearsv(SV **svp)
8990e307 391{
11343788 392 dTHR;
8990e307 393 SSCHECK(2);
4aa0a1f7 394 SSPUSHLONG((long)(svp-curpad));
8990e307
LW
395 SSPUSHINT(SAVEt_CLEARSV);
396}
397
398void
8ac85365 399save_delete(HV *hv, char *key, I32 klen)
8990e307 400{
11343788 401 dTHR;
8990e307
LW
402 SSCHECK(4);
403 SSPUSHINT(klen);
404 SSPUSHPTR(key);
405 SSPUSHPTR(hv);
406 SSPUSHINT(SAVEt_DELETE);
407}
408
409void
8ac85365 410save_list(register SV **sarg, I32 maxsarg)
79072805 411{
11343788 412 dTHR;
79072805
LW
413 register SV *sv;
414 register I32 i;
415
416 SSCHECK(3 * maxsarg);
417 for (i = 1; i <= maxsarg; i++) {
418 SSPUSHPTR(sarg[i]); /* remember the pointer */
419 sv = NEWSV(0,0);
420 sv_setsv(sv,sarg[i]);
421 SSPUSHPTR(sv); /* remember the value */
422 SSPUSHINT(SAVEt_ITEM);
423 }
424}
425
426void
8ac85365 427save_destructor(void (*f) (void *), void *p)
a0d0e21e 428{
11343788 429 dTHR;
a0d0e21e
LW
430 SSCHECK(3);
431 SSPUSHDPTR(f);
432 SSPUSHPTR(p);
433 SSPUSHINT(SAVEt_DESTRUCTOR);
434}
435
436void
8ac85365 437save_op(void)
462e5cf6
MB
438{
439 dTHR;
440 SSCHECK(2);
441 SSPUSHPTR(op);
442 SSPUSHINT(SAVEt_OP);
443}
444
445void
8ac85365 446leave_scope(I32 base)
79072805 447{
11343788 448 dTHR;
79072805
LW
449 register SV *sv;
450 register SV *value;
451 register GV *gv;
452 register AV *av;
453 register HV *hv;
454 register void* ptr;
455
456 if (base < -1)
463ee0b2 457 croak("panic: corrupt saved stack index");
79072805
LW
458 while (savestack_ix > base) {
459 switch (SSPOPINT) {
460 case SAVEt_ITEM: /* normal string */
461 value = (SV*)SSPOPPTR;
462 sv = (SV*)SSPOPPTR;
463 sv_replace(sv,value);
748a9306 464 localizing = 2;
79072805 465 SvSETMAGIC(sv);
748a9306 466 localizing = 0;
79072805
LW
467 break;
468 case SAVEt_SV: /* scalar reference */
469 value = (SV*)SSPOPPTR;
470 gv = (GV*)SSPOPPTR;
7a4c00b4
PP
471 ptr = &GvSV(gv);
472 goto restore_sv;
79072805 473 case SAVEt_SVREF: /* scalar reference */
7a4c00b4 474 value = (SV*)SSPOPPTR;
79072805 475 ptr = SSPOPPTR;
7a4c00b4 476 restore_sv:
79072805 477 sv = *(SV**)ptr;
748a9306
LW
478 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
479 SvTYPE(sv) != SVt_PVGV)
480 {
a0d0e21e
LW
481 (void)SvUPGRADE(value, SvTYPE(sv));
482 SvMAGIC(value) = SvMAGIC(sv);
483 SvFLAGS(value) |= SvMAGICAL(sv);
484 SvMAGICAL_off(sv);
79072805 485 SvMAGIC(sv) = 0;
a0d0e21e 486 }
7a4c00b4
PP
487 else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
488 SvTYPE(value) != SVt_PVGV)
489 {
490 SvFLAGS(value) |= (SvFLAGS(value) &
491 (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
492 SvMAGICAL_off(value);
493 SvMAGIC(value) = 0;
494 }
8990e307 495 SvREFCNT_dec(sv);
a0d0e21e 496 *(SV**)ptr = value;
748a9306 497 localizing = 2;
a0d0e21e 498 SvSETMAGIC(value);
748a9306 499 localizing = 0;
79072805
LW
500 break;
501 case SAVEt_AV: /* array reference */
502 av = (AV*)SSPOPPTR;
503 gv = (GV*)SSPOPPTR;
fb73857a
PP
504 if (GvAV(gv)) {
505 AV *goner = GvAV(gv);
506 SvMAGIC(av) = SvMAGIC(goner);
507 SvFLAGS(av) |= SvMAGICAL(goner);
508 SvMAGICAL_off(goner);
509 SvMAGIC(goner) = 0;
510 SvREFCNT_dec(goner);
511 }
79072805 512 GvAV(gv) = av;
fb73857a
PP
513 if (SvMAGICAL(av)) {
514 localizing = 2;
515 SvSETMAGIC((SV*)av);
516 localizing = 0;
517 }
79072805
LW
518 break;
519 case SAVEt_HV: /* hash reference */
520 hv = (HV*)SSPOPPTR;
521 gv = (GV*)SSPOPPTR;
fb73857a
PP
522 if (GvHV(gv)) {
523 HV *goner = GvHV(gv);
524 SvMAGIC(hv) = SvMAGIC(goner);
525 SvFLAGS(hv) |= SvMAGICAL(goner);
526 SvMAGICAL_off(goner);
527 SvMAGIC(goner) = 0;
528 SvREFCNT_dec(goner);
529 }
79072805 530 GvHV(gv) = hv;
fb73857a
PP
531 if (SvMAGICAL(hv)) {
532 localizing = 2;
533 SvSETMAGIC((SV*)hv);
534 localizing = 0;
535 }
79072805
LW
536 break;
537 case SAVEt_INT: /* int reference */
538 ptr = SSPOPPTR;
539 *(int*)ptr = (int)SSPOPINT;
540 break;
85e6fe83
LW
541 case SAVEt_LONG: /* long reference */
542 ptr = SSPOPPTR;
543 *(long*)ptr = (long)SSPOPLONG;
544 break;
79072805
LW
545 case SAVEt_I32: /* I32 reference */
546 ptr = SSPOPPTR;
547 *(I32*)ptr = (I32)SSPOPINT;
548 break;
55497cff
PP
549 case SAVEt_I16: /* I16 reference */
550 ptr = SSPOPPTR;
551 *(I16*)ptr = (I16)SSPOPINT;
552 break;
a0d0e21e
LW
553 case SAVEt_IV: /* IV reference */
554 ptr = SSPOPPTR;
555 *(IV*)ptr = (IV)SSPOPIV;
556 break;
79072805
LW
557 case SAVEt_SPTR: /* SV* reference */
558 ptr = SSPOPPTR;
559 *(SV**)ptr = (SV*)SSPOPPTR;
560 break;
85e6fe83
LW
561 case SAVEt_PPTR: /* char* reference */
562 ptr = SSPOPPTR;
563 *(char**)ptr = (char*)SSPOPPTR;
564 break;
79072805
LW
565 case SAVEt_HPTR: /* HV* reference */
566 ptr = SSPOPPTR;
567 *(HV**)ptr = (HV*)SSPOPPTR;
568 break;
569 case SAVEt_APTR: /* AV* reference */
570 ptr = SSPOPPTR;
571 *(AV**)ptr = (AV*)SSPOPPTR;
572 break;
573 case SAVEt_NSTAB:
574 gv = (GV*)SSPOPPTR;
1f96a9ed 575 (void)sv_clear((SV*)gv);
79072805 576 break;
fb73857a 577 case SAVEt_GP: /* scalar reference */
79072805
LW
578 ptr = SSPOPPTR;
579 gv = (GV*)SSPOPPTR;
580 gp_free(gv);
581 GvGP(gv) = (GP*)ptr;
fb73857a
PP
582 if (SvPOK(gv) && SvLEN(gv) > 0) {
583 Safefree(SvPVX(gv));
584 }
585 SvPVX(gv) = (char *)SSPOPPTR;
586 SvCUR(gv) = (STRLEN)SSPOPIV;
587 SvLEN(gv) = (STRLEN)SSPOPIV;
4633a7c4 588 SvREFCNT_dec(gv);
79072805 589 break;
8990e307
LW
590 case SAVEt_FREESV:
591 ptr = SSPOPPTR;
592 SvREFCNT_dec((SV*)ptr);
593 break;
594 case SAVEt_FREEOP:
595 ptr = SSPOPPTR;
46fc3d4c
PP
596 if (comppad)
597 curpad = AvARRAY(comppad);
8990e307
LW
598 op_free((OP*)ptr);
599 break;
600 case SAVEt_FREEPV:
601 ptr = SSPOPPTR;
602 Safefree((char*)ptr);
603 break;
604 case SAVEt_CLEARSV:
4aa0a1f7 605 ptr = (void*)&curpad[SSPOPLONG];
8990e307 606 sv = *(SV**)ptr;
bc44cdaf
GS
607 /* Can clear pad variable in place? */
608 if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
8990e307
LW
609 if (SvTHINKFIRST(sv)) {
610 if (SvREADONLY(sv))
611 croak("panic: leave_scope clearsv");
612 if (SvROK(sv))
613 sv_unref(sv);
614 }
a0d0e21e
LW
615 if (SvMAGICAL(sv))
616 mg_free(sv);
8990e307
LW
617
618 switch (SvTYPE(sv)) {
619 case SVt_NULL:
620 break;
621 case SVt_PVAV:
44a8e56a 622 av_clear((AV*)sv);
8990e307
LW
623 break;
624 case SVt_PVHV:
44a8e56a 625 hv_clear((HV*)sv);
8990e307
LW
626 break;
627 case SVt_PVCV:
5377b701
CS
628 croak("panic: leave_scope pad code");
629 case SVt_RV:
630 case SVt_IV:
631 case SVt_NV:
632 (void)SvOK_off(sv);
8990e307
LW
633 break;
634 default:
a0d0e21e 635 (void)SvOK_off(sv);
5377b701 636 (void)SvOOK_off(sv);
8990e307
LW
637 break;
638 }
639 }
640 else { /* Someone has a claim on this, so abandon it. */
4aa0a1f7 641 U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
8990e307
LW
642 SvREFCNT_dec(sv); /* Cast current value to the winds. */
643 switch (SvTYPE(sv)) { /* Console ourselves with a new value */
644 case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break;
645 case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break;
646 default: *(SV**)ptr = NEWSV(0,0); break;
647 }
4aa0a1f7 648 SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
8990e307
LW
649 }
650 break;
651 case SAVEt_DELETE:
652 ptr = SSPOPPTR;
653 hv = (HV*)ptr;
654 ptr = SSPOPPTR;
748a9306 655 (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
adbc6bb1 656 Safefree(ptr);
8990e307 657 break;
a0d0e21e
LW
658 case SAVEt_DESTRUCTOR:
659 ptr = SSPOPPTR;
660 (*SSPOPDPTR)(ptr);
661 break;
662 case SAVEt_REGCONTEXT:
8e07c86e
AD
663 {
664 I32 delta = SSPOPINT;
665 savestack_ix -= delta; /* regexp must have croaked */
666 }
a0d0e21e 667 break;
55497cff
PP
668 case SAVEt_STACK_POS: /* Position on Perl stack */
669 {
670 I32 delta = SSPOPINT;
671 stack_sp = stack_base + delta;
672 }
673 break;
462e5cf6
MB
674 case SAVEt_OP:
675 op = (OP*)SSPOPPTR;
676 break;
79072805 677 default:
463ee0b2 678 croak("panic: leave_scope inconsistency");
79072805
LW
679 }
680 }
681}
8990e307
LW
682
683#ifdef DEBUGGING
1f96a9ed 684
8990e307 685void
c09156bb 686cx_dump(PERL_CONTEXT *cx)
8990e307 687{
11343788 688 dTHR;
fb73857a 689 PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
8990e307 690 if (cx->cx_type != CXt_SUBST) {
760ac839
LW
691 PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
692 PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
693 PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
694 PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
695 PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
696 PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
697 PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
8990e307
LW
698 }
699 switch (cx->cx_type) {
700 case CXt_NULL:
701 case CXt_BLOCK:
702 break;
703 case CXt_SUB:
760ac839 704 PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%lx\n",
8990e307 705 (long)cx->blk_sub.cv);
760ac839 706 PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n",
8990e307 707 (long)cx->blk_sub.gv);
760ac839 708 PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n",
8990e307 709 (long)cx->blk_sub.dfoutgv);
760ac839 710 PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
8990e307 711 (long)cx->blk_sub.olddepth);
760ac839 712 PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
8990e307
LW
713 (int)cx->blk_sub.hasargs);
714 break;
715 case CXt_EVAL:
760ac839 716 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
8990e307 717 (long)cx->blk_eval.old_in_eval);
760ac839 718 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
c07a80fd
PP
719 op_name[cx->blk_eval.old_op_type],
720 op_desc[cx->blk_eval.old_op_type]);
760ac839 721 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
8990e307 722 cx->blk_eval.old_name);
760ac839 723 PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
8990e307
LW
724 (long)cx->blk_eval.old_eval_root);
725 break;
726
727 case CXt_LOOP:
760ac839 728 PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n",
8990e307 729 cx->blk_loop.label);
760ac839 730 PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
8990e307 731 (long)cx->blk_loop.resetsp);
760ac839 732 PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n",
8990e307 733 (long)cx->blk_loop.redo_op);
760ac839 734 PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n",
8990e307 735 (long)cx->blk_loop.next_op);
760ac839 736 PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n",
8990e307 737 (long)cx->blk_loop.last_op);
760ac839 738 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
8990e307 739 (long)cx->blk_loop.iterix);
760ac839 740 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n",
8990e307 741 (long)cx->blk_loop.iterary);
760ac839 742 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n",
8990e307
LW
743 (long)cx->blk_loop.itervar);
744 if (cx->blk_loop.itervar)
760ac839 745 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n",
8990e307 746 (long)cx->blk_loop.itersave);
7a4c00b4
PP
747 PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n",
748 (long)cx->blk_loop.iterlval);
8990e307
LW
749 break;
750
751 case CXt_SUBST:
760ac839 752 PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
8990e307 753 (long)cx->sb_iters);
760ac839 754 PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
8990e307 755 (long)cx->sb_maxiters);
760ac839 756 PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n",
8990e307 757 (long)cx->sb_safebase);
760ac839 758 PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
8990e307 759 (long)cx->sb_once);
760ac839 760 PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
8990e307 761 cx->sb_orig);
760ac839 762 PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n",
8990e307 763 (long)cx->sb_dstr);
760ac839 764 PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n",
8990e307 765 (long)cx->sb_targ);
760ac839 766 PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n",
8990e307 767 (long)cx->sb_s);
760ac839 768 PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n",
8990e307 769 (long)cx->sb_m);
760ac839 770 PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n",
8990e307 771 (long)cx->sb_strend);
c90c0ff4
PP
772 PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n",
773 (long)cx->sb_rxres);
8990e307
LW
774 break;
775 }
776}
777#endif