1 /* $RCSfile: gv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:39 $
3 * Copyright (c) 1991, Larry Wall
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.
9 * Revision 4.1 92/08/07 18:26:39 lwall
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
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
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
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
38 * Revision 4.0 91/03/20 01:39:41 lwall
73 sprintf(tmpbuf,"::_<%s", name);
74 gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
75 sv_setpv(GvSV(gv), name);
79 hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
84 gv_init(gv, stash, name, len, multi)
93 sv_upgrade(gv, SVt_PVGV);
97 GvGP(gv) = gp_ref(gp);
99 GvSV(gv) = NEWSV(72,0);
100 GvLINE(gv) = curcop->cop_line;
101 GvFILEGV(gv) = curcop->cop_filegv;
103 sv_magic((SV*)gv, (SV*)gv, '*', name, len);
105 GvNAME(gv) = nsavestr(name, len);
112 gv_fetchmeth(stash, name, len)
122 gvp = (GV**)hv_fetch(stash, name, len, TRUE);
124 DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
126 if (SvTYPE(topgv) != SVt_PVGV)
127 gv_init(topgv, stash, name, len, TRUE);
130 if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
134 gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
135 if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
136 SV** svp = AvARRAY(av);
137 I32 items = AvFILL(av) + 1;
140 HV* basestash = fetch_stash(sv, FALSE);
143 warn("Can't locate package %s for @%s'ISA",
144 SvPVX(sv), HvNAME(stash));
147 gv = gv_fetchmeth(basestash, name, len);
149 GvCV(topgv) = GvCV(gv); /* cache the CV */
150 GvCVGEN(topgv) = sub_generation; /* valid for now */
159 gv_fetchmethod(stash, name)
165 for (nend = name; *nend; nend++) {
166 if (*nend == ':' || *nend == '\'') {
167 return gv_fetchpv(name, FALSE, SVt_PVCV);
170 return gv_fetchmeth(stash, name, nend - name);
174 gv_fetchpv(nambeg,add,svtype)
179 register char *name = nambeg;
183 register char *namend;
188 for (namend = name; *namend; namend++) {
189 if ((*namend == '\'' && namend[1]) ||
190 (*namend == ':' && namend[1] == ':'))
197 New(601, tmpbuf, len+2, char);
199 Copy(name, tmpbuf+1, len, char);
200 tmpbuf[++len] = '\0';
201 gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
203 if (!gvp || *gvp == (GV*)&sv_undef)
207 if (SvTYPE(gv) == SVt_PVGV)
210 gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));
212 if (!(stash = GvHV(gv)))
213 stash = GvHV(gv) = newHV();
216 HvNAME(stash) = nsavestr(nambeg, namend - nambeg);
224 return gv ? gv : defgv;
228 /* No stash in name, so see how we can default */
231 if (isIDFIRST(*name)) {
232 if (isUPPER(*name)) {
234 if (*name == 'S' && (
235 strEQ(name, "SIG") ||
236 strEQ(name, "STDIN") ||
237 strEQ(name, "STDOUT") ||
238 strEQ(name, "STDERR") ))
241 else if (*name > 'E') {
242 if (*name == 'I' && strEQ(name, "INC"))
245 else if (*name > 'A') {
246 if (*name == 'E' && strEQ(name, "ENV"))
249 else if (*name == 'A' && (
250 strEQ(name, "ARGV") ||
251 strEQ(name, "ARGVOUT") ))
254 else if (*name == '_' && !name[1])
258 else if ((COP*)curcop == &compiling) {
259 if (!(hints & HINT_STRICT_VARS) || svtype == SVt_PVCV)
263 stash = curcop->cop_stash;
269 /* By this point we should have a stash and a name */
272 croak("Global symbol \"%s\" requires explicit package name", name);
276 gvp = (GV**)hv_fetch(stash,name,len,add);
277 if (!gvp || *gvp == (GV*)&sv_undef)
280 if (SvTYPE(gv) == SVt_PVGV) {
285 /* Adding a new symbol */
287 gv_init(gv, stash, name, len, add & 2);
289 /* set up magic where warranted */
297 if (strEQ(name, "ISA")) {
300 sv_magic((SV*)av, (SV*)gv, 'I', 0, 0);
301 if (add & 2 && strEQ(nambeg,"Any_DBM_File::ISA") && AvFILL(av) == -1)
303 av_push(av, newSVpv("NDBM_File",0));
304 av_push(av, newSVpv("DB_File",0));
305 av_push(av, newSVpv("GDBM_File",0));
306 av_push(av, newSVpv("SDBM_File",0));
307 av_push(av, newSVpv("ODBM_File",0));
312 if (strEQ(name, "SIG")) {
317 hv_magic(hv, siggv, 'S');
319 /* initialize signal stack */
320 signalstack = newAV();
321 av_store(signalstack, 32, Nullsv);
322 av_clear(signalstack);
323 AvREAL_off(signalstack);
351 sv_setpv(GvSV(gv),chopset);
394 sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
400 sv_setpv(GvSV(gv),"\f");
406 sv_setpv(GvSV(gv),"\034");
412 sv_upgrade(sv, SVt_PVNV);
414 SvNVX(sv) = atof(patchlevel);
427 HV *hv = GvSTASH(gv);
431 sv_setpv(sv, sv == (SV*)gv ? "*" : "");
432 sv_catpv(sv,HvNAME(hv));
433 sv_catpvn(sv,"::", 2);
434 sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
443 HV *hv = GvSTASH(egv);
447 sv_setpv(sv, sv == (SV*)gv ? "*" : "");
448 sv_catpv(sv,HvNAME(hv));
449 sv_catpvn(sv,"::", 2);
450 sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
459 io = (IO*)NEWSV(0,0);
460 sv_upgrade(io,SVt_PVIO);
463 iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVIO);
464 SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
479 for (i = 0; i <= HvMAX(stash); i++) {
480 for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
481 if (isALPHA(*entry->hent_key)) {
482 gv = (GV*)entry->hent_val;
485 curcop->cop_line = GvLINE(gv);
486 curcop->cop_filegv = GvFILEGV(gv);
487 if (SvMULTI(GvFILEGV(gv))) /* Filename began with slash */
489 warn("Identifier \"%s::%s\" used only once: possible typo", HvNAME(stash), GvNAME(gv));
491 else if (*entry->hent_key == '_' &&
492 (gv = (GV*)entry->hent_val) &&
493 (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
494 gv_check(hv); /* nested package */
503 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
504 return gv_fetchpv(tokenbuf,TRUE, SVt_PVGV);
507 /* hopefully this is only called on local symbol table entries */
526 if (!gv || !(gp = GvGP(gv)))
528 if (gp->gp_refcnt == 0) {
529 warn("Attempt to free unreferenced glob pointers");
532 if (--gp->gp_refcnt > 0)
535 SvREFCNT_dec(gp->gp_sv);
536 SvREFCNT_dec(gp->gp_av);
537 SvREFCNT_dec(gp->gp_hv);
538 if ((io = gp->gp_io) && SvTYPE(io) != SVTYPEMASK) {
542 if ((cv = gp->gp_cv) && !GvCVGEN(gv))
548 #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
552 #ifdef MICROPORT /* Microport 2.4 hack */
557 return GvGP(gv)->gp_av;
559 return GvGP(gv_AVadd(gv))->gp_av;
566 return GvGP(gv)->gp_hv;
568 return GvGP(gv_HVadd(gv))->gp_hv;
570 #endif /* Microport 2.4 hack */