This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
"unofficial" patches for some of the more spectacular [memory leaks]
[perl5.git] / scope.c
1 /*    scope.c
2  *
3  *    Copyright (c) 1991-1994, Larry Wall
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  *
8  */
9
10 /*
11  * "For the fashion of Minas Tirith was such that it was built on seven
12  * levels..."
13  */
14
15 #include "EXTERN.h"
16 #include "perl.h"
17
18 SV**
19 stack_grow(sp, p, n)
20 SV** sp;
21 SV** p;
22 int n;
23 {
24     stack_sp = sp;
25     av_extend(stack, (p - stack_base) + (n) + 128);
26 #ifdef NOTDEF
27     stack_sp = AvARRAY(stack) + (sp - stack_base);
28     stack_base = AvARRAY(stack);
29     stack_max = stack_base + AvMAX(stack) - 1;
30 #endif
31     return stack_sp;
32 }
33
34 I32
35 cxinc()
36 {
37     cxstack_max = cxstack_max * 3 / 2;
38     Renew(cxstack, cxstack_max, CONTEXT);
39     return cxstack_ix + 1;
40 }
41
42 void
43 push_return(retop)
44 OP *retop;
45 {
46     if (retstack_ix == retstack_max) {
47         retstack_max = retstack_max * 3 / 2;
48         Renew(retstack, retstack_max, OP*);
49     }
50     retstack[retstack_ix++] = retop;
51 }
52
53 OP *
54 pop_return()
55 {
56     if (retstack_ix > 0)
57         return retstack[--retstack_ix];
58     else
59         return Nullop;
60 }
61
62 void
63 push_scope()
64 {
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
73 void
74 pop_scope()
75 {
76     I32 oldsave = scopestack[--scopestack_ix];
77     LEAVE_SCOPE(oldsave);
78 }
79
80 void
81 markstack_grow()
82 {
83     I32 oldmax = markstack_max - markstack;
84     I32 newmax = oldmax * 3 / 2;
85
86     Renew(markstack, newmax, I32);
87     markstack_ptr = markstack + oldmax;
88     markstack_max = markstack + newmax;
89 }
90
91 void
92 savestack_grow()
93 {
94     savestack_max = savestack_max * 3 / 2;
95     Renew(savestack, savestack_max, ANY);
96 }
97
98 void
99 free_tmps()
100 {
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;
106         if (sv) {
107 #ifdef DEBUGGING
108             SvTEMP_off(sv);
109 #endif
110             SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
111         }
112     }
113 }
114
115 SV *
116 save_scalar(gv)
117 GV *gv;
118 {
119     register SV *sv;
120     SV *osv = GvSV(gv);
121
122     SSCHECK(3);
123     SSPUSHPTR(gv);
124     SSPUSHPTR(osv);
125     SSPUSHINT(SAVEt_SV);
126
127     sv = GvSV(gv) = NEWSV(0,0);
128     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
129         sv_upgrade(sv, SvTYPE(osv));
130         if (SvGMAGICAL(osv)) {
131             mg_get(osv);
132             SvFLAGS(osv) |= (SvFLAGS(osv) &
133                 (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
134         }
135         SvMAGIC(sv) = SvMAGIC(osv);
136         SvFLAGS(sv) |= SvMAGICAL(osv);
137         localizing = TRUE;
138         SvSETMAGIC(sv);
139         localizing = FALSE;
140     }
141     return sv;
142 }
143
144 #ifdef INLINED_ELSEWHERE
145 void
146 save_gp(gv)
147 GV *gv;
148 {
149     register GP *gp;
150     GP *ogp = GvGP(gv);
151
152     SSCHECK(3);
153     SSPUSHPTR(gv);
154     SSPUSHPTR(ogp);
155     SSPUSHINT(SAVEt_GP);
156
157     Newz(602,gp, 1, GP);
158     GvGP(gv) = gp;
159     GvREFCNT(gv) = 1;
160     GvSV(gv) = NEWSV(72,0);
161     GvLINE(gv) = curcop->cop_line;
162     GvEGV(gv) = gv;
163 }
164 #endif
165
166 SV*
167 save_svref(sptr)
168 SV **sptr;
169 {
170     register SV *sv;
171     SV *osv = *sptr;
172
173     SSCHECK(3);
174     SSPUSHPTR(*sptr);
175     SSPUSHPTR(sptr);
176     SSPUSHINT(SAVEt_SVREF);
177
178     sv = *sptr = NEWSV(0,0);
179     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
180         sv_upgrade(sv, SvTYPE(osv));
181         if (SvGMAGICAL(osv)) {
182             mg_get(osv);
183             SvFLAGS(osv) |= (SvFLAGS(osv) &
184                 (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
185         }
186         SvMAGIC(sv) = SvMAGIC(osv);
187         SvFLAGS(sv) |= SvMAGICAL(osv);
188         localizing = TRUE;
189         SvSETMAGIC(sv);
190         localizing = FALSE;
191     }
192     return sv;
193 }
194
195 AV *
196 save_ary(gv)
197 GV *gv;
198 {
199     SSCHECK(3);
200     SSPUSHPTR(gv);
201     SSPUSHPTR(GvAVn(gv));
202     SSPUSHINT(SAVEt_AV);
203
204     GvAV(gv) = Null(AV*);
205     return GvAVn(gv);
206 }
207
208 HV *
209 save_hash(gv)
210 GV *gv;
211 {
212     SSCHECK(3);
213     SSPUSHPTR(gv);
214     SSPUSHPTR(GvHVn(gv));
215     SSPUSHINT(SAVEt_HV);
216
217     GvHV(gv) = Null(HV*);
218     return GvHVn(gv);
219 }
220
221 void
222 save_item(item)
223 register SV *item;
224 {
225     register SV *sv;
226
227     SSCHECK(3);
228     SSPUSHPTR(item);            /* remember the pointer */
229     sv = NEWSV(0,0);
230     sv_setsv(sv,item);
231     SSPUSHPTR(sv);              /* remember the value */
232     SSPUSHINT(SAVEt_ITEM);
233 }
234
235 void
236 save_int(intp)
237 int *intp;
238 {
239     SSCHECK(3);
240     SSPUSHINT(*intp);
241     SSPUSHPTR(intp);
242     SSPUSHINT(SAVEt_INT);
243 }
244
245 void
246 save_long(longp)
247 long *longp;
248 {
249     SSCHECK(3);
250     SSPUSHLONG(*longp);
251     SSPUSHPTR(longp);
252     SSPUSHINT(SAVEt_LONG);
253 }
254
255 void
256 save_I32(intp)
257 I32 *intp;
258 {
259     SSCHECK(3);
260     SSPUSHINT(*intp);
261     SSPUSHPTR(intp);
262     SSPUSHINT(SAVEt_I32);
263 }
264
265 void
266 save_iv(ivp)
267 IV *ivp;
268 {
269     SSCHECK(3);
270     SSPUSHINT(*ivp);
271     SSPUSHPTR(ivp);
272     SSPUSHINT(SAVEt_IV);
273 }
274
275 /* Cannot use save_sptr() to store a char* since the SV** cast will
276  * force word-alignment and we'll miss the pointer.
277  */
278 void
279 save_pptr(pptr)
280 char **pptr;
281 {
282     SSCHECK(3);
283     SSPUSHPTR(*pptr);
284     SSPUSHPTR(pptr);
285     SSPUSHINT(SAVEt_PPTR);
286 }
287
288 void
289 save_sptr(sptr)
290 SV **sptr;
291 {
292     SSCHECK(3);
293     SSPUSHPTR(*sptr);
294     SSPUSHPTR(sptr);
295     SSPUSHINT(SAVEt_SPTR);
296 }
297
298 void
299 save_nogv(gv)
300 GV *gv;
301 {
302     SSCHECK(2);
303     SSPUSHPTR(gv);
304     SSPUSHINT(SAVEt_NSTAB);
305 }
306
307 void
308 save_hptr(hptr)
309 HV **hptr;
310 {
311     SSCHECK(3);
312     SSPUSHPTR(*hptr);
313     SSPUSHPTR(hptr);
314     SSPUSHINT(SAVEt_HPTR);
315 }
316
317 void
318 save_aptr(aptr)
319 AV **aptr;
320 {
321     SSCHECK(3);
322     SSPUSHPTR(*aptr);
323     SSPUSHPTR(aptr);
324     SSPUSHINT(SAVEt_APTR);
325 }
326
327 void
328 save_freesv(sv)
329 SV *sv;
330 {
331     SSCHECK(2);
332     SSPUSHPTR(sv);
333     SSPUSHINT(SAVEt_FREESV);
334 }
335
336 void
337 save_freeop(op)
338 OP *op;
339 {
340     SSCHECK(2);
341     SSPUSHPTR(op);
342     SSPUSHINT(SAVEt_FREEOP);
343 }
344
345 void
346 save_freepv(pv)
347 char *pv;
348 {
349     SSCHECK(2);
350     SSPUSHPTR(pv);
351     SSPUSHINT(SAVEt_FREEPV);
352 }
353
354 void
355 save_clearsv(svp)
356 SV** svp;
357 {
358     SSCHECK(2);
359     SSPUSHPTR(svp);
360     SSPUSHINT(SAVEt_CLEARSV);
361 }
362
363 void
364 save_delete(hv,key,klen)
365 HV *hv;
366 char *key;
367 I32 klen;
368 {
369     SSCHECK(4);
370     SSPUSHINT(klen);
371     SSPUSHPTR(key);
372     SSPUSHPTR(hv);
373     SSPUSHINT(SAVEt_DELETE);
374 }
375
376 void
377 save_list(sarg,maxsarg)
378 register SV **sarg;
379 I32 maxsarg;
380 {
381     register SV *sv;
382     register I32 i;
383
384     SSCHECK(3 * maxsarg);
385     for (i = 1; i <= maxsarg; i++) {
386         SSPUSHPTR(sarg[i]);             /* remember the pointer */
387         sv = NEWSV(0,0);
388         sv_setsv(sv,sarg[i]);
389         SSPUSHPTR(sv);                  /* remember the value */
390         SSPUSHINT(SAVEt_ITEM);
391     }
392 }
393
394 void
395 save_destructor(f,p)
396 void (*f) _((void*));
397 void* p;
398 {
399     SSCHECK(3);
400     SSPUSHDPTR(f);
401     SSPUSHPTR(p);
402     SSPUSHINT(SAVEt_DESTRUCTOR);
403 }
404
405 void
406 leave_scope(base)
407 I32 base;
408 {
409     register SV *sv;
410     register SV *value;
411     register GV *gv;
412     register AV *av;
413     register HV *hv;
414     register void* ptr;
415
416     if (base < -1)
417         croak("panic: corrupt saved stack index");
418     while (savestack_ix > base) {
419         switch (SSPOPINT) {
420         case SAVEt_ITEM:                        /* normal string */
421             value = (SV*)SSPOPPTR;
422             sv = (SV*)SSPOPPTR;
423             sv_replace(sv,value);
424             localizing = TRUE;
425             SvSETMAGIC(sv);
426             localizing = FALSE;
427             break;
428         case SAVEt_SV:                          /* scalar reference */
429             value = (SV*)SSPOPPTR;
430             gv = (GV*)SSPOPPTR;
431             sv = GvSV(gv);
432             if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && SvTYPE(sv) != SVt_PVGV){
433                 (void)SvUPGRADE(value, SvTYPE(sv));
434                 SvMAGIC(value) = SvMAGIC(sv);
435                 SvFLAGS(value) |= SvMAGICAL(sv);
436                 SvMAGICAL_off(sv);
437                 SvMAGIC(sv) = 0;
438             }
439             SvREFCNT_dec(sv);
440             GvSV(gv) = value;
441             localizing = TRUE;
442             SvSETMAGIC(value);
443             localizing = FALSE;
444             break;
445         case SAVEt_SVREF:                       /* scalar reference */
446             ptr = SSPOPPTR;
447             sv = *(SV**)ptr;
448             value = (SV*)SSPOPPTR;
449             if (SvTYPE(sv) >= SVt_PVMG && SvTYPE(sv) != SVt_PVGV) {
450                 (void)SvUPGRADE(value, SvTYPE(sv));
451                 SvMAGIC(value) = SvMAGIC(sv);
452                 SvFLAGS(value) |= SvMAGICAL(sv);
453                 SvMAGICAL_off(sv);
454                 SvMAGIC(sv) = 0;
455             }
456             SvREFCNT_dec(sv);
457             *(SV**)ptr = value;
458             localizing = TRUE;
459             SvSETMAGIC(value);
460             localizing = FALSE;
461             break;
462         case SAVEt_AV:                          /* array reference */
463             av = (AV*)SSPOPPTR;
464             gv = (GV*)SSPOPPTR;
465             SvREFCNT_dec(GvAV(gv));
466             GvAV(gv) = av;
467             break;
468         case SAVEt_HV:                          /* hash reference */
469             hv = (HV*)SSPOPPTR;
470             gv = (GV*)SSPOPPTR;
471             SvREFCNT_dec(GvHV(gv));
472             GvHV(gv) = hv;
473             break;
474         case SAVEt_INT:                         /* int reference */
475             ptr = SSPOPPTR;
476             *(int*)ptr = (int)SSPOPINT;
477             break;
478         case SAVEt_LONG:                        /* long reference */
479             ptr = SSPOPPTR;
480             *(long*)ptr = (long)SSPOPLONG;
481             break;
482         case SAVEt_I32:                         /* I32 reference */
483             ptr = SSPOPPTR;
484             *(I32*)ptr = (I32)SSPOPINT;
485             break;
486         case SAVEt_IV:                          /* IV reference */
487             ptr = SSPOPPTR;
488             *(IV*)ptr = (IV)SSPOPIV;
489             break;
490         case SAVEt_SPTR:                        /* SV* reference */
491             ptr = SSPOPPTR;
492             *(SV**)ptr = (SV*)SSPOPPTR;
493             break;
494         case SAVEt_PPTR:                        /* char* reference */
495             ptr = SSPOPPTR;
496             *(char**)ptr = (char*)SSPOPPTR;
497             break;
498         case SAVEt_HPTR:                        /* HV* reference */
499             ptr = SSPOPPTR;
500             *(HV**)ptr = (HV*)SSPOPPTR;
501             break;
502         case SAVEt_APTR:                        /* AV* reference */
503             ptr = SSPOPPTR;
504             *(AV**)ptr = (AV*)SSPOPPTR;
505             break;
506         case SAVEt_NSTAB:
507             gv = (GV*)SSPOPPTR;
508             (void)sv_clear(gv);
509             break;
510         case SAVEt_GP:                          /* scalar reference */
511             ptr = SSPOPPTR;
512             gv = (GV*)SSPOPPTR;
513             gp_free(gv);
514             GvGP(gv) = (GP*)ptr;
515             break;
516         case SAVEt_FREESV:
517             ptr = SSPOPPTR;
518             SvREFCNT_dec((SV*)ptr);
519             break;
520         case SAVEt_FREEOP:
521             ptr = SSPOPPTR;
522             curpad = AvARRAY(comppad);
523             op_free((OP*)ptr);
524             break;
525         case SAVEt_FREEPV:
526             ptr = SSPOPPTR;
527             Safefree((char*)ptr);
528             break;
529         case SAVEt_CLEARSV:
530             ptr = SSPOPPTR;
531             sv = *(SV**)ptr;
532             if (SvREFCNT(sv) <= 1) { /* Can clear pad variable in place. */
533                 if (SvTHINKFIRST(sv)) {
534                     if (SvREADONLY(sv))
535                         croak("panic: leave_scope clearsv");
536                     if (SvROK(sv))
537                         sv_unref(sv);
538                 }
539                 if (SvMAGICAL(sv))
540                     mg_free(sv);
541
542                 switch (SvTYPE(sv)) {
543                 case SVt_NULL:
544                     break;
545                 case SVt_PVAV:
546                     av_clear((AV*)sv);
547                     break;
548                 case SVt_PVHV:
549                     hv_clear((HV*)sv);
550                     break;
551                 case SVt_PVCV:
552                     sub_generation++;
553                     cv_undef((CV*)sv);
554                     break;
555                 default:
556                     if (SvPOK(sv) && SvLEN(sv))
557                         (void)SvOOK_off(sv);
558                     (void)SvOK_off(sv);
559                     break;
560                 }
561             }
562             else {      /* Someone has a claim on this, so abandon it. */
563                 SvREFCNT_dec(sv);       /* Cast current value to the winds. */
564                 switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
565                 case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
566                 case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
567                 default:        *(SV**)ptr = NEWSV(0,0);        break;
568                 }
569             }
570             break;
571         case SAVEt_DELETE:
572             ptr = SSPOPPTR;
573             hv = (HV*)ptr;
574             ptr = SSPOPPTR;
575             hv_delete(hv, (char*)ptr, (U32)SSPOPINT);
576             Safefree(ptr);
577             break;
578         case SAVEt_DESTRUCTOR:
579             ptr = SSPOPPTR;
580             (*SSPOPDPTR)(ptr);
581             break;
582         case SAVEt_REGCONTEXT:
583             savestack_ix -= SSPOPINT;   /* regexp must have croaked */
584             break;
585         default:
586             croak("panic: leave_scope inconsistency");
587         }
588     }
589 }
590
591 #ifdef DEBUGGING
592 void
593 cx_dump(cx)
594 CONTEXT* cx;
595 {
596     fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
597     if (cx->cx_type != CXt_SUBST) {
598         fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
599         fprintf(stderr, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
600         fprintf(stderr, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
601         fprintf(stderr, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
602         fprintf(stderr, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
603         fprintf(stderr, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
604         fprintf(stderr, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
605     }
606     switch (cx->cx_type) {
607     case CXt_NULL:
608     case CXt_BLOCK:
609         break;
610     case CXt_SUB:
611         fprintf(stderr, "BLK_SUB.CV = 0x%lx\n",
612                 (long)cx->blk_sub.cv);
613         fprintf(stderr, "BLK_SUB.GV = 0x%lx\n",
614                 (long)cx->blk_sub.gv);
615         fprintf(stderr, "BLK_SUB.DFOUTGV = 0x%lx\n",
616                 (long)cx->blk_sub.dfoutgv);
617         fprintf(stderr, "BLK_SUB.OLDDEPTH = %ld\n",
618                 (long)cx->blk_sub.olddepth);
619         fprintf(stderr, "BLK_SUB.HASARGS = %d\n",
620                 (int)cx->blk_sub.hasargs);
621         break;
622     case CXt_EVAL:
623         fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
624                 (long)cx->blk_eval.old_in_eval);
625         fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s\n",
626                 op_name[cx->blk_eval.old_op_type]);
627         fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n",
628                 cx->blk_eval.old_name);
629         fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
630                 (long)cx->blk_eval.old_eval_root);
631         break;
632
633     case CXt_LOOP:
634         fprintf(stderr, "BLK_LOOP.LABEL = %s\n",
635                 cx->blk_loop.label);
636         fprintf(stderr, "BLK_LOOP.RESETSP = %ld\n",
637                 (long)cx->blk_loop.resetsp);
638         fprintf(stderr, "BLK_LOOP.REDO_OP = 0x%lx\n",
639                 (long)cx->blk_loop.redo_op);
640         fprintf(stderr, "BLK_LOOP.NEXT_OP = 0x%lx\n",
641                 (long)cx->blk_loop.next_op);
642         fprintf(stderr, "BLK_LOOP.LAST_OP = 0x%lx\n",
643                 (long)cx->blk_loop.last_op);
644         fprintf(stderr, "BLK_LOOP.ITERIX = %ld\n",
645                 (long)cx->blk_loop.iterix);
646         fprintf(stderr, "BLK_LOOP.ITERARY = 0x%lx\n",
647                 (long)cx->blk_loop.iterary);
648         fprintf(stderr, "BLK_LOOP.ITERVAR = 0x%lx\n",
649                 (long)cx->blk_loop.itervar);
650         if (cx->blk_loop.itervar)
651             fprintf(stderr, "BLK_LOOP.ITERSAVE = 0x%lx\n",
652                 (long)cx->blk_loop.itersave);
653         break;
654
655     case CXt_SUBST:
656         fprintf(stderr, "SB_ITERS = %ld\n",
657                 (long)cx->sb_iters);
658         fprintf(stderr, "SB_MAXITERS = %ld\n",
659                 (long)cx->sb_maxiters);
660         fprintf(stderr, "SB_SAFEBASE = %ld\n",
661                 (long)cx->sb_safebase);
662         fprintf(stderr, "SB_ONCE = %ld\n",
663                 (long)cx->sb_once);
664         fprintf(stderr, "SB_ORIG = %s\n",
665                 cx->sb_orig);
666         fprintf(stderr, "SB_DSTR = 0x%lx\n",
667                 (long)cx->sb_dstr);
668         fprintf(stderr, "SB_TARG = 0x%lx\n",
669                 (long)cx->sb_targ);
670         fprintf(stderr, "SB_S = 0x%lx\n",
671                 (long)cx->sb_s);
672         fprintf(stderr, "SB_M = 0x%lx\n",
673                 (long)cx->sb_m);
674         fprintf(stderr, "SB_STREND = 0x%lx\n",
675                 (long)cx->sb_strend);
676         fprintf(stderr, "SB_SUBBASE = 0x%lx\n",
677                 (long)cx->sb_subbase);
678         break;
679     }
680 }
681 #endif