X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/97aff369fa5580e7a888d4fa4c86be74ab000409..8f75121c844fcb3cbdc99c82d6051e66b39f4c78:/gv.c diff --git a/gv.c b/gv.c index 42c1556..e03521e 100644 --- a/gv.c +++ b/gv.c @@ -1,7 +1,7 @@ /* gv.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -45,7 +45,7 @@ Perl_gv_SVadd(pTHX_ GV *gv) if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) Perl_croak(aTHX_ "Bad symbol for scalar"); if (!GvSV(gv)) - GvSV(gv) = NEWSV(72,0); + GvSV(gv) = newSV(0); return gv; } #endif @@ -80,7 +80,8 @@ Perl_gv_IOadd(pTHX_ register GV *gv) * if it walks like a dirhandle, then let's assume that * this is a dirhandle. */ - const char *fh = PL_op->op_type == OP_READDIR || + const char * const fh = + PL_op->op_type == OP_READDIR || PL_op->op_type == OP_TELLDIR || PL_op->op_type == OP_SEEKDIR || PL_op->op_type == OP_REWINDDIR || @@ -103,34 +104,42 @@ Perl_gv_IOadd(pTHX_ register GV *gv) GV * Perl_gv_fetchfile(pTHX_ const char *name) { + return gv_fetchfile_flags(name, strlen(name), 0); +} + +GV * +Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen, + const U32 flags) +{ dVAR; - char smallbuf[256]; + char smallbuf[128]; char *tmpbuf; - STRLEN tmplen; + const STRLEN tmplen = namelen + 2; GV *gv; + PERL_UNUSED_ARG(flags); + if (!PL_defstash) - return Nullgv; + return NULL; - tmplen = strlen(name) + 2; - if (tmplen < sizeof smallbuf) + if (tmplen <= sizeof smallbuf) tmpbuf = smallbuf; else - Newx(tmpbuf, tmplen + 1, char); + Newx(tmpbuf, tmplen, char); /* This is where the debugger's %{"::_<$filename"} hash is created */ tmpbuf[0] = '_'; tmpbuf[1] = '<'; - memcpy(tmpbuf + 2, name, tmplen - 1); + memcpy(tmpbuf + 2, name, namelen); gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE); if (!isGV(gv)) { gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE); #ifdef PERL_DONT_CREATE_GVSV - GvSV(gv) = newSVpvn(name, tmplen - 2); + GvSV(gv) = newSVpvn(name, namelen); #else - sv_setpvn(GvSV(gv), name, tmplen - 2); + sv_setpvn(GvSV(gv), name, namelen); #endif if (PERLDB_LINE) - hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, PERL_MAGIC_dbfile); + hv_magic(GvHVn(gv_AVadd(gv)), NULL, PERL_MAGIC_dbfile); } if (tmpbuf != smallbuf) Safefree(tmpbuf); @@ -156,14 +165,42 @@ Perl_gv_const_sv(pTHX_ GV *gv) return SvROK(gv) ? SvRV(gv) : NULL; } +GP * +Perl_newGP(pTHX_ GV *const gv) +{ + GP *gp; + const char *const file + = (PL_curcop && CopFILE(PL_curcop)) ? CopFILE(PL_curcop) : ""; + STRLEN len = strlen(file); + U32 hash; + + PERL_HASH(hash, file, len); + + Newxz(gp, 1, GP); + +#ifndef PERL_DONT_CREATE_GVSV + gp->gp_sv = newSV(0); +#endif + + gp->gp_line = PL_curcop ? CopLINE(PL_curcop) : 0; + /* XXX Ideally this cast would be replaced with a change to const char* + in the struct. */ + gp->gp_file_hek = share_hek(file, len, hash); + gp->gp_egv = gv; + gp->gp_refcnt = 1; + + return gp; +} + void Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) { dVAR; - register GP *gp; - const bool doproto = SvTYPE(gv) > SVt_NULL; + const U32 old_type = SvTYPE(gv); + const bool doproto = old_type > SVt_NULL; const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL; SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL; + const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0; assert (!(proto && has_constant)); @@ -177,12 +214,18 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) case SVt_PVIO: Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob", sv_reftype(has_constant, 0)); + default: NOOP; } SvRV_set(gv, NULL); SvROK_off(gv); } - sv_upgrade((SV*)gv, SVt_PVGV); + + if (old_type < SVt_PVGV) { + if (old_type >= SVt_PV) + SvCUR_set(gv, 0); + sv_upgrade((SV*)gv, SVt_PVGV); + } if (SvLEN(gv)) { if (proto) { SvPV_set(gv, NULL); @@ -191,35 +234,27 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) } else Safefree(SvPVX_mutable(gv)); } - Newxz(gp, 1, GP); - GvGP(gv) = gp_ref(gp); -#ifdef PERL_DONT_CREATE_GVSV - GvSV(gv) = NULL; -#else - GvSV(gv) = NEWSV(72,0); -#endif - GvLINE(gv) = CopLINE(PL_curcop); - /* XXX Ideally this cast would be replaced with a change to const char* - in the struct. */ - GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) ""; - GvCVGEN(gv) = 0; - GvEGV(gv) = gv; - sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, Nullch, 0); + SvIOK_off(gv); + isGV_with_GP_on(gv); + + GvGP(gv) = Perl_newGP(aTHX_ gv); GvSTASH(gv) = stash; if (stash) Perl_sv_add_backref(aTHX_ (SV*)stash, (SV*)gv); - GvNAME(gv) = savepvn(name, len); - GvNAMELEN(gv) = len; + gv_name_set(gv, name, len, GV_ADD); if (multi || doproto) /* doproto means it _was_ mentioned */ GvMULTI_on(gv); if (doproto) { /* Replicate part of newSUB here. */ - SvIOK_off(gv); ENTER; if (has_constant) { /* newCONSTSUB takes ownership of the reference from us. */ GvCV(gv) = newCONSTSUB(stash, name, has_constant); + /* If this reference was a copy of another, then the subroutine + must have been "imported", by a Perl space assignment to a GV + from a reference to CV. */ + if (exported_constant) + GvIMPORTED_CV_on(gv); } else { - /* XXX unsafe for threads if eval_owner isn't held */ (void) start_subparse(0,0); /* Create empty CV in compcv. */ GvCV(gv) = PL_compcv; } @@ -253,6 +288,7 @@ S_gv_init_sv(pTHX_ GV *gv, I32 sv_type) case SVt_NULL: case SVt_PVCV: case SVt_PVFM: + case SVt_PVGV: break; default: (void)GvSVn(gv); @@ -291,11 +327,12 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) GV** gvp; CV* cv; const char *hvname; + HV* lastchance = NULL; /* UNIVERSAL methods should be callable without a stash */ if (!stash) { level = -1; /* probably appropriate */ - if(!(stash = gv_stashpvs("UNIVERSAL", FALSE))) + if(!(stash = gv_stashpvs("UNIVERSAL", 0))) return 0; } @@ -312,7 +349,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) gvp = (GV**)hv_fetch(stash, name, len, (level >= 0)); if (!gvp) - topgv = Nullgv; + topgv = NULL; else { topgv = *gvp; if (SvTYPE(topgv) != SVt_PVGV) @@ -323,14 +360,14 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) return topgv; /* Stale cached entry: junk it */ SvREFCNT_dec(cv); - GvCV(topgv) = cv = Nullcv; + GvCV(topgv) = cv = NULL; GvCVGEN(topgv) = 0; } else if (GvCVGEN(topgv) == PL_sub_generation) return 0; /* cache indicates sub doesn't exist */ } - gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE); + gvp = (GV**)hv_fetchs(stash, "ISA", FALSE); av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL; /* create and re-create @.*::SUPER::ISA on demand */ @@ -341,16 +378,16 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) HV* basestash; packlen -= 7; - basestash = gv_stashpvn(hvname, packlen, TRUE); - gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE); + basestash = gv_stashpvn(hvname, packlen, GV_ADD); + gvp = (GV**)hv_fetchs(basestash, "ISA", FALSE); if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) { - gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); + gvp = (GV**)hv_fetchs(stash, "ISA", TRUE); if (!gvp || !(gv = *gvp)) Perl_croak(aTHX_ "Cannot create %s::ISA", hvname); if (SvTYPE(gv) != SVt_PVGV) gv_init(gv, stash, "ISA", 3, TRUE); SvREFCNT_dec(GvAV(gv)); - GvAV(gv) = (AV*)SvREFCNT_inc(av); + GvAV(gv) = (AV*)SvREFCNT_inc_simple(av); } } } @@ -361,11 +398,11 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) I32 items = AvFILLp(av) + 1; while (items--) { SV* const sv = *svp++; - HV* const basestash = gv_stashsv(sv, FALSE); + HV* const basestash = gv_stashsv(sv, 0); if (!basestash) { if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA", - sv, hvname); + SVfARG(sv), hvname); continue; } gv = gv_fetchmeth(basestash, name, len, @@ -378,7 +415,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) /* if at top level, try UNIVERSAL */ if (level == 0 || level == -1) { - HV* const lastchance = gv_stashpvs("UNIVERSAL", FALSE); + lastchance = gv_stashpvs("UNIVERSAL", 0); if (lastchance) { if ((gv = gv_fetchmeth(lastchance, name, len, @@ -435,20 +472,20 @@ Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 le GV **gvp; if (!stash) - return Nullgv; /* UNIVERSAL::AUTOLOAD could cause trouble */ + return NULL; /* UNIVERSAL::AUTOLOAD could cause trouble */ if (len == S_autolen && strnEQ(name, S_autoload, S_autolen)) - return Nullgv; + return NULL; if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE))) - return Nullgv; + return NULL; cv = GvCV(gv); if (!(CvROOT(cv) || CvXSUB(cv))) - return Nullgv; + return NULL; /* Have an autoload */ if (level < 0) /* Cannot do without a stub */ gv_fetchmeth(stash, name, len, 0); gvp = (GV**)hv_fetch(stash, name, len, (level >= 0)); if (!gvp) - return Nullgv; + return NULL; return *gvp; } return gv; @@ -507,23 +544,23 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) --nsplit; if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) { /* ->SUPER::method should really be looked up in original stash */ - SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER", + SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER", CopSTASHPV(PL_curcop))); /* __PACKAGE__::SUPER stash should be autovivified */ - stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), TRUE); + stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), GV_ADD); DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n", origname, HvNAME_get(stash), name) ); } else { /* don't autovifify if ->NoSuchStash::method */ - stash = gv_stashpvn(origname, nsplit - origname, FALSE); + stash = gv_stashpvn(origname, nsplit - origname, 0); /* however, explicit calls to Pkg::SUPER::method may happen, and may require autovivification to work */ if (!stash && (nsplit - origname) >= 7 && strnEQ(nsplit - 7, "::SUPER", 7) && - gv_stashpvn(origname, nsplit - origname - 7, FALSE)) - stash = gv_stashpvn(origname, nsplit - origname, TRUE); + gv_stashpvn(origname, nsplit - origname - 7, 0)) + stash = gv_stashpvn(origname, nsplit - origname, GV_ADD); } ostash = stash; } @@ -568,10 +605,10 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) GV* vargv; SV* varsv; const char *packname = ""; - STRLEN packname_len; + STRLEN packname_len = 0; if (len == S_autolen && strnEQ(name, S_autoload, S_autolen)) - return Nullgv; + return NULL; if (stash) { if (SvTYPE(stash) < SVt_PVHV) { packname = SvPV_const((SV*)stash, packname_len); @@ -583,11 +620,11 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) } } if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE))) - return Nullgv; + return NULL; cv = GvCV(gv); if (!(CvROOT(cv) || CvXSUB(cv))) - return Nullgv; + return NULL; /* * Inheriting AUTOLOAD for non-methods works ... for now. @@ -599,7 +636,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", packname, (int)len, name); - if (CvXSUB(cv)) { + if (CvISXSUB(cv)) { /* rather than lookup/init $AUTOLOAD here * only to have the XSUB do another lookup for $AUTOLOAD * and split that value on the last '::', @@ -624,7 +661,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) if (!isGV(vargv)) { gv_init(vargv, varstash, S_autoload, S_autolen, FALSE); #ifdef PERL_DONT_CREATE_GVSV - GvSV(vargv) = NEWSV(72,0); + GvSV(vargv) = newSV(0); #endif } LEAVE; @@ -632,41 +669,54 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) sv_setpvn(varsv, packname, packname_len); sv_catpvs(varsv, "::"); sv_catpvn(varsv, name, len); - SvTAINTED_off(varsv); return gv; } -/* The "gv" parameter should be the glob known to Perl code as *! - * The scalar must already have been magicalized. + +/* require_tie_mod() internal routine for requiring a module + * that implements the logic of automatical ties like %! and %- + * + * The "gv" parameter should be the glob. + * "varpv" holds the name of the var, used for error messages + * "namesv" holds the module name + * "methpv" holds the method name to test for to check that things + * are working reasonably close to as expected + * "flags" if flag & 1 then save the scalar before loading. + * For the protection of $! to work (it is set by this routine) + * the sv slot must already be magicalized. */ -STATIC void -S_require_errno(pTHX_ GV *gv) +STATIC HV* +S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv,const U32 flags) { dVAR; - HV* stash = gv_stashpvs("Errno", FALSE); - - if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { + HV* stash = gv_stashsv(namesv, 0); + + if (!stash || !(gv_fetchmethod(stash, methpv))) { + SV *module = newSVsv(namesv); dSP; PUTBACK; ENTER; - save_scalar(gv); /* keep the value of $! */ - Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, - newSVpvs("Errno"), Nullsv); + if ( flags & 1 ) + save_scalar(gv); + Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL); LEAVE; SPAGAIN; - stash = gv_stashpvs("Errno", FALSE); - if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) - Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available"); + stash = gv_stashsv(namesv, 0); + if (!stash) + Perl_croak( aTHX_ "panic: Can't use %%%s because %"SVf" is not available", + varpv, SVfARG(module)); + else if (!gv_fetchmethod(stash, methpv)) + Perl_croak( aTHX_ "panic: Can't use %%%s because %"SVf" does not support method %s", + varpv, SVfARG(module), methpv); } + return stash; } /* =for apidoc gv_stashpv -Returns a pointer to the stash for a specified package. C should -be a valid UTF-8 string and must be null-terminated. If C is set -then the package will be created if it does not already exist. If C -is not set and the package does not exist then NULL is returned. +Returns a pointer to the stash for a specified package. Uses C to +determine the length of C, then calls C. =cut */ @@ -680,36 +730,37 @@ Perl_gv_stashpv(pTHX_ const char *name, I32 create) /* =for apidoc gv_stashpvn -Returns a pointer to the stash for a specified package. C should -be a valid UTF-8 string. The C parameter indicates the length of -the C, in bytes. If C is set then the package will be -created if it does not already exist. If C is not set and the -package does not exist then NULL is returned. +Returns a pointer to the stash for a specified package. The C +parameter indicates the length of the C, in bytes. C is passed +to C, so if set to C then the package will be +created if it does not already exist. If the package does not exist and +C is 0 (or any other setting that does not create packages) then NULL +is returned. + =cut */ HV* -Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create) +Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) { char smallbuf[128]; char *tmpbuf; HV *stash; GV *tmpgv; - if (namelen + 3 < sizeof smallbuf) + if (namelen + 2 <= sizeof smallbuf) tmpbuf = smallbuf; else - Newx(tmpbuf, namelen + 3, char); + Newx(tmpbuf, namelen + 2, char); Copy(name,tmpbuf,namelen,char); tmpbuf[namelen++] = ':'; tmpbuf[namelen++] = ':'; - tmpbuf[namelen] = '\0'; - tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, create, SVt_PVHV); + tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, flags, SVt_PVHV); if (tmpbuf != smallbuf) Safefree(tmpbuf); if (!tmpgv) - return 0; + return NULL; if (!GvHV(tmpgv)) GvHV(tmpgv) = newHV(); stash = GvHV(tmpgv); @@ -721,18 +772,17 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create) /* =for apidoc gv_stashsv -Returns a pointer to the stash for a specified package, which must be a -valid UTF-8 string. See C. +Returns a pointer to the stash for a specified package. See C. =cut */ HV* -Perl_gv_stashsv(pTHX_ SV *sv, I32 create) +Perl_gv_stashsv(pTHX_ SV *sv, I32 flags) { STRLEN len; const char * const ptr = SvPV_const(sv,len); - return gv_stashpvn(ptr, len, create); + return gv_stashpvn(ptr, len, flags); } @@ -757,41 +807,49 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, register GV *gv = NULL; GV**gvp; I32 len; - register const char *namend; + register const char *name_cursor; HV *stash = NULL; const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT); const I32 no_expand = flags & GV_NOEXPAND; - const I32 add = flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND; - - PERL_UNUSED_ARG(full_len); + const I32 add = flags & ~GV_NOADD_MASK; + const char *const name_end = nambeg + full_len; + const char *const name_em1 = name_end - 1; + + if (flags & GV_NOTQUAL) { + /* Caller promised that there is no stash, so we can skip the check. */ + len = full_len; + goto no_stash; + } - if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */ + if (full_len > 2 && *name == '*' && isALPHA(name[1])) { + /* accidental stringify on a GV? */ name++; + } - for (namend = name; *namend; namend++) { - if ((*namend == ':' && namend[1] == ':') - || (*namend == '\'' && namend[1])) + for (name_cursor = name; name_cursor < name_end; name_cursor++) { + if ((*name_cursor == ':' && name_cursor < name_em1 + && name_cursor[1] == ':') + || (*name_cursor == '\'' && name_cursor[1])) { if (!stash) stash = PL_defstash; if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */ - return Nullgv; + return NULL; - len = namend - name; + len = name_cursor - name; if (len > 0) { char smallbuf[128]; char *tmpbuf; - if (len + 3 < sizeof (smallbuf)) + if (len + 2 <= (I32)sizeof (smallbuf)) tmpbuf = smallbuf; else - Newx(tmpbuf, len+3, char); + Newx(tmpbuf, len+2, char); Copy(name, tmpbuf, len, char); tmpbuf[len++] = ':'; tmpbuf[len++] = ':'; - tmpbuf[len] = '\0'; gvp = (GV**)hv_fetch(stash,tmpbuf,len,add); - gv = gvp ? *gvp : Nullgv; + gv = gvp ? *gvp : NULL; if (gv && gv != (GV*)&PL_sv_undef) { if (SvTYPE(gv) != SVt_PVGV) gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI)); @@ -801,53 +859,63 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (tmpbuf != smallbuf) Safefree(tmpbuf); if (!gv || gv == (GV*)&PL_sv_undef) - return Nullgv; + return NULL; if (!(stash = GvHV(gv))) stash = GvHV(gv) = newHV(); if (!HvNAME_get(stash)) - hv_name_set(stash, nambeg, namend - nambeg, 0); + hv_name_set(stash, nambeg, name_cursor - nambeg, 0); } - if (*namend == ':') - namend++; - namend++; - name = namend; - if (!*name) - return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE); + if (*name_cursor == ':') + name_cursor++; + name_cursor++; + name = name_cursor; + if (name == name_end) + return gv ? gv : (GV*)*hv_fetchs(PL_defstash, "main::", TRUE); } } - len = namend - name; + len = name_cursor - name; /* No stash in name, so see how we can default */ if (!stash) { - if (isIDFIRST_lazy(name)) { + no_stash: + if (len && isIDFIRST_lazy(name)) { bool global = FALSE; - /* name is always \0 terminated, and initial \0 wouldn't return - true from isIDFIRST_lazy, so we know that name[1] is defined */ - switch (name[1]) { - case '\0': + switch (len) { + case 1: if (*name == '_') global = TRUE; break; - case 'N': - if (strEQ(name, "INC") || strEQ(name, "ENV")) + case 3: + if ((name[0] == 'I' && name[1] == 'N' && name[2] == 'C') + || (name[0] == 'E' && name[1] == 'N' && name[2] == 'V') + || (name[0] == 'S' && name[1] == 'I' && name[2] == 'G')) global = TRUE; break; - case 'I': - if (strEQ(name, "SIG")) + case 4: + if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G' + && name[3] == 'V') + global = TRUE; + break; + case 5: + if (name[0] == 'S' && name[1] == 'T' && name[2] == 'D' + && name[3] == 'I' && name[4] == 'N') global = TRUE; break; - case 'T': - if (strEQ(name, "STDIN") || strEQ(name, "STDOUT") || - strEQ(name, "STDERR")) + case 6: + if ((name[0] == 'S' && name[1] == 'T' && name[2] == 'D') + &&((name[3] == 'O' && name[4] == 'U' && name[5] == 'T') + ||(name[3] == 'E' && name[4] == 'R' && name[5] == 'R'))) global = TRUE; break; - case 'R': - if (strEQ(name, "ARGV") || strEQ(name, "ARGVOUT")) + case 7: + if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G' + && name[3] == 'V' && name[4] == 'O' && name[5] == 'U' + && name[6] == 'T') global = TRUE; break; } @@ -869,7 +937,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, *gvp == (GV*)&PL_sv_undef || SvTYPE(*gvp) != SVt_PVGV) { - stash = 0; + stash = NULL; } else if ((sv_type == SVt_PV && !GvIMPORTED_SV(*gvp)) || (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) || @@ -881,7 +949,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, name); if (GvCVu(*gvp)) Perl_warn(aTHX_ "\t(Did you mean &%s instead?)\n", name); - stash = 0; + stash = NULL; } } } @@ -902,28 +970,40 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, : sv_type == SVt_PVAV ? "@" : sv_type == SVt_PVHV ? "%" : ""), name); + GV *gv; if (USE_UTF8_IN_NAMES) SvUTF8_on(err); qerror(err); - stash = GvHV(gv_fetchpvn_flags("::", 8, GV_ADDMULTI, SVt_PVHV)); + gv = gv_fetchpvn_flags("::", 8, GV_ADDMULTI, SVt_PVHV); + if(!gv) { + /* symbol table under destruction */ + return NULL; + } + stash = GvHV(gv); } else - return Nullgv; + return NULL; } if (!SvREFCNT(stash)) /* symbol table under destruction */ - return Nullgv; + return NULL; gvp = (GV**)hv_fetch(stash,name,len,add); if (!gvp || *gvp == (GV*)&PL_sv_undef) - return Nullgv; + return NULL; gv = *gvp; if (SvTYPE(gv) == SVt_PVGV) { if (add) { GvMULTI_on(gv); gv_init_sv(gv, sv_type); - if (*name=='!' && sv_type == SVt_PVHV && len==1) - require_errno(gv); + if (sv_type == SVt_PVHV && len == 1 ) { + if (*name == '!') + require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1); + else + if (*name == '-' || *name == '+') + require_tie_mod(gv, name, newSVpvs("re::Tie::Hash::NamedCapture"), "FETCH", 0); + + } } return gv; } else if (no_init) { @@ -947,6 +1027,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (len > 1) { #ifndef EBCDIC if (*name > 'V' ) { + NOOP; /* Nothing else to do. The compiler will probably turn the switch statement into a branch table. Make sure we avoid even that small overhead for @@ -960,6 +1041,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (strEQ(name2, "RGV")) { IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; } + else if (strEQ(name2, "RGVOUT")) { + GvMULTI_on(gv); + } break; case 'E': if (strnEQ(name2, "XPORT", 5)) @@ -969,22 +1053,22 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (strEQ(name2, "SA")) { AV* const av = GvAVn(gv); GvMULTI_on(gv); - sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0); + sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, NULL, 0); /* NOTE: No support for tied ISA */ if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILLp(av) == -1) { const char *pname; av_push(av, newSVpvn(pname = "NDBM_File",9)); - gv_stashpvn(pname, 9, TRUE); + gv_stashpvn(pname, 9, GV_ADD); av_push(av, newSVpvn(pname = "DB_File",7)); - gv_stashpvn(pname, 7, TRUE); + gv_stashpvn(pname, 7, GV_ADD); av_push(av, newSVpvn(pname = "GDBM_File",9)); - gv_stashpvn(pname, 9, TRUE); + gv_stashpvn(pname, 9, GV_ADD); av_push(av, newSVpvn(pname = "SDBM_File",9)); - gv_stashpvn(pname, 9, TRUE); + gv_stashpvn(pname, 9, GV_ADD); av_push(av, newSVpvn(pname = "ODBM_File",9)); - gv_stashpvn(pname, 9, TRUE); + gv_stashpvn(pname, 9, GV_ADD); } } break; @@ -992,7 +1076,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (strEQ(name2, "VERLOAD")) { HV* const hv = GvHVn(gv); GvMULTI_on(gv); - hv_magic(hv, Nullgv, PERL_MAGIC_overload); + hv_magic(hv, NULL, PERL_MAGIC_overload); } break; case 'S': @@ -1006,7 +1090,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, } GvMULTI_on(gv); hv = GvHVn(gv); - hv_magic(hv, Nullgv, PERL_MAGIC_sig); + hv_magic(hv, NULL, PERL_MAGIC_sig); for (i = 1; i < SIG_SIZE; i++) { SV * const * const init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); if (init) @@ -1029,10 +1113,16 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (strEQ(name2, "NCODING")) goto magicalize; break; + case '\015': /* $^MATCH */ + if (strEQ(name2, "ATCH")) + goto ro_magicalize; case '\017': /* $^OPEN */ if (strEQ(name2, "PEN")) goto magicalize; break; + case '\020': /* $^PREMATCH $^POSTMATCH */ + if (strEQ(name2, "REMATCH") || strEQ(name2, "OSTMATCH")) + goto ro_magicalize; case '\024': /* ${^TAINT} */ if (strEQ(name2, "AINT")) goto ro_magicalize; @@ -1042,6 +1132,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, goto ro_magicalize; if (strEQ(name2, "TF8LOCALE")) goto ro_magicalize; + if (strEQ(name2, "TF8CACHE")) + goto magicalize; break; case '\027': /* $^WARNING_BITS */ if (strEQ(name2, "ARNING_BITS")) @@ -1096,25 +1188,45 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, goto magicalize; case '!': - - /* If %! has been used, automatically load Errno.pm. - The require will itself set errno, so in order to - preserve its value we have to set up the magic - now (rather than going to magicalize) - */ + GvMULTI_on(gv); + /* If %! has been used, automatically load Errno.pm. */ sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len); + /* magicalization must be done before require_tie_mod is called */ if (sv_type == SVt_PVHV) - require_errno(gv); + require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1); break; case '-': - { - AV* const av = GvAVn(gv); - sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0); - SvREADONLY_on(av); - goto magicalize; + case '+': + GvMULTI_on(gv); /* no used once warnings here */ + { + bool plus = (*name == '+'); + SV *stashname = newSVpvs("re::Tie::Hash::NamedCapture"); + AV* const av = GvAVn(gv); + HV *const hv = GvHVn(gv); + HV *const hv_tie = newHV(); + SV *tie = newRV_noinc((SV*)hv_tie); + + sv_bless(tie, gv_stashsv(stashname,GV_ADD)); + hv_magic(hv, (GV*)tie, PERL_MAGIC_tied); + sv_magic((SV*)av, (plus ? (SV*)av : NULL), PERL_MAGIC_regdata, NULL, 0); + sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len); + + if (plus) + SvREADONLY_on(GvSVn(gv)); + else + Perl_hv_store(aTHX_ hv_tie, STR_WITH_LEN("all"), newSViv(1), 0); + + SvREADONLY_on(hv); + SvREADONLY_on(tie); + SvREADONLY_on(av); + + if (sv_type == SVt_PVHV) + require_tie_mod(gv, name, stashname, "FETCH", 0); + + break; } case '*': case '#': @@ -1126,13 +1238,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0); goto magicalize; - case '+': - { - AV* const av = GvAVn(gv); - sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0); - SvREADONLY_on(av); - /* FALL THROUGH */ - } + case '\010': /* $^H */ + { + HV *const hv = GvHVn(gv); + hv_magic(hv, NULL, PERL_MAGIC_hints); + } + goto magicalize; case '\023': /* $^S */ case '1': case '2': @@ -1164,7 +1275,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case '\004': /* $^D */ case '\005': /* $^E */ case '\006': /* $^F */ - case '\010': /* $^H */ case '\011': /* $^I, NOT \t in EBCDIC */ case '\016': /* $^N */ case '\017': /* $^O */ @@ -1244,9 +1354,7 @@ Perl_newIO(pTHX) { dVAR; GV *iogv; - IO * const io = (IO*)NEWSV(0,0); - - sv_upgrade((SV *)io,SVt_PVIO); + IO * const io = (IO*)newSV_type(SVt_PVIO); /* This used to read SvREFCNT(io) = 1; It's not clear why the reference count needed an explicit reset. NWC */ @@ -1254,16 +1362,16 @@ Perl_newIO(pTHX) SvOBJECT_on(io); /* Clear the stashcache because a new IO could overrule a package name */ hv_clear(PL_stashcache); - iogv = gv_fetchpvn_flags("FileHandle::", 12, 0, SVt_PVHV); + iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV); /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */ if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv)))) - iogv = gv_fetchpvn_flags("IO::Handle::", 12, TRUE, SVt_PVHV); + iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV); SvSTASH_set(io, (HV*)SvREFCNT_inc(GvHV(iogv))); return io; } void -Perl_gv_check(pTHX_ HV *stash) +Perl_gv_check(pTHX_ const HV *stash) { dVAR; register I32 i; @@ -1319,7 +1427,7 @@ Perl_newGVgen(pTHX_ const char *pack) { dVAR; return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++), - TRUE, SVt_PVGV); + GV_ADD, SVt_PVGV); } /* hopefully this is only called on local symbol table entries */ @@ -1329,13 +1437,13 @@ Perl_gp_ref(pTHX_ GP *gp) { dVAR; if (!gp) - return (GP*)NULL; + return NULL; gp->gp_refcnt++; if (gp->gp_cv) { if (gp->gp_cvgen) { /* multi-named GPs cannot be used for method cache */ SvREFCNT_dec(gp->gp_cv); - gp->gp_cv = Nullcv; + gp->gp_cv = NULL; gp->gp_cvgen = 0; } else { @@ -1352,7 +1460,7 @@ Perl_gp_free(pTHX_ GV *gv) dVAR; GP* gp; - if (!gv || !(gp = GvGP(gv))) + if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv))) return; if (gp->gp_refcnt == 0) { if (ckWARN_d(WARN_INTERNAL)) @@ -1368,11 +1476,14 @@ Perl_gp_free(pTHX_ GV *gv) if (--gp->gp_refcnt > 0) { if (gp->gp_egv == gv) gp->gp_egv = 0; + GvGP(gv) = 0; return; } - if (gp->gp_sv) SvREFCNT_dec(gp->gp_sv); - if (gp->gp_av) SvREFCNT_dec(gp->gp_av); + if (gp->gp_file_hek) + unshare_hek(gp->gp_file_hek); + SvREFCNT_dec(gp->gp_sv); + SvREFCNT_dec(gp->gp_av); /* FIXME - another reference loop GV -> symtab -> GV ? Somehow gp->gp_hv can end up pointing at freed garbage. */ if (gp->gp_hv && SvTYPE(gp->gp_hv) == SVt_PVHV) { @@ -1382,9 +1493,9 @@ Perl_gp_free(pTHX_ GV *gv) G_DISCARD); SvREFCNT_dec(gp->gp_hv); } - if (gp->gp_io) SvREFCNT_dec(gp->gp_io); - if (gp->gp_cv) SvREFCNT_dec(gp->gp_cv); - if (gp->gp_form) SvREFCNT_dec(gp->gp_form); + SvREFCNT_dec(gp->gp_io); + SvREFCNT_dec(gp->gp_cv); + SvREFCNT_dec(gp->gp_form); Safefree(gp); GvGP(gv) = 0; @@ -1400,9 +1511,9 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg) int i; for (i = 1; i < NofAMmeth; i++) { CV * const cv = amtp->table[i]; - if (cv != Nullcv) { + if (cv) { SvREFCNT_dec((SV *) cv); - amtp->table[i] = Nullcv; + amtp->table[i] = NULL; } } } @@ -1416,13 +1527,16 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) { dVAR; MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); - AMT * const amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; - if (mg && amtp->was_ok_am == PL_amagic_generation - && amtp->was_ok_sub == PL_sub_generation) - return (bool)AMT_OVERLOADED(amtp); - sv_unmagic((SV*)stash, PERL_MAGIC_overload_table); + if (mg) { + const AMT * const amtp = (AMT*)mg->mg_ptr; + if (amtp->was_ok_am == PL_amagic_generation + && amtp->was_ok_sub == PL_sub_generation) { + return (bool)AMT_OVERLOADED(amtp); + } + sv_unmagic((SV*)stash, PERL_MAGIC_overload_table); + } DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME_get(stash)) ); @@ -1447,7 +1561,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) lim = DESTROY_amg; /* Skip overloading entries. */ #ifdef PERL_DONT_CREATE_GVSV else if (!sv) { - /* Equivalent to !SvTRUE and !SvOK */ + NOOP; /* Equivalent to !SvTRUE and !SvOK */ } #endif else if (SvTRUE(sv)) @@ -1456,11 +1570,11 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) amt.fallback=AMGfallNEVER; for (i = 1; i < lim; i++) - amt.table[i] = Nullcv; + amt.table[i] = NULL; for (; i < NofAMmeth; i++) { - const char *cooky = PL_AMG_names[i]; + const char * const cooky = PL_AMG_names[i]; /* Human-readable form, for debugging: */ - const char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i)); + const char * const cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i)); const STRLEN l = strlen(cooky); DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n", @@ -1484,12 +1598,12 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) /* This is a hack to support autoloading..., while knowing *which* methods were declared as overloaded. */ /* GvSV contains the name of the method. */ - GV *ngv = Nullgv; + GV *ngv = NULL; SV *gvsv = GvSV(gv); DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\ "\" for overloaded \"%s\" in package \"%.256s\"\n", - GvSV(gv), cp, hvname) ); + (void*)GvSV(gv), cp, hvname) ); if (!gvsv || !SvPOK(gvsv) || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(gvsv), FALSE))) @@ -1514,7 +1628,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) cv = (CV*)gv; filled = 1; } - amt.table[i]=(CV*)SvREFCNT_inc(cv); + amt.table[i]=(CV*)SvREFCNT_inc_simple(cv); } if (filled) { AMT_AMAGIC_on(&amt); @@ -1542,13 +1656,14 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id) AMT *amtp; if (!stash || !HvNAME_get(stash)) - return Nullcv; + return NULL; mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); if (!mg) { do_update: Gv_AMupdate(stash); mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); } + assert(mg); amtp = (AMT*)mg->mg_ptr; if ( amtp->was_ok_am != PL_amagic_generation || amtp->was_ok_sub != PL_sub_generation ) @@ -1568,7 +1683,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id) return ret; } - return Nullcv; + return NULL; } @@ -1593,7 +1708,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table - : (CV **) NULL)) + : NULL)) && ((cv = cvp[off=method+assignshift]) || (assign && amtp->fallback > AMGfallNEVER && /* fallback to * usual method */ @@ -1653,6 +1768,12 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) */ SV* const newref = newSVsv(tmpRef); SvOBJECT_on(newref); + /* As a bit of a source compatibility hack, SvAMAGIC() and + friends dereference an RV, to behave the same was as when + overloading was stored on the reference, not the referant. + Hence we can't use SvAMAGIC_on() + */ + SvFLAGS(newref) |= SVf_AMAGIC; SvSTASH_set(newref, (HV*)SvREFCNT_inc(SvSTASH(tmpRef))); return newref; } @@ -1711,7 +1832,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table - : (CV **) NULL)) + : NULL)) && (cv = cvp[off=method])) { /* Method for right * argument found */ lr=1; @@ -1750,6 +1871,19 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } else { not_found: /* No method found, either report or croak */ switch (method) { + case lt_amg: + case le_amg: + case gt_amg: + case ge_amg: + case eq_amg: + case ne_amg: + case slt_amg: + case sle_amg: + case sgt_amg: + case sge_amg: + case seq_amg: + case sne_amg: + postpr = 0; break; case to_sv_amg: case to_av_amg: case to_hv_amg: @@ -1763,6 +1897,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) notfound = 1; lr = -1; } else if (cvp && (cv=cvp[nomethod_amg])) { notfound = 1; lr = 1; + } else if ((amtp && amtp->fallback >= AMGfallYES) && !DEBUG_o_TEST) { + /* Skip generating the "no method found" message. */ + return NULL; } else { SV *msg; if (off==-1) off=method; @@ -1787,7 +1924,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) if (amtp && amtp->fallback >= AMGfallYES) { DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) ); } else { - Perl_croak(aTHX_ "%"SVf, msg); + Perl_croak(aTHX_ "%"SVf, SVfARG(msg)); } return NULL; } @@ -1846,7 +1983,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) CATCH_SET(TRUE); Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; - myop.op_next = Nullop; + myop.op_next = NULL; myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; PUSHSTACKi(PERLSI_OVERLOAD); @@ -1955,6 +2092,7 @@ pointers returned by SvPV. bool Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags) { + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(flags); if (len > 1) { @@ -2073,6 +2211,26 @@ Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags) return FALSE; } +void +Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags) +{ + dVAR; + U32 hash; + + assert(name); + PERL_UNUSED_ARG(flags); + + if (len > I32_MAX) + Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len); + + if (!(flags & GV_ADD) && GvNAME_HEK(gv)) { + unshare_hek(GvNAME_HEK(gv)); + } + + PERL_HASH(hash, name, len); + GvNAME_HEK(gv) = share_hek(name, len, hash); +} + /* * Local variables: * c-indentation-style: bsd