perl 5.0 alpha 6
[perl.git] / scope.c
1 /* $RCSfile: op.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:16 $
2  *
3  *    Copyright (c) 1991, 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  * $Log:        op.c,v $
9  */
10
11 #include "EXTERN.h"
12 #include "perl.h"
13
14 I32
15 cxinc()
16 {
17     cxstack_max = cxstack_max * 3 / 2;
18     Renew(cxstack, cxstack_max, CONTEXT);
19     return cxstack_ix + 1;
20 }
21
22 void
23 push_return(retop)
24 OP *retop;
25 {
26     if (retstack_ix == retstack_max) {
27         retstack_max = retstack_max * 3 / 2;
28         Renew(retstack, retstack_max, OP*);
29     }
30     retstack[retstack_ix++] = retop;
31 }
32
33 OP *
34 pop_return()
35 {
36     if (retstack_ix > 0)
37         return retstack[--retstack_ix];
38     else
39         return Nullop;
40 }
41
42 void
43 push_scope()
44 {
45     if (scopestack_ix == scopestack_max) {
46         scopestack_max = scopestack_max * 3 / 2;
47         Renew(scopestack, scopestack_max, I32);
48     }
49     scopestack[scopestack_ix++] = savestack_ix;
50
51 }
52
53 void
54 pop_scope()
55 {
56     I32 oldsave = scopestack[--scopestack_ix];
57     LEAVE_SCOPE(oldsave);
58 }
59
60 void
61 savestack_grow()
62 {
63     savestack_max = savestack_max * 3 / 2;
64     Renew(savestack, savestack_max, ANY);
65 }
66
67 void
68 free_tmps()
69 {
70     /* XXX should tmps_floor live in cxstack? */
71     I32 myfloor = tmps_floor;
72     while (tmps_ix > myfloor) {      /* clean up after last statement */
73         SV* sv = tmps_stack[tmps_ix];
74         tmps_stack[tmps_ix--] = Nullsv;
75         if (sv) {
76 #ifdef DEBUGGING
77             SvTEMP_off(sv);
78 #endif
79             SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
80         }
81     }
82 }
83
84 SV *
85 save_scalar(gv)
86 GV *gv;
87 {
88     register SV *sv;
89     SV *osv = GvSV(gv);
90
91     SSCHECK(3);
92     SSPUSHPTR(gv);
93     SSPUSHPTR(osv);
94     SSPUSHINT(SAVEt_SV);
95
96     sv = GvSV(gv) = NEWSV(0,0);
97     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv)) {
98         sv_upgrade(sv, SvTYPE(osv));
99         SvMAGIC(sv) = SvMAGIC(osv);
100         localizing = TRUE;
101         SvSETMAGIC(sv);
102         localizing = FALSE;
103     }
104     return sv;
105 }
106
107 #ifdef INLINED_ELSEWHERE
108 void
109 save_gp(gv)
110 GV *gv;
111 {
112     register GP *gp;
113     GP *ogp = GvGP(gv);
114
115     SSCHECK(3);
116     SSPUSHPTR(gv);
117     SSPUSHPTR(ogp);
118     SSPUSHINT(SAVEt_GP);
119
120     Newz(602,gp, 1, GP);
121     GvGP(gv) = gp;
122     GvREFCNT(gv) = 1;
123     GvSV(gv) = NEWSV(72,0);
124     GvLINE(gv) = curcop->cop_line;
125     GvEGV(gv) = gv;
126 }
127 #endif
128
129 SV*
130 save_svref(sptr)
131 SV **sptr;
132 {
133     register SV *sv;
134     SV *osv = *sptr;
135
136     SSCHECK(3);
137     SSPUSHPTR(*sptr);
138     SSPUSHPTR(sptr);
139     SSPUSHINT(SAVEt_SVREF);
140
141     sv = *sptr = NEWSV(0,0);
142     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(sv)) {
143         sv_upgrade(sv, SvTYPE(osv));
144         SvMAGIC(sv) = SvMAGIC(osv);
145         localizing = TRUE;
146         SvSETMAGIC(sv);
147         localizing = FALSE;
148     }
149     return sv;
150 }
151
152 AV *
153 save_ary(gv)
154 GV *gv;
155 {
156     SSCHECK(3);
157     SSPUSHPTR(gv);
158     SSPUSHPTR(GvAVn(gv));
159     SSPUSHINT(SAVEt_AV);
160
161     GvAV(gv) = Null(AV*);
162     return GvAVn(gv);
163 }
164
165 HV *
166 save_hash(gv)
167 GV *gv;
168 {
169     SSCHECK(3);
170     SSPUSHPTR(gv);
171     SSPUSHPTR(GvHVn(gv));
172     SSPUSHINT(SAVEt_HV);
173
174     GvHV(gv) = Null(HV*);
175     return GvHVn(gv);
176 }
177
178 void
179 save_item(item)
180 register SV *item;
181 {
182     register SV *sv;
183
184     SSCHECK(3);
185     SSPUSHPTR(item);            /* remember the pointer */
186     sv = NEWSV(0,0);
187     sv_setsv(sv,item);
188     SSPUSHPTR(sv);              /* remember the value */
189     SSPUSHINT(SAVEt_ITEM);
190 }
191
192 void
193 save_int(intp)
194 int *intp;
195 {
196     SSCHECK(3);
197     SSPUSHINT(*intp);
198     SSPUSHPTR(intp);
199     SSPUSHINT(SAVEt_INT);
200 }
201
202 void
203 save_I32(intp)
204 I32 *intp;
205 {
206     SSCHECK(3);
207     SSPUSHINT(*intp);
208     SSPUSHPTR(intp);
209     SSPUSHINT(SAVEt_I32);
210 }
211
212 void
213 save_sptr(sptr)
214 SV **sptr;
215 {
216     SSCHECK(3);
217     SSPUSHPTR(*sptr);
218     SSPUSHPTR(sptr);
219     SSPUSHINT(SAVEt_SPTR);
220 }
221
222 void
223 save_nogv(gv)
224 GV *gv;
225 {
226     SSCHECK(2);
227     SSPUSHPTR(gv);
228     SSPUSHINT(SAVEt_NSTAB);
229 }
230
231 void
232 save_hptr(hptr)
233 HV **hptr;
234 {
235     SSCHECK(3);
236     SSPUSHINT(*hptr);
237     SSPUSHPTR(hptr);
238     SSPUSHINT(SAVEt_HPTR);
239 }
240
241 void
242 save_aptr(aptr)
243 AV **aptr;
244 {
245     SSCHECK(3);
246     SSPUSHINT(*aptr);
247     SSPUSHPTR(aptr);
248     SSPUSHINT(SAVEt_APTR);
249 }
250
251 void
252 save_freesv(sv)
253 SV *sv;
254 {
255     SSCHECK(2);
256     SSPUSHPTR(sv);
257     SSPUSHINT(SAVEt_FREESV);
258 }
259
260 void
261 save_freeop(op)
262 OP *op;
263 {
264     SSCHECK(2);
265     SSPUSHPTR(op);
266     SSPUSHINT(SAVEt_FREEOP);
267 }
268
269 void
270 save_freepv(pv)
271 char *pv;
272 {
273     SSCHECK(2);
274     SSPUSHPTR(pv);
275     SSPUSHINT(SAVEt_FREEPV);
276 }
277
278 void
279 save_clearsv(svp)
280 SV** svp;
281 {
282     SSCHECK(2);
283     SSPUSHPTR(svp);
284     SSPUSHINT(SAVEt_CLEARSV);
285 }
286
287 void
288 save_delete(hv,key,klen)
289 HV *hv;
290 char *key;
291 I32 klen;
292 {
293     SSCHECK(4);
294     SSPUSHINT(klen);
295     SSPUSHPTR(key);
296     SSPUSHPTR(hv);
297     SSPUSHINT(SAVEt_DELETE);
298 }
299
300 void
301 save_list(sarg,maxsarg)
302 register SV **sarg;
303 I32 maxsarg;
304 {
305     register SV *sv;
306     register I32 i;
307
308     SSCHECK(3 * maxsarg);
309     for (i = 1; i <= maxsarg; i++) {
310         SSPUSHPTR(sarg[i]);             /* remember the pointer */
311         sv = NEWSV(0,0);
312         sv_setsv(sv,sarg[i]);
313         SSPUSHPTR(sv);                  /* remember the value */
314         SSPUSHINT(SAVEt_ITEM);
315     }
316 }
317
318 void
319 leave_scope(base)
320 I32 base;
321 {
322     register SV *sv;
323     register SV *value;
324     register GV *gv;
325     register AV *av;
326     register HV *hv;
327     register void* ptr;
328
329     if (base < -1)
330         croak("panic: corrupt saved stack index");
331     while (savestack_ix > base) {
332         switch (SSPOPINT) {
333         case SAVEt_ITEM:                        /* normal string */
334             value = (SV*)SSPOPPTR;
335             sv = (SV*)SSPOPPTR;
336             sv_replace(sv,value);
337             SvSETMAGIC(sv);
338             break;
339         case SAVEt_SV:                          /* scalar reference */
340             value = (SV*)SSPOPPTR;
341             gv = (GV*)SSPOPPTR;
342             sv = GvSV(gv);
343             if (SvTYPE(sv) >= SVt_PVMG)
344                 SvMAGIC(sv) = 0;
345             SvREFCNT_dec(sv);
346             GvSV(gv) = sv = value;
347             SvSETMAGIC(sv);
348             break;
349         case SAVEt_SVREF:                       /* scalar reference */
350             ptr = SSPOPPTR;
351             sv = *(SV**)ptr;
352             if (SvTYPE(sv) >= SVt_PVMG)
353                 SvMAGIC(sv) = 0;
354             SvREFCNT_dec(sv);
355             *(SV**)ptr = sv = (SV*)SSPOPPTR;
356             SvSETMAGIC(sv);
357             break;
358         case SAVEt_AV:                          /* array reference */
359             av = (AV*)SSPOPPTR;
360             gv = (GV*)SSPOPPTR;
361             SvREFCNT_dec(GvAV(gv));
362             GvAV(gv) = av;
363             break;
364         case SAVEt_HV:                          /* hash reference */
365             hv = (HV*)SSPOPPTR;
366             gv = (GV*)SSPOPPTR;
367             SvREFCNT_dec(GvHV(gv));
368             GvHV(gv) = hv;
369             break;
370         case SAVEt_INT:                         /* int reference */
371             ptr = SSPOPPTR;
372             *(int*)ptr = (int)SSPOPINT;
373             break;
374         case SAVEt_I32:                         /* I32 reference */
375             ptr = SSPOPPTR;
376             *(I32*)ptr = (I32)SSPOPINT;
377             break;
378         case SAVEt_SPTR:                        /* SV* reference */
379             ptr = SSPOPPTR;
380             *(SV**)ptr = (SV*)SSPOPPTR;
381             break;
382         case SAVEt_HPTR:                        /* HV* reference */
383             ptr = SSPOPPTR;
384             *(HV**)ptr = (HV*)SSPOPPTR;
385             break;
386         case SAVEt_APTR:                        /* AV* reference */
387             ptr = SSPOPPTR;
388             *(AV**)ptr = (AV*)SSPOPPTR;
389             break;
390         case SAVEt_NSTAB:
391             gv = (GV*)SSPOPPTR;
392             (void)sv_clear(gv);
393             break;
394         case SAVEt_GP:                          /* scalar reference */
395             ptr = SSPOPPTR;
396             gv = (GV*)SSPOPPTR;
397             gp_free(gv);
398             GvGP(gv) = (GP*)ptr;
399             break;
400         case SAVEt_FREESV:
401             ptr = SSPOPPTR;
402             SvREFCNT_dec((SV*)ptr);
403             break;
404         case SAVEt_FREEOP:
405             ptr = SSPOPPTR;
406             curpad = AvARRAY(comppad);
407             op_free((OP*)ptr);
408             break;
409         case SAVEt_FREEPV:
410             ptr = SSPOPPTR;
411             Safefree((char*)ptr);
412             break;
413         case SAVEt_CLEARSV:
414             ptr = SSPOPPTR;
415             sv = *(SV**)ptr;
416             if (SvREFCNT(sv) <= 1) {    /* Can clear pad variable in place. */
417                 if (SvTHINKFIRST(sv)) {
418                     if (SvREADONLY(sv))
419                         croak("panic: leave_scope clearsv");
420                     if (SvROK(sv))
421                         sv_unref(sv);
422                 }
423
424                 switch (SvTYPE(sv)) {
425                 case SVt_NULL:
426                     break;
427                 case SVt_PVAV:
428                     av_clear((AV*)sv);
429                     break;
430                 case SVt_PVHV:
431                     hv_clear((HV*)sv);
432                     break;
433                 case SVt_PVCV:
434                     sub_generation++;
435                     cv_clear((CV*)sv);
436                     break;
437                 default:
438                     if (SvPOK(sv) && SvLEN(sv))
439                         SvOOK_off(sv);
440                     SvOK_off(sv);
441                     SvSETMAGIC(sv);
442                     break;
443                 }
444             }
445             else {      /* Someone has a claim on this, so abandon it. */
446                 SvREFCNT_dec(sv);       /* Cast current value to the winds. */
447                 switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
448                 case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
449                 case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
450                 default:        *(SV**)ptr = NEWSV(0,0);        break;
451                 }
452             }
453             break;
454         case SAVEt_DELETE:
455             ptr = SSPOPPTR;
456             hv = (HV*)ptr;
457             ptr = SSPOPPTR;
458             hv_delete(hv, (char*)ptr, (U32)SSPOPINT);
459             break;
460         default:
461             croak("panic: leave_scope inconsistency");
462         }
463     }
464 }
465
466 #ifdef DEBUGGING
467 void
468 cx_dump(cx)
469 CONTEXT* cx;
470 {
471     fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
472     if (cx->cx_type != CXt_SUBST) {
473         fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
474         fprintf(stderr, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
475         fprintf(stderr, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
476         fprintf(stderr, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
477         fprintf(stderr, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
478         fprintf(stderr, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
479         fprintf(stderr, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
480     }
481     switch (cx->cx_type) {
482     case CXt_NULL:
483     case CXt_BLOCK:
484         break;
485     case CXt_SUB:
486         fprintf(stderr, "BLK_SUB.CV = 0x%lx\n",
487                 (long)cx->blk_sub.cv);
488         fprintf(stderr, "BLK_SUB.GV = 0x%lx\n",
489                 (long)cx->blk_sub.gv);
490         fprintf(stderr, "BLK_SUB.DFOUTGV = 0x%lx\n",
491                 (long)cx->blk_sub.dfoutgv);
492         fprintf(stderr, "BLK_SUB.OLDDEPTH = %ld\n",
493                 (long)cx->blk_sub.olddepth);
494         fprintf(stderr, "BLK_SUB.HASARGS = %d\n",
495                 (int)cx->blk_sub.hasargs);
496         break;
497     case CXt_EVAL:
498         fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
499                 (long)cx->blk_eval.old_in_eval);
500         fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s\n",
501                 op_name[cx->blk_eval.old_op_type]);
502         fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n",
503                 cx->blk_eval.old_name);
504         fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
505                 (long)cx->blk_eval.old_eval_root);
506         break;
507
508     case CXt_LOOP:
509         fprintf(stderr, "BLK_LOOP.LABEL = %s\n",
510                 cx->blk_loop.label);
511         fprintf(stderr, "BLK_LOOP.RESETSP = %ld\n",
512                 (long)cx->blk_loop.resetsp);
513         fprintf(stderr, "BLK_LOOP.REDO_OP = 0x%lx\n",
514                 (long)cx->blk_loop.redo_op);
515         fprintf(stderr, "BLK_LOOP.NEXT_OP = 0x%lx\n",
516                 (long)cx->blk_loop.next_op);
517         fprintf(stderr, "BLK_LOOP.LAST_OP = 0x%lx\n",
518                 (long)cx->blk_loop.last_op);
519         fprintf(stderr, "BLK_LOOP.ITERIX = %ld\n",
520                 (long)cx->blk_loop.iterix);
521         fprintf(stderr, "BLK_LOOP.ITERARY = 0x%lx\n",
522                 (long)cx->blk_loop.iterary);
523         fprintf(stderr, "BLK_LOOP.ITERVAR = 0x%lx\n",
524                 (long)cx->blk_loop.itervar);
525         if (cx->blk_loop.itervar)
526             fprintf(stderr, "BLK_LOOP.ITERSAVE = 0x%lx\n",
527                 (long)cx->blk_loop.itersave);
528         break;
529
530     case CXt_SUBST:
531         fprintf(stderr, "SB_ITERS = %ld\n",
532                 (long)cx->sb_iters);
533         fprintf(stderr, "SB_MAXITERS = %ld\n",
534                 (long)cx->sb_maxiters);
535         fprintf(stderr, "SB_SAFEBASE = %ld\n",
536                 (long)cx->sb_safebase);
537         fprintf(stderr, "SB_ONCE = %ld\n",
538                 (long)cx->sb_once);
539         fprintf(stderr, "SB_ORIG = %s\n",
540                 cx->sb_orig);
541         fprintf(stderr, "SB_DSTR = 0x%lx\n",
542                 (long)cx->sb_dstr);
543         fprintf(stderr, "SB_TARG = 0x%lx\n",
544                 (long)cx->sb_targ);
545         fprintf(stderr, "SB_S = 0x%lx\n",
546                 (long)cx->sb_s);
547         fprintf(stderr, "SB_M = 0x%lx\n",
548                 (long)cx->sb_m);
549         fprintf(stderr, "SB_STREND = 0x%lx\n",
550                 (long)cx->sb_strend);
551         fprintf(stderr, "SB_SUBBASE = 0x%lx\n",
552                 (long)cx->sb_subbase);
553         break;
554     }
555 }
556 #endif