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