This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 3
[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];
57 if (savestack_ix > oldsave)
58 leave_scope(oldsave);
59}
60
61void
62savestack_grow()
63{
64 savestack_max = savestack_max * 3 / 2;
65 Renew(savestack, savestack_max, ANY);
66}
67
68void
69free_tmps()
70{
71 /* XXX should tmps_floor live in cxstack? */
72 I32 myfloor = tmps_floor;
73 while (tmps_ix > myfloor) { /* clean up after last statement */
74 SV* sv = tmps_stack[tmps_ix];
75 tmps_stack[tmps_ix--] = Nullsv;
76 if (sv)
77 sv_free(sv); /* note, can modify tmps_ix!!! */
78 }
79}
80
81SV *
82save_scalar(gv)
83GV *gv;
84{
85 register SV *sv;
86 SV *osv = GvSV(gv);
87
88 SSCHECK(3);
89 SSPUSHPTR(gv);
90 SSPUSHPTR(osv);
91 SSPUSHINT(SAVEt_SV);
92
93 sv = GvSV(gv) = NEWSV(0,0);
93a17b20 94 if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv)) {
79072805
LW
95 sv_upgrade(sv, SvTYPE(osv));
96 SvMAGIC(sv) = SvMAGIC(osv);
97 localizing = TRUE;
98 SvSETMAGIC(sv);
99 localizing = FALSE;
100 }
101 return sv;
102}
103
104#ifdef INLINED_ELSEWHERE
105void
106save_gp(gv)
107GV *gv;
108{
109 register GP *gp;
110 GP *ogp = GvGP(gv);
111
112 SSCHECK(3);
113 SSPUSHPTR(gv);
114 SSPUSHPTR(ogp);
115 SSPUSHINT(SAVEt_GP);
116
117 Newz(602,gp, 1, GP);
118 GvGP(gv) = gp;
119 GvREFCNT(gv) = 1;
120 GvSV(gv) = NEWSV(72,0);
121 GvLINE(gv) = curcop->cop_line;
122 GvEGV(gv) = gv;
123}
124#endif
125
126SV*
127save_svref(sptr)
128SV **sptr;
129{
130 register SV *sv;
131 SV *osv = *sptr;
132
133 SSCHECK(3);
134 SSPUSHPTR(*sptr);
135 SSPUSHPTR(sptr);
136 SSPUSHINT(SAVEt_SVREF);
137
138 sv = *sptr = NEWSV(0,0);
139 if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(sv)) {
140 sv_upgrade(sv, SvTYPE(osv));
141 SvMAGIC(sv) = SvMAGIC(osv);
142 localizing = TRUE;
143 SvSETMAGIC(sv);
144 localizing = FALSE;
145 }
146 return sv;
147}
148
149AV *
150save_ary(gv)
151GV *gv;
152{
153 SSCHECK(3);
154 SSPUSHPTR(gv);
155 SSPUSHPTR(GvAVn(gv));
156 SSPUSHINT(SAVEt_AV);
157
158 GvAV(gv) = Null(AV*);
159 return GvAVn(gv);
160}
161
162HV *
163save_hash(gv)
164GV *gv;
165{
166 SSCHECK(3);
167 SSPUSHPTR(gv);
168 SSPUSHPTR(GvHVn(gv));
169 SSPUSHINT(SAVEt_HV);
170
171 GvHV(gv) = Null(HV*);
172 return GvHVn(gv);
173}
174
175void
176save_item(item)
177register SV *item;
178{
179 register SV *sv;
180
181 SSCHECK(3);
182 SSPUSHPTR(item); /* remember the pointer */
183 sv = NEWSV(0,0);
184 sv_setsv(sv,item);
185 SSPUSHPTR(sv); /* remember the value */
186 SSPUSHINT(SAVEt_ITEM);
187}
188
189void
190save_int(intp)
191int *intp;
192{
193 SSCHECK(3);
194 SSPUSHINT(*intp);
195 SSPUSHPTR(intp);
196 SSPUSHINT(SAVEt_INT);
197}
198
199void
200save_I32(intp)
201I32 *intp;
202{
203 SSCHECK(3);
204 SSPUSHINT(*intp);
205 SSPUSHPTR(intp);
206 SSPUSHINT(SAVEt_I32);
207}
208
209void
210save_sptr(sptr)
211SV **sptr;
212{
213 SSCHECK(3);
214 SSPUSHPTR(*sptr);
215 SSPUSHPTR(sptr);
216 SSPUSHINT(SAVEt_SPTR);
217}
218
219void
220save_nogv(gv)
221GV *gv;
222{
223 SSCHECK(2);
224 SSPUSHPTR(gv);
225 SSPUSHINT(SAVEt_NSTAB);
226}
227
228void
229save_hptr(hptr)
230HV **hptr;
231{
232 SSCHECK(3);
233 SSPUSHINT(*hptr);
234 SSPUSHPTR(hptr);
235 SSPUSHINT(SAVEt_HPTR);
236}
237
238void
239save_aptr(aptr)
240AV **aptr;
241{
242 SSCHECK(3);
243 SSPUSHINT(*aptr);
244 SSPUSHPTR(aptr);
245 SSPUSHINT(SAVEt_APTR);
246}
247
248void
249save_list(sarg,maxsarg)
250register SV **sarg;
251I32 maxsarg;
252{
253 register SV *sv;
254 register I32 i;
255
256 SSCHECK(3 * maxsarg);
257 for (i = 1; i <= maxsarg; i++) {
258 SSPUSHPTR(sarg[i]); /* remember the pointer */
259 sv = NEWSV(0,0);
260 sv_setsv(sv,sarg[i]);
261 SSPUSHPTR(sv); /* remember the value */
262 SSPUSHINT(SAVEt_ITEM);
263 }
264}
265
266void
267leave_scope(base)
268I32 base;
269{
270 register SV *sv;
271 register SV *value;
272 register GV *gv;
273 register AV *av;
274 register HV *hv;
275 register void* ptr;
276
277 if (base < -1)
278 fatal("panic: corrupt saved stack index");
279 while (savestack_ix > base) {
280 switch (SSPOPINT) {
281 case SAVEt_ITEM: /* normal string */
282 value = (SV*)SSPOPPTR;
283 sv = (SV*)SSPOPPTR;
284 sv_replace(sv,value);
285 SvSETMAGIC(sv);
286 break;
287 case SAVEt_SV: /* scalar reference */
288 value = (SV*)SSPOPPTR;
289 gv = (GV*)SSPOPPTR;
290 sv = GvSV(gv);
291 if (SvTYPE(sv) >= SVt_PVMG)
292 SvMAGIC(sv) = 0;
293 sv_free(sv);
294 GvSV(gv) = sv = value;
295 SvSETMAGIC(sv);
296 break;
297 case SAVEt_SVREF: /* scalar reference */
298 ptr = SSPOPPTR;
299 sv = *(SV**)ptr;
300 if (SvTYPE(sv) >= SVt_PVMG)
301 SvMAGIC(sv) = 0;
302 sv_free(sv);
303 *(SV**)ptr = sv = (SV*)SSPOPPTR;
304 SvSETMAGIC(sv);
305 break;
306 case SAVEt_AV: /* array reference */
307 av = (AV*)SSPOPPTR;
308 gv = (GV*)SSPOPPTR;
309 av_free(GvAV(gv));
310 GvAV(gv) = av;
311 break;
312 case SAVEt_HV: /* hash reference */
313 hv = (HV*)SSPOPPTR;
314 gv = (GV*)SSPOPPTR;
315 (void)hv_free(GvHV(gv), FALSE);
316 GvHV(gv) = hv;
317 break;
318 case SAVEt_INT: /* int reference */
319 ptr = SSPOPPTR;
320 *(int*)ptr = (int)SSPOPINT;
321 break;
322 case SAVEt_I32: /* I32 reference */
323 ptr = SSPOPPTR;
324 *(I32*)ptr = (I32)SSPOPINT;
325 break;
326 case SAVEt_SPTR: /* SV* reference */
327 ptr = SSPOPPTR;
328 *(SV**)ptr = (SV*)SSPOPPTR;
329 break;
330 case SAVEt_HPTR: /* HV* reference */
331 ptr = SSPOPPTR;
332 *(HV**)ptr = (HV*)SSPOPPTR;
333 break;
334 case SAVEt_APTR: /* AV* reference */
335 ptr = SSPOPPTR;
336 *(AV**)ptr = (AV*)SSPOPPTR;
337 break;
338 case SAVEt_NSTAB:
339 gv = (GV*)SSPOPPTR;
340 (void)sv_clear(gv);
341 break;
342 case SAVEt_GP: /* scalar reference */
343 ptr = SSPOPPTR;
344 gv = (GV*)SSPOPPTR;
345 gp_free(gv);
346 GvGP(gv) = (GP*)ptr;
347 break;
348 default:
349 fatal("panic: leave_scope inconsistency");
350 }
351 }
352}