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] / gv.c
CommitLineData
79072805
LW
1/* $RCSfile: gv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:39 $
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: gv.c,v $
9 * Revision 4.1 92/08/07 18:26:39 lwall
10 *
11 * Revision 4.0.1.4 92/06/08 15:32:19 lwall
12 * patch20: fixed confusion between a *var's real name and its effective name
13 * patch20: the debugger now warns you on lines that can't set a breakpoint
14 * patch20: the debugger made perl forget the last pattern used by //
15 * patch20: paragraph mode now skips extra newlines automatically
16 * patch20: ($<,$>) = ... didn't work on some architectures
17 *
18 * Revision 4.0.1.3 91/11/05 18:35:33 lwall
19 * patch11: length($x) was sometimes wrong for numeric $x
20 * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
21 * patch11: *foo = undef coredumped
22 * patch11: solitary subroutine references no longer trigger typo warnings
23 * patch11: local(*FILEHANDLE) had a memory leak
24 *
25 * Revision 4.0.1.2 91/06/07 11:55:53 lwall
26 * patch4: new copyright notice
27 * patch4: added $^P variable to control calling of perldb routines
28 * patch4: added $^F variable to specify maximum system fd, default 2
29 * patch4: $` was busted inside s///
30 * patch4: default top-of-form run_format is now FILEHANDLE_TOP
31 * patch4: length($`), length($&), length($') now optimized to avoid string copy
32 * patch4: $^D |= 1024 now does syntax tree dump at run-time
33 *
34 * Revision 4.0.1.1 91/04/12 09:10:24 lwall
35 * patch1: Configure now differentiates getgroups() type from getgid() type
36 * patch1: you may now use "die" and "caller" in a signal handler
37 *
38 * Revision 4.0 91/03/20 01:39:41 lwall
39 * 4.0 baseline.
40 *
41 */
42
43#include "EXTERN.h"
44#include "perl.h"
45
93a17b20
LW
46extern char* rcsid;
47
79072805
LW
48GV *
49gv_AVadd(gv)
50register GV *gv;
51{
52 if (!GvAV(gv))
53 GvAV(gv) = newAV();
54 return gv;
55}
56
57GV *
58gv_HVadd(gv)
59register GV *gv;
60{
61 if (!GvHV(gv))
62 GvHV(gv) = newHV(COEFFSIZE);
63 return gv;
64}
65
66GV *
67gv_fetchfile(name)
68char *name;
69{
70 char tmpbuf[1200];
71 GV *gv;
72
73 sprintf(tmpbuf,"'_<%s", name);
74 gv = gv_fetchpv(tmpbuf, TRUE);
75 sv_setpv(GvSV(gv), name);
76 if (perldb)
93a17b20 77 hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
79072805
LW
78 return gv;
79}
80
81GV *
82gv_fetchmethod(stash, name)
83HV* stash;
84char* name;
85{
86 AV* av;
87 GV* gv;
88 GV** gvp = (GV**)hv_fetch(stash,name,strlen(name),FALSE);
89 if (gvp && (gv = *gvp) != (GV*)&sv_undef && GvCV(gv))
90 return gv;
91
92 gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
93 if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
94 SV** svp = AvARRAY(av);
95 I32 items = AvFILL(av) + 1;
96 while (items--) {
97 char tmpbuf[512];
98 SV* sv = *svp++;
99 *tmpbuf = '_';
100 SvUPGRADE(sv, SVt_PV);
101 strcpy(tmpbuf+1,SvPVn(sv));
102 gv = gv_fetchpv(tmpbuf,FALSE);
103 if (!gv || !(stash = GvHV(gv))) {
104 if (dowarn)
105 warn("Can't locate package %s for @%s'ISA",
106 SvPV(sv), HvNAME(stash));
107 continue;
108 }
109 gv = gv_fetchmethod(stash, name);
110 if (gv)
111 return gv;
112 }
113 }
114 return 0;
115}
116
117GV *
118gv_fetchpv(name,add)
119register char *name;
120I32 add;
121{
122 register GV *gv;
123 GV**gvp;
124 register GP *gp;
125 I32 len;
126 register char *namend;
127 HV *stash;
128 char *sawquote = Nullch;
129 char *prevquote = Nullch;
130 bool global = FALSE;
131
132 if (isUPPER(*name)) {
133 if (*name > 'I') {
134 if (*name == 'S' && (
135 strEQ(name, "SIG") ||
136 strEQ(name, "STDIN") ||
137 strEQ(name, "STDOUT") ||
138 strEQ(name, "STDERR") ))
139 global = TRUE;
140 }
141 else if (*name > 'E') {
142 if (*name == 'I' && strEQ(name, "INC"))
143 global = TRUE;
144 }
145 else if (*name > 'A') {
146 if (*name == 'E' && strEQ(name, "ENV"))
147 global = TRUE;
148 }
149 else if (*name == 'A' && (
150 strEQ(name, "ARGV") ||
151 strEQ(name, "ARGVOUT") ))
152 global = TRUE;
153 }
154 for (namend = name; *namend; namend++) {
155 if (*namend == '\'' && namend[1])
156 prevquote = sawquote, sawquote = namend;
157 }
158 if (sawquote == name && name[1]) {
159 stash = defstash;
160 sawquote = Nullch;
161 name++;
162 }
163 else if (!isALPHA(*name) || global)
164 stash = defstash;
165 else if ((COP*)curcop == &compiling)
166 stash = curstash;
167 else
168 stash = curcop->cop_stash;
169 if (sawquote) {
170 char tmpbuf[256];
171 char *s, *d;
172
173 *sawquote = '\0';
174 /*SUPPRESS 560*/
175 if (s = prevquote) {
176 strncpy(tmpbuf,name,s-name+1);
177 d = tmpbuf+(s-name+1);
178 *d++ = '_';
179 strcpy(d,s+1);
180 }
181 else {
182 *tmpbuf = '_';
183 strcpy(tmpbuf+1,name);
184 }
185 gv = gv_fetchpv(tmpbuf,TRUE);
186 if (!(stash = GvHV(gv)))
187 stash = GvHV(gv) = newHV(0);
188 if (!HvNAME(stash))
189 HvNAME(stash) = savestr(name);
190 name = sawquote+1;
191 *sawquote = '\'';
192 }
93a17b20
LW
193 if (!stash)
194 fatal("Global symbol \"%s\" requires explicit package name", name);
79072805
LW
195 len = namend - name;
196 gvp = (GV**)hv_fetch(stash,name,len,add);
197 if (!gvp || *gvp == (GV*)&sv_undef)
198 return Nullgv;
199 gv = *gvp;
200 if (SvTYPE(gv) == SVt_PVGV) {
201 SvMULTI_on(gv);
202 return gv;
203 }
93a17b20
LW
204
205 /* Adding a new symbol */
206
207 sv_upgrade(gv, SVt_PVGV);
208 if (SvLEN(gv))
209 Safefree(SvPV(gv));
210 Newz(602,gp, 1, GP);
211 GvGP(gv) = gp;
212 GvREFCNT(gv) = 1;
213 GvSV(gv) = NEWSV(72,0);
214 GvLINE(gv) = curcop->cop_line;
215 GvEGV(gv) = gv;
216 sv_magic((SV*)gv, (SV*)gv, '*', name, len);
217 GvSTASH(gv) = stash;
218 GvNAME(gv) = nsavestr(name, len);
219 GvNAMELEN(gv) = len;
220 if (isDIGIT(*name) && *name != '0')
221 sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
222 if (add & 2)
223 SvMULTI_on(gv);
224
225 /* set up magic where warranted */
226 switch (*name) {
227 case 'S':
228 if (strEQ(name, "SIG")) {
229 HV *hv;
230 siggv = gv;
231 SvMULTI_on(siggv);
232 hv = GvHVn(siggv);
233 hv_magic(hv, siggv, 'S');
234
235 /* initialize signal stack */
236 signalstack = newAV();
237 av_store(signalstack, 32, Nullsv);
238 av_clear(signalstack);
239 AvREAL_off(signalstack);
240 }
241 break;
242
243 case '&':
244 ampergv = gv;
245 sawampersand = TRUE;
246 goto magicalize;
247
248 case '`':
249 leftgv = gv;
250 sawampersand = TRUE;
251 goto magicalize;
252
253 case '\'':
254 rightgv = gv;
255 sawampersand = TRUE;
256 goto magicalize;
257
258 case ':':
259 sv_setpv(GvSV(gv),chopset);
260 goto magicalize;
261
262 case '!':
263 case '#':
264 case '?':
265 case '^':
266 case '~':
267 case '=':
268 case '-':
269 case '%':
270 case '.':
271 case '+':
272 case '*':
273 case '(':
274 case ')':
275 case '<':
276 case '>':
277 case ',':
278 case '\\':
279 case '/':
280 case '[':
281 case '|':
282 case '\004':
283 case '\t':
284 case '\020':
285 case '\024':
286 case '\027':
287 case '\006':
288 magicalize:
289 sv_magic(GvSV(gv), (SV*)gv, 0, name, 1);
290 break;
291
292 case '\014':
293 sv_setpv(GvSV(gv),"\f");
294 formfeed = GvSV(gv);
295 break;
296 case ';':
297 sv_setpv(GvSV(gv),"\034");
298 break;
299 case ']': {
300 SV *sv;
301 sv = GvSV(gv);
302 sv_upgrade(sv, SVt_PVNV);
303 sv_setpv(sv,rcsid);
304 SvNV(sv) = atof(patchlevel);
305 SvNOK_on(sv);
306 }
307 break;
79072805 308 }
93a17b20 309 return gv;
79072805
LW
310}
311
312void
313gv_fullname(sv,gv)
314SV *sv;
315GV *gv;
316{
317 HV *hv = GvSTASH(gv);
318
319 if (!hv)
320 return;
321 sv_setpv(sv, sv == (SV*)gv ? "*" : "");
322 sv_catpv(sv,HvNAME(hv));
323 sv_catpvn(sv,"'", 1);
324 sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
325}
326
327void
328gv_efullname(sv,gv)
329SV *sv;
330GV *gv;
331{
332 GV* egv = GvEGV(gv);
333 HV *hv = GvSTASH(egv);
334
335 if (!hv)
336 return;
337 sv_setpv(sv, sv == (SV*)gv ? "*" : "");
338 sv_catpv(sv,HvNAME(hv));
339 sv_catpvn(sv,"'", 1);
340 sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
341}
342
343IO *
344newIO()
345{
346 IO *io;
347
348 Newz(603,io,1,IO);
349 io->page_len = 60;
350 return io;
351}
352
353void
354gv_check(min,max)
355I32 min;
356register I32 max;
357{
358 register HE *entry;
359 register I32 i;
360 register GV *gv;
361
362 for (i = min; i <= max; i++) {
363 for (entry = HvARRAY(defstash)[i]; entry; entry = entry->hent_next) {
364 gv = (GV*)entry->hent_val;
365 if (SvMULTI(gv))
366 continue;
367 curcop->cop_line = GvLINE(gv);
368 warn("Possible typo: \"%s\"", GvNAME(gv));
369 }
370 }
371}
372
373GV *
374newGVgen()
375{
376 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
377 return gv_fetchpv(tokenbuf,TRUE);
378}
379
380/* hopefully this is only called on local symbol table entries */
381
382GP*
383gp_ref(gp)
384GP* gp;
385{
386 gp->gp_refcnt++;
387 return gp;
388
389}
390
391void
392gp_free(gv)
393GV* gv;
394{
395 IO *io;
396 CV *cv;
397 GP* gp;
398
399 if (!gv || !(gp = GvGP(gv)))
400 return;
401 if (gp->gp_refcnt == 0) {
402 warn("Attempt to free unreferenced glob pointers");
403 return;
404 }
405 if (--gp->gp_refcnt > 0)
406 return;
407
408 sv_free(gp->gp_sv);
409 sv_free(gp->gp_av);
410 sv_free(gp->gp_hv);
411 if (io = gp->gp_io) {
412 do_close(gv,FALSE);
413 Safefree(io->top_name);
414 Safefree(io->fmt_name);
415 Safefree(io);
416 }
417 if (cv = gp->gp_cv)
418 sv_free(cv);
419 Safefree(gp);
420 GvGP(gv) = 0;
421}
422
423#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
424#define MICROPORT
425#endif
426
427#ifdef MICROPORT /* Microport 2.4 hack */
428AV *GvAVn(gv)
429register GV *gv;
430{
431 if (GvGP(gv)->gp_av)
432 return GvGP(gv)->gp_av;
433 else
434 return GvGP(gv_AVadd(gv))->gp_av;
435}
436
437HV *GvHVn(gv)
438register GV *gv;
439{
440 if (GvGP(gv)->gp_hv)
441 return GvGP(gv)->gp_hv;
442 else
443 return GvGP(gv_HVadd(gv))->gp_hv;
444}
445#endif /* Microport 2.4 hack */
446
447GV *
448fetch_gv(op,num)
449OP *op;
450I32 num;
451{
452 if (op->op_private < num)
453 return 0;
454 if (op->op_flags & OPf_STACKED)
455 return gv_fetchpv(SvPVnx(*(stack_sp--)),TRUE);
456 else
457 return cGVOP->op_gv;
458}
459
460IO *
461fetch_io(op,num)
462OP *op;
463I32 num;
464{
465 GV *gv;
466
467 if (op->op_private < num)
468 return 0;
469 if (op->op_flags & OPf_STACKED)
470 gv = gv_fetchpv(SvPVnx(*(stack_sp--)),TRUE);
471 else
472 gv = cGVOP->op_gv;
473
474 if (!gv)
475 return 0;
476
477 return GvIOn(gv);
478}