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