[perl5.git] / gv.c

/* $RCSfile: gv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:39 $
 *
 *    Copyright (c) 1991, Larry Wall
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 *
 * $Log:	gv.c,v $
 * Revision 4.1  92/08/07  18:26:39  lwall
 * 
 * Revision 4.0.1.4  92/06/08  15:32:19  lwall
 * patch20: fixed confusion between a *var's real name and its effective name
 * patch20: the debugger now warns you on lines that can't set a breakpoint
 * patch20: the debugger made perl forget the last pattern used by //
 * patch20: paragraph mode now skips extra newlines automatically
 * patch20: ($<,$>) = ... didn't work on some architectures
 * 
 * Revision 4.0.1.3  91/11/05  18:35:33  lwall
 * patch11: length($x) was sometimes wrong for numeric $x
 * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
 * patch11: *foo = undef coredumped
 * patch11: solitary subroutine references no longer trigger typo warnings
 * patch11: local(*FILEHANDLE) had a memory leak
 * 
 * Revision 4.0.1.2  91/06/07  11:55:53  lwall
 * patch4: new copyright notice
 * patch4: added $^P variable to control calling of perldb routines
 * patch4: added $^F variable to specify maximum system fd, default 2
 * patch4: $` was busted inside s///
 * patch4: default top-of-form run_format is now FILEHANDLE_TOP
 * patch4: length($`), length($&), length($') now optimized to avoid string copy
 * patch4: $^D |= 1024 now does syntax tree dump at run-time
 * 
 * Revision 4.0.1.1  91/04/12  09:10:24  lwall
 * patch1: Configure now differentiates getgroups() type from getgid() type
 * patch1: you may now use "die" and "caller" in a signal handler
 * 
 * Revision 4.0  91/03/20  01:39:41  lwall
 * 4.0 baseline.
 * 
 */

#include "EXTERN.h"
#include "perl.h"

extern char rcsid[];

GV *
gv_AVadd(gv)
register GV *gv;
{
    if (!GvAV(gv))
	GvAV(gv) = newAV();
    return gv;
}

GV *
gv_HVadd(gv)
register GV *gv;
{
    if (!GvHV(gv))
	GvHV(gv) = newHV();
    return gv;
}

GV *
gv_fetchfile(name)
char *name;
{
    char tmpbuf[1200];
    GV *gv;

    sprintf(tmpbuf,"::_<%s", name);
    gv = gv_fetchpv(tmpbuf, TRUE);
    sv_setpv(GvSV(gv), name);
    if (*name == '/')
	SvMULTI_on(gv);
    if (perldb)
	hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
    return gv;
}

void
gv_init(gv, stash, name, len, multi)
GV *gv;
HV *stash;
char *name;
STRLEN len;
int multi;
{
    register GP *gp;

    sv_upgrade(gv, SVt_PVGV);
    if (SvLEN(gv))
	Safefree(SvPVX(gv));
    Newz(602,gp, 1, GP);
    GvGP(gv) = gp_ref(gp);
    GvREFCNT(gv) = 1;
    GvSV(gv) = NEWSV(72,0);
    GvLINE(gv) = curcop->cop_line;
    GvFILEGV(gv) = curcop->cop_filegv;
    GvEGV(gv) = gv;
    sv_magic((SV*)gv, (SV*)gv, '*', name, len);
    GvSTASH(gv) = stash;
    GvNAME(gv) = nsavestr(name, len);
    GvNAMELEN(gv) = len;
    if (multi)
	SvMULTI_on(gv);
}

GV *
gv_fetchmeth(stash, name, len)
HV* stash;
char* name;
STRLEN len;
{
    AV* av;
    GV* topgv;
    GV* gv;
    GV** gvp;

    gvp = (GV**)hv_fetch(stash, name, len, TRUE);

    DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
    topgv = *gvp;
    if (SvTYPE(topgv) != SVt_PVGV)
	gv_init(topgv, stash, name, len, TRUE);

    if (GvCV(topgv)) {
	if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
	    return topgv;
    }

    gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
    if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
	SV** svp = AvARRAY(av);
	I32 items = AvFILL(av) + 1;
	while (items--) {
	    SV* sv = *svp++;
	    HV* basestash = fetch_stash(sv, FALSE);
	    if (!basestash) {
		if (dowarn)
		    warn("Can't locate package %s for @%s'ISA",
			SvPVX(sv), HvNAME(stash));
		continue;
	    }
	    gv = gv_fetchmeth(basestash, name, len);
	    if (gv) {
		GvCV(topgv) = GvCV(gv);			/* cache the CV */
		GvCVGEN(topgv) = sub_generation;	/* valid for now */
		return gv;
	    }
	}
    }
    return 0;
}

GV *
gv_fetchmethod(stash, name)
HV* stash;
char* name;
{
    register char *nend;
    
    for (nend = name; *nend; nend++) {
	if (*nend == ':' || *nend == '\'') {
	    return gv_fetchpv(name, FALSE);
	}
    }
    return gv_fetchmeth(stash, name, nend - name);
}

GV *
gv_fetchpv(nambeg,add)
char *nambeg;
I32 add;
{
    register char *name = nambeg;
    register GV *gv = 0;
    GV**gvp;
    I32 len;
    register char *namend;
    HV *stash = 0;
    bool global = FALSE;
    char tmpbuf[256];

    for (namend = name; *namend; namend++) {
	if ((*namend == '\'' && namend[1]) ||
	    (*namend == ':' && namend[1] == ':'))
	{
	    len = namend - name;
	    *tmpbuf = '_';
	    Copy(name, tmpbuf+1, len, char);
	    len++;
	    tmpbuf[len] = '\0';
	    if (!stash)
		stash = defstash;

	    if (len > 1) {
		gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
		if (!gvp || *gvp == (GV*)&sv_undef)
		    return Nullgv;
		gv = *gvp;
		if (SvTYPE(gv) == SVt_PVGV)
		    SvMULTI_on(gv);
		else
		    gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));
		if (!(stash = GvHV(gv)))
		    stash = GvHV(gv) = newHV();
		if (!HvNAME(stash))
		    HvNAME(stash) = nsavestr(nambeg, namend - nambeg);
	    }

	    if (*namend == ':')
		namend++;
	    namend++;
	    name = namend;
	    if (!*name)
		return gv ? gv : defgv;
	}
    }

    /* No stash in name, so see how we can default */

    if (!stash) {
	if (isIDFIRST(*name)) {
	    if (isUPPER(*name)) {
		if (*name > 'I') {
		    if (*name == 'S' && (
		      strEQ(name, "SIG") ||
		      strEQ(name, "STDIN") ||
		      strEQ(name, "STDOUT") ||
		      strEQ(name, "STDERR") ))
			global = TRUE;
		}
		else if (*name > 'E') {
		    if (*name == 'I' && strEQ(name, "INC"))
			global = TRUE;
		}
		else if (*name > 'A') {
		    if (*name == 'E' && strEQ(name, "ENV"))
			global = TRUE;
		}
		else if (*name == 'A' && (
		  strEQ(name, "ARGV") ||
		  strEQ(name, "ARGVOUT") ))
		    global = TRUE;
	    }
	    else if (*name == '_' && !name[1])
		global = TRUE;
	    if (global)
		stash = defstash;
	    else if ((COP*)curcop == &compiling)
		stash = curstash;
	    else
		stash = curcop->cop_stash;
	}
	else
	    stash = defstash;
    }

    /* By this point we should have a stash and a name */

    if (!stash)
	croak("Global symbol \"%s\" requires explicit package name", name);
    len = namend - name;
    if (!len)
	len = 1;
    gvp = (GV**)hv_fetch(stash,name,len,add);
    if (!gvp || *gvp == (GV*)&sv_undef)
	return Nullgv;
    gv = *gvp;
    if (SvTYPE(gv) == SVt_PVGV) {
	SvMULTI_on(gv);
	return gv;
    }

    /* Adding a new symbol */

    gv_init(gv, stash, name, len, add & 2);

    /* set up magic where warranted */
    switch (*name) {
    case 'a':
    case 'b':
	if (len == 1)
	    SvMULTI_on(gv);
	break;
    case 'I':
	if (strEQ(name, "ISA")) {
	    AV* av = GvAVn(gv);
	    SvMULTI_on(gv);
	    sv_magic((SV*)av, (SV*)gv, 'I', 0, 0);
	}
	break;
    case 'S':
	if (strEQ(name, "SIG")) {
	    HV *hv;
	    siggv = gv;
	    SvMULTI_on(siggv);
	    hv = GvHVn(siggv);
	    hv_magic(hv, siggv, 'S');

	    /* initialize signal stack */
	    signalstack = newAV();
	    av_store(signalstack, 32, Nullsv);
	    av_clear(signalstack);
	    AvREAL_off(signalstack);
	}
	break;

    case '&':
	if (len > 1)
	    break;
	ampergv = gv;
	sawampersand = TRUE;
	goto magicalize;

    case '`':
	if (len > 1)
	    break;
	leftgv = gv;
	sawampersand = TRUE;
	goto magicalize;

    case '\'':
	if (len > 1)
	    break;
	rightgv = gv;
	sawampersand = TRUE;
	goto magicalize;

    case ':':
	if (len > 1)
	    break;
	sv_setpv(GvSV(gv),chopset);
	goto magicalize;

    case '!':
    case '#':
    case '?':
    case '^':
    case '~':
    case '=':
    case '-':
    case '%':
    case '.':
    case '+':
    case '*':
    case '(':
    case ')':
    case '<':
    case '>':
    case ',':
    case '\\':
    case '/':
    case '[':
    case '|':
    case '\004':
    case '\t':
    case '\020':
    case '\024':
    case '\027':
    case '\006':
	if (len > 1)
	    break;
	goto magicalize;

    case '1':
    case '2':
    case '3':
    case '4':
    case '5':
    case '6':
    case '7':
    case '8':
    case '9':
      magicalize:
	sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
	break;

    case '\014':
	if (len > 1)
	    break;
	sv_setpv(GvSV(gv),"\f");
	formfeed = GvSV(gv);
	break;
    case ';':
	if (len > 1)
	    break;
	sv_setpv(GvSV(gv),"\034");
	break;
    case ']':
	if (len == 1) {
	    SV *sv;
	    sv = GvSV(gv);
	    sv_upgrade(sv, SVt_PVNV);
	    sv_setpv(sv,rcsid);
	    SvNVX(sv) = atof(patchlevel);
	    SvNOK_on(sv);
	}
	break;
    }
    return gv;
}

void
gv_fullname(sv,gv)
SV *sv;
GV *gv;
{
    HV *hv = GvSTASH(gv);

    if (!hv)
	return;
    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
    sv_catpv(sv,HvNAME(hv));
    sv_catpvn(sv,"::", 2);
    sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
}

void
gv_efullname(sv,gv)
SV *sv;
GV *gv;
{
    GV* egv = GvEGV(gv);
    HV *hv = GvSTASH(egv);

    if (!hv)
	return;
    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
    sv_catpv(sv,HvNAME(hv));
    sv_catpvn(sv,"::", 2);
    sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
}

IO *
newIO()
{
    IO *io;
    GV *iogv;

    io = (IO*)NEWSV(0,0);
    sv_upgrade(io,SVt_PVIO);
    SvREFCNT(io) = 1;
    SvOBJECT_on(io);
    iogv = gv_fetchpv("FileHandle::", TRUE);
    SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
    return io;
}

void
gv_check(stash)
HV* stash;
{
    register HE *entry;
    register I32 i;
    register GV *gv;
    HV *hv;

    if (!HvARRAY(stash))
	return;
    for (i = 0; i <= HvMAX(stash); i++) {
	for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
	    if (isALPHA(*entry->hent_key)) {
		gv = (GV*)entry->hent_val;
		if (SvMULTI(gv))
		    continue;
		curcop->cop_line = GvLINE(gv);
		curcop->cop_filegv = GvFILEGV(gv);
		if (SvMULTI(GvFILEGV(gv)))	/* Filename began with slash */
		    continue;
		warn("Identifier \"%s::%s\" used only once: possible typo", HvNAME(stash), GvNAME(gv));
	    }
	    else if (*entry->hent_key == '_' &&
		(gv = (GV*)entry->hent_val) &&
		(hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
		     gv_check(hv);              /* nested package */
						      
	}
    }
}

GV *
newGVgen()
{
    (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
    return gv_fetchpv(tokenbuf,TRUE);
}

/* hopefully this is only called on local symbol table entries */

GP*
gp_ref(gp)
GP* gp;
{
    gp->gp_refcnt++;
    return gp;

}

void
gp_free(gv)
GV* gv;
{
    IO *io;
    CV *cv;
    GP* gp;

    if (!gv || !(gp = GvGP(gv)))
	return;
    if (gp->gp_refcnt == 0) {
        warn("Attempt to free unreferenced glob pointers");
        return;
    }
    if (--gp->gp_refcnt > 0)
        return;

    SvREFCNT_dec(gp->gp_sv);
    SvREFCNT_dec(gp->gp_av);
    SvREFCNT_dec(gp->gp_hv);
    if ((io = gp->gp_io) && SvTYPE(io) != SVTYPEMASK) {
	do_close(gv,FALSE);
	SvREFCNT_dec(io);
    }
    if ((cv = gp->gp_cv) && !GvCVGEN(gv))
	SvREFCNT_dec(cv);
    Safefree(gp);
    GvGP(gv) = 0;
}

#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
#define MICROPORT
#endif

#ifdef	MICROPORT	/* Microport 2.4 hack */
AV *GvAVn(gv)
register GV *gv;
{
    if (GvGP(gv)->gp_av) 
	return GvGP(gv)->gp_av;
    else
	return GvGP(gv_AVadd(gv))->gp_av;
}

HV *GvHVn(gv)
register GV *gv;
{
    if (GvGP(gv)->gp_hv)
	return GvGP(gv)->gp_hv;
    else
	return GvGP(gv_HVadd(gv))->gp_hv;
}
#endif			/* Microport 2.4 hack */

GV *
fetch_gv(op,num)
OP *op;
I32 num;
{
    if (op->op_private < num)
	return 0;
    if (op->op_flags & OPf_STACKED)
        return gv_fetchpv(SvPVx(*(stack_sp--), na),TRUE);
    else
        return cGVOP->op_gv;
}

IO *
fetch_io(op,num)
OP *op;
I32 num;
{
    GV *gv;

    if (op->op_private < num)
	return 0;
    if (op->op_flags & OPf_STACKED)
        gv = gv_fetchpv(SvPVx(*(stack_sp--), na),TRUE);
    else
        gv = cGVOP->op_gv;

    if (!gv)
	return 0;

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