This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 5
[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
463ee0b2 46extern char rcsid[];
93a17b20 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))
463ee0b2 62 GvHV(gv) = newHV();
79072805
LW
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
463ee0b2
LW
81void
82gv_init(gv, stash, name, len, multi)
83GV *gv;
84HV *stash;
85char *name;
86STRLEN len;
87int multi;
88{
89 register GP *gp;
90
91 sv_upgrade(gv, SVt_PVGV);
92 if (SvLEN(gv))
93 Safefree(SvPVX(gv));
94 Newz(602,gp, 1, GP);
95 GvGP(gv) = gp;
96 GvREFCNT(gv) = 1;
97 GvSV(gv) = NEWSV(72,0);
98 GvLINE(gv) = curcop->cop_line;
99 GvEGV(gv) = gv;
100 sv_magic((SV*)gv, (SV*)gv, '*', name, len);
101 GvSTASH(gv) = stash;
102 GvNAME(gv) = nsavestr(name, len);
103 GvNAMELEN(gv) = len;
104 if (multi)
105 SvMULTI_on(gv);
106}
107
79072805 108GV *
463ee0b2 109gv_fetchmeth(stash, name, len)
79072805
LW
110HV* stash;
111char* name;
463ee0b2 112STRLEN len;
79072805
LW
113{
114 AV* av;
463ee0b2 115 GV* topgv;
79072805 116 GV* gv;
463ee0b2
LW
117 GV** gvp;
118
119 gvp = (GV**)hv_fetch(stash, name, len, TRUE);
120
121 DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
122 topgv = *gvp;
123 if (SvTYPE(topgv) != SVt_PVGV)
124 gv_init(topgv, stash, name, len, TRUE);
125
126 if (GvCV(topgv)) {
127 if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
128 return topgv;
129 }
79072805
LW
130
131 gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
132 if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
133 SV** svp = AvARRAY(av);
134 I32 items = AvFILL(av) + 1;
135 while (items--) {
79072805 136 SV* sv = *svp++;
9bbf4081
LW
137 HV* basestash = fetch_stash(sv, FALSE);
138 if (!basestash) {
79072805
LW
139 if (dowarn)
140 warn("Can't locate package %s for @%s'ISA",
463ee0b2 141 SvPVX(sv), HvNAME(stash));
79072805
LW
142 continue;
143 }
9bbf4081 144 gv = gv_fetchmeth(basestash, name, len);
463ee0b2
LW
145 if (gv) {
146 GvCV(topgv) = GvCV(gv); /* cache the CV */
147 GvCVGEN(topgv) = sub_generation; /* valid for now */
79072805 148 return gv;
463ee0b2 149 }
79072805
LW
150 }
151 }
152 return 0;
153}
154
155GV *
463ee0b2
LW
156gv_fetchmethod(stash, name)
157HV* stash;
158char* name;
159{
160 register char *nend;
161
162 for (nend = name; *nend; nend++) {
163 if (*nend == ':' || *nend == '\'') {
164 return gv_fetchpv(name, FALSE);
165 }
166 }
167 return gv_fetchmeth(stash, name, nend - name);
168}
169
170GV *
171gv_fetchpv(nambeg,add)
172char *nambeg;
79072805
LW
173I32 add;
174{
463ee0b2
LW
175 register char *name = nambeg;
176 register GV *gv = 0;
79072805 177 GV**gvp;
79072805
LW
178 I32 len;
179 register char *namend;
463ee0b2 180 HV *stash = 0;
79072805 181 bool global = FALSE;
463ee0b2 182 char tmpbuf[256];
79072805 183
79072805 184 for (namend = name; *namend; namend++) {
463ee0b2
LW
185 if ((*namend == '\'' && namend[1]) ||
186 (*namend == ':' && namend[1] == ':'))
187 {
188 len = namend - name;
79072805 189 *tmpbuf = '_';
463ee0b2
LW
190 Copy(name, tmpbuf+1, len, char);
191 len++;
192 tmpbuf[len] = '\0';
193 if (!stash)
194 stash = defstash;
195
196 if (len > 1) {
197 gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
198 if (!gvp || *gvp == (GV*)&sv_undef)
199 return Nullgv;
200 gv = *gvp;
201 if (SvTYPE(gv) == SVt_PVGV)
202 SvMULTI_on(gv);
203 else
204 gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));
205 if (!(stash = GvHV(gv)))
206 stash = GvHV(gv) = newHV();
207 if (!HvNAME(stash))
208 HvNAME(stash) = nsavestr(nambeg, namend - nambeg);
209 }
210
211 if (*namend == ':')
212 namend++;
213 namend++;
214 name = namend;
215 if (!*name)
216 return gv ? gv : defgv;
79072805 217 }
79072805 218 }
463ee0b2
LW
219
220 /* No stash in name, so see how we can default */
221
222 if (!stash) {
223 if (isIDFIRST(*name)) {
224 if (isUPPER(*name)) {
225 if (*name > 'I') {
226 if (*name == 'S' && (
227 strEQ(name, "SIG") ||
228 strEQ(name, "STDIN") ||
229 strEQ(name, "STDOUT") ||
230 strEQ(name, "STDERR") ))
231 global = TRUE;
232 }
233 else if (*name > 'E') {
234 if (*name == 'I' && strEQ(name, "INC"))
235 global = TRUE;
236 }
237 else if (*name > 'A') {
238 if (*name == 'E' && strEQ(name, "ENV"))
239 global = TRUE;
240 }
241 else if (*name == 'A' && (
242 strEQ(name, "ARGV") ||
243 strEQ(name, "ARGVOUT") ))
244 global = TRUE;
245 }
246 else if (*name == '_' && !name[1])
247 global = TRUE;
248 if (global)
249 stash = defstash;
250 else if ((COP*)curcop == &compiling)
251 stash = curstash;
252 else
253 stash = curcop->cop_stash;
254 }
255 else
256 stash = defstash;
257 }
258
259 /* By this point we should have a stash and a name */
260
93a17b20 261 if (!stash)
463ee0b2 262 croak("Global symbol \"%s\" requires explicit package name", name);
79072805 263 len = namend - name;
463ee0b2
LW
264 if (!len)
265 len = 1;
79072805
LW
266 gvp = (GV**)hv_fetch(stash,name,len,add);
267 if (!gvp || *gvp == (GV*)&sv_undef)
268 return Nullgv;
269 gv = *gvp;
270 if (SvTYPE(gv) == SVt_PVGV) {
271 SvMULTI_on(gv);
272 return gv;
273 }
93a17b20
LW
274
275 /* Adding a new symbol */
276
463ee0b2 277 gv_init(gv, stash, name, len, add & 2);
93a17b20
LW
278
279 /* set up magic where warranted */
280 switch (*name) {
ed6116ce
LW
281 case 'a':
282 case 'b':
283 if (len == 1)
284 SvMULTI_on(gv);
285 break;
463ee0b2
LW
286 case 'I':
287 if (strEQ(name, "ISA")) {
288 AV* av = GvAVn(gv);
289 sv_magic((SV*)av, (SV*)gv, 'I', 0, 0);
290 }
291 break;
93a17b20
LW
292 case 'S':
293 if (strEQ(name, "SIG")) {
294 HV *hv;
295 siggv = gv;
296 SvMULTI_on(siggv);
297 hv = GvHVn(siggv);
298 hv_magic(hv, siggv, 'S');
299
300 /* initialize signal stack */
301 signalstack = newAV();
302 av_store(signalstack, 32, Nullsv);
303 av_clear(signalstack);
304 AvREAL_off(signalstack);
305 }
306 break;
307
308 case '&':
463ee0b2
LW
309 if (len > 1)
310 break;
93a17b20
LW
311 ampergv = gv;
312 sawampersand = TRUE;
313 goto magicalize;
314
315 case '`':
463ee0b2
LW
316 if (len > 1)
317 break;
93a17b20
LW
318 leftgv = gv;
319 sawampersand = TRUE;
320 goto magicalize;
321
322 case '\'':
463ee0b2
LW
323 if (len > 1)
324 break;
93a17b20
LW
325 rightgv = gv;
326 sawampersand = TRUE;
327 goto magicalize;
328
329 case ':':
463ee0b2
LW
330 if (len > 1)
331 break;
93a17b20
LW
332 sv_setpv(GvSV(gv),chopset);
333 goto magicalize;
334
335 case '!':
336 case '#':
337 case '?':
338 case '^':
339 case '~':
340 case '=':
341 case '-':
342 case '%':
343 case '.':
344 case '+':
345 case '*':
346 case '(':
347 case ')':
348 case '<':
349 case '>':
350 case ',':
351 case '\\':
352 case '/':
353 case '[':
354 case '|':
355 case '\004':
356 case '\t':
357 case '\020':
358 case '\024':
359 case '\027':
360 case '\006':
463ee0b2
LW
361 if (len > 1)
362 break;
363 goto magicalize;
364
365 case '1':
366 case '2':
367 case '3':
368 case '4':
369 case '5':
370 case '6':
371 case '7':
372 case '8':
373 case '9':
93a17b20 374 magicalize:
463ee0b2 375 sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
93a17b20
LW
376 break;
377
378 case '\014':
463ee0b2
LW
379 if (len > 1)
380 break;
93a17b20
LW
381 sv_setpv(GvSV(gv),"\f");
382 formfeed = GvSV(gv);
383 break;
384 case ';':
463ee0b2
LW
385 if (len > 1)
386 break;
93a17b20
LW
387 sv_setpv(GvSV(gv),"\034");
388 break;
463ee0b2
LW
389 case ']':
390 if (len == 1) {
93a17b20
LW
391 SV *sv;
392 sv = GvSV(gv);
393 sv_upgrade(sv, SVt_PVNV);
394 sv_setpv(sv,rcsid);
463ee0b2 395 SvNVX(sv) = atof(patchlevel);
93a17b20
LW
396 SvNOK_on(sv);
397 }
398 break;
79072805 399 }
93a17b20 400 return gv;
79072805
LW
401}
402
403void
404gv_fullname(sv,gv)
405SV *sv;
406GV *gv;
407{
408 HV *hv = GvSTASH(gv);
409
410 if (!hv)
411 return;
412 sv_setpv(sv, sv == (SV*)gv ? "*" : "");
413 sv_catpv(sv,HvNAME(hv));
463ee0b2 414 sv_catpvn(sv,"::", 2);
79072805
LW
415 sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
416}
417
418void
419gv_efullname(sv,gv)
420SV *sv;
421GV *gv;
422{
423 GV* egv = GvEGV(gv);
424 HV *hv = GvSTASH(egv);
425
426 if (!hv)
427 return;
428 sv_setpv(sv, sv == (SV*)gv ? "*" : "");
429 sv_catpv(sv,HvNAME(hv));
463ee0b2 430 sv_catpvn(sv,"::", 2);
79072805
LW
431 sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
432}
433
434IO *
435newIO()
436{
437 IO *io;
438
439 Newz(603,io,1,IO);
440 io->page_len = 60;
441 return io;
442}
443
444void
463ee0b2
LW
445gv_check(stash)
446HV* stash;
79072805
LW
447{
448 register HE *entry;
449 register I32 i;
450 register GV *gv;
463ee0b2
LW
451 HV *hv;
452
453 for (i = 0; i <= HvMAX(stash); i++) {
454 for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
455 if (isALPHA(*entry->hent_key)) {
456 gv = (GV*)entry->hent_val;
457 if (SvMULTI(gv))
458 continue;
459 curcop->cop_line = GvLINE(gv);
460 warn("Possible typo: \"%s::%s\"", HvNAME(stash), GvNAME(gv));
461 }
462 else if (*entry->hent_key == '_' &&
463 (gv = (GV*)entry->hent_val) &&
464 (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
465 gv_check(hv); /* nested package */
466
79072805
LW
467 }
468 }
469}
470
471GV *
472newGVgen()
473{
474 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
475 return gv_fetchpv(tokenbuf,TRUE);
476}
477
478/* hopefully this is only called on local symbol table entries */
479
480GP*
481gp_ref(gp)
482GP* gp;
483{
484 gp->gp_refcnt++;
485 return gp;
486
487}
488
489void
490gp_free(gv)
491GV* gv;
492{
493 IO *io;
494 CV *cv;
495 GP* gp;
496
497 if (!gv || !(gp = GvGP(gv)))
498 return;
499 if (gp->gp_refcnt == 0) {
500 warn("Attempt to free unreferenced glob pointers");
501 return;
502 }
503 if (--gp->gp_refcnt > 0)
504 return;
505
463ee0b2
LW
506 sv_free((SV*)gp->gp_sv);
507 sv_free((SV*)gp->gp_av);
508 sv_free((SV*)gp->gp_hv);
79072805
LW
509 if (io = gp->gp_io) {
510 do_close(gv,FALSE);
511 Safefree(io->top_name);
512 Safefree(io->fmt_name);
513 Safefree(io);
514 }
515 if (cv = gp->gp_cv)
463ee0b2 516 sv_free((SV*)cv);
79072805
LW
517 Safefree(gp);
518 GvGP(gv) = 0;
519}
520
521#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
522#define MICROPORT
523#endif
524
525#ifdef MICROPORT /* Microport 2.4 hack */
526AV *GvAVn(gv)
527register GV *gv;
528{
529 if (GvGP(gv)->gp_av)
530 return GvGP(gv)->gp_av;
531 else
532 return GvGP(gv_AVadd(gv))->gp_av;
533}
534
535HV *GvHVn(gv)
536register GV *gv;
537{
538 if (GvGP(gv)->gp_hv)
539 return GvGP(gv)->gp_hv;
540 else
541 return GvGP(gv_HVadd(gv))->gp_hv;
542}
543#endif /* Microport 2.4 hack */
544
545GV *
546fetch_gv(op,num)
547OP *op;
548I32 num;
549{
550 if (op->op_private < num)
551 return 0;
552 if (op->op_flags & OPf_STACKED)
463ee0b2 553 return gv_fetchpv(SvPVx(*(stack_sp--), na),TRUE);
79072805
LW
554 else
555 return cGVOP->op_gv;
556}
557
558IO *
559fetch_io(op,num)
560OP *op;
561I32 num;
562{
563 GV *gv;
564
565 if (op->op_private < num)
566 return 0;
567 if (op->op_flags & OPf_STACKED)
463ee0b2 568 gv = gv_fetchpv(SvPVx(*(stack_sp--), na),TRUE);
79072805
LW
569 else
570 gv = cGVOP->op_gv;
571
572 if (!gv)
573 return 0;
574
575 return GvIOn(gv);
576}