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