3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4 * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
12 * 'Mercy!' cried Gandalf. 'If the giving of information is to be the cure
13 * of your inquisitiveness, I shall spend all the rest of my days answering
14 * you. What more do you want to know?'
15 * 'The names of all the stars, and of all living things, and the whole
16 * history of Middle-earth and Over-heaven and of the Sundering Seas,'
29 Perl_gv_AVadd(pTHX_ register GV *gv)
31 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
32 Perl_croak(aTHX_ "Bad symbol for array");
39 Perl_gv_HVadd(pTHX_ register GV *gv)
41 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
42 Perl_croak(aTHX_ "Bad symbol for hash");
49 Perl_gv_IOadd(pTHX_ register GV *gv)
51 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
52 Perl_croak(aTHX_ "Bad symbol for filehandle");
54 #ifdef GV_UNIQUE_CHECK
56 Perl_croak(aTHX_ "Bad symbol for filehandle (GV is unique)");
65 Perl_gv_fetchfile(pTHX_ const char *name)
75 tmplen = strlen(name) + 2;
76 if (tmplen < sizeof smallbuf)
79 New(603, tmpbuf, tmplen + 1, char);
80 /* This is where the debugger's %{"::_<$filename"} hash is created */
83 strcpy(tmpbuf + 2, name);
84 gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
86 gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
87 sv_setpv(GvSV(gv), name);
89 hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, PERL_MAGIC_dbfile);
91 if (tmpbuf != smallbuf)
97 Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
100 bool doproto = SvTYPE(gv) > SVt_NULL;
101 char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
103 sv_upgrade((SV*)gv, SVt_PVGV);
112 Newz(602, gp, 1, GP);
113 GvGP(gv) = gp_ref(gp);
114 GvSV(gv) = NEWSV(72,0);
115 GvLINE(gv) = CopLINE(PL_curcop);
116 GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
119 sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, Nullch, 0);
120 GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
121 GvNAME(gv) = savepvn(name, len);
123 if (multi || doproto) /* doproto means it _was_ mentioned */
125 if (doproto) { /* Replicate part of newSUB here. */
128 /* XXX unsafe for threads if eval_owner isn't held */
129 start_subparse(0,0); /* Create CV in compcv. */
130 GvCV(gv) = PL_compcv;
135 CvFILE_set_from_cop(GvCV(gv), PL_curcop);
136 CvSTASH(GvCV(gv)) = PL_curstash;
138 sv_setpv((SV*)GvCV(gv), proto);
145 S_gv_init_sv(pTHX_ GV *gv, I32 sv_type)
161 =for apidoc gv_fetchmeth
163 Returns the glob with the given C<name> and a defined subroutine or
164 C<NULL>. The glob lives in the given C<stash>, or in the stashes
165 accessible via @ISA and UNIVERSAL::.
167 The argument C<level> should be either 0 or -1. If C<level==0>, as a
168 side-effect creates a glob with the given C<name> in the given C<stash>
169 which in the case of success contains an alias for the subroutine, and sets
170 up caching info for this glob. Similarly for all the searched stashes.
172 This function grants C<"SUPER"> token as a postfix of the stash name. The
173 GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
174 visible to Perl code. So when calling C<call_sv>, you should not use
175 the GV directly; instead, you should use the method's CV, which can be
176 obtained from the GV with the C<GvCV> macro.
182 Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
190 /* UNIVERSAL methods should be callable without a stash */
192 level = -1; /* probably appropriate */
193 if(!(stash = gv_stashpvn("UNIVERSAL", 9, FALSE)))
199 "Can't use anonymous symbol table for method lookup");
201 if ((level > 100) || (level < -100))
202 Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
203 name, HvNAME(stash));
205 DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,HvNAME(stash)) );
207 gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
212 if (SvTYPE(topgv) != SVt_PVGV)
213 gv_init(topgv, stash, name, len, TRUE);
214 if ((cv = GvCV(topgv))) {
215 /* If genuine method or valid cache entry, use it */
216 if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation)
218 /* Stale cached entry: junk it */
220 GvCV(topgv) = cv = Nullcv;
223 else if (GvCVGEN(topgv) == PL_sub_generation)
224 return 0; /* cache indicates sub doesn't exist */
227 gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
228 av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav;
230 /* create and re-create @.*::SUPER::ISA on demand */
231 if (!av || !SvMAGIC(av)) {
232 char* packname = HvNAME(stash);
233 STRLEN packlen = strlen(packname);
235 if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
239 basestash = gv_stashpvn(packname, packlen, TRUE);
240 gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
241 if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
242 gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
243 if (!gvp || !(gv = *gvp))
244 Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash));
245 if (SvTYPE(gv) != SVt_PVGV)
246 gv_init(gv, stash, "ISA", 3, TRUE);
247 SvREFCNT_dec(GvAV(gv));
248 GvAV(gv) = (AV*)SvREFCNT_inc(av);
254 SV** svp = AvARRAY(av);
255 /* NOTE: No support for tied ISA */
256 I32 items = AvFILLp(av) + 1;
259 HV* basestash = gv_stashsv(sv, FALSE);
261 if (ckWARN(WARN_MISC))
262 Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
266 gv = gv_fetchmeth(basestash, name, len,
267 (level >= 0) ? level + 1 : level - 1);
273 /* if at top level, try UNIVERSAL */
275 if (level == 0 || level == -1) {
278 if ((lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE))) {
279 if ((gv = gv_fetchmeth(lastchance, name, len,
280 (level >= 0) ? level + 1 : level - 1)))
284 * Cache method in topgv if:
285 * 1. topgv has no synonyms (else inheritance crosses wires)
286 * 2. method isn't a stub (else AUTOLOAD fails spectacularly)
289 GvREFCNT(topgv) == 1 &&
291 (CvROOT(cv) || CvXSUB(cv)))
293 if ((cv = GvCV(topgv)))
295 GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
296 GvCVGEN(topgv) = PL_sub_generation;
300 else if (topgv && GvREFCNT(topgv) == 1) {
301 /* cache the fact that the method is not defined */
302 GvCVGEN(topgv) = PL_sub_generation;
311 =for apidoc gv_fetchmeth_autoload
313 Same as gv_fetchmeth(), but looks for autoloaded subroutines too.
314 Returns a glob for the subroutine.
316 For an autoloaded subroutine without a GV, will create a GV even
317 if C<level < 0>. For an autoloaded subroutine without a stub, GvCV()
318 of the result may be zero.
324 Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
326 GV *gv = gv_fetchmeth(stash, name, len, level);
329 char autoload[] = "AUTOLOAD";
330 STRLEN autolen = sizeof(autoload)-1;
335 return Nullgv; /* UNIVERSAL::AUTOLOAD could cause trouble */
336 if (len == autolen && strnEQ(name, autoload, autolen))
338 if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
341 if (!(CvROOT(cv) || CvXSUB(cv)))
343 /* Have an autoload */
344 if (level < 0) /* Cannot do without a stub */
345 gv_fetchmeth(stash, name, len, 0);
346 gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
355 =for apidoc gv_fetchmethod
357 See L<gv_fetchmethod_autoload>.
363 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
365 return gv_fetchmethod_autoload(stash, name, TRUE);
369 =for apidoc gv_fetchmethod_autoload
371 Returns the glob which contains the subroutine to call to invoke the method
372 on the C<stash>. In fact in the presence of autoloading this may be the
373 glob for "AUTOLOAD". In this case the corresponding variable $AUTOLOAD is
376 The third parameter of C<gv_fetchmethod_autoload> determines whether
377 AUTOLOAD lookup is performed if the given method is not present: non-zero
378 means yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD.
379 Calling C<gv_fetchmethod> is equivalent to calling C<gv_fetchmethod_autoload>
380 with a non-zero C<autoload> parameter.
382 These functions grant C<"SUPER"> token as a prefix of the method name. Note
383 that if you want to keep the returned glob for a long time, you need to
384 check for it being "AUTOLOAD", since at the later time the call may load a
385 different subroutine due to $AUTOLOAD changing its value. Use the glob
386 created via a side effect to do this.
388 These functions have the same side-effects and as C<gv_fetchmeth> with
389 C<level==0>. C<name> should be writable if contains C<':'> or C<'
390 ''>. The warning against passing the GV returned by C<gv_fetchmeth> to
391 C<call_sv> apply equally to these functions.
397 Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
399 register const char *nend;
400 const char *nsplit = 0;
404 if (stash && SvTYPE(stash) < SVt_PVHV)
407 for (nend = name; *nend; nend++) {
410 else if (*nend == ':' && *(nend + 1) == ':')
414 const char *origname = name;
418 if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
419 /* ->SUPER::method should really be looked up in original stash */
420 SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
421 CopSTASHPV(PL_curcop)));
422 /* __PACKAGE__::SUPER stash should be autovivified */
423 stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
424 DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
425 origname, HvNAME(stash), name) );
428 /* don't autovifify if ->NoSuchStash::method */
429 stash = gv_stashpvn(origname, nsplit - origname, FALSE);
431 /* however, explicit calls to Pkg::SUPER::method may
432 happen, and may require autovivification to work */
433 if (!stash && (nsplit - origname) >= 7 &&
434 strnEQ(nsplit - 7, "::SUPER", 7) &&
435 gv_stashpvn(origname, nsplit - origname - 7, FALSE))
436 stash = gv_stashpvn(origname, nsplit - origname, TRUE);
441 gv = gv_fetchmeth(stash, name, nend - name, 0);
443 if (strEQ(name,"import") || strEQ(name,"unimport"))
444 gv = (GV*)&PL_sv_yes;
446 gv = gv_autoload4(ostash, name, nend - name, TRUE);
450 if (!CvROOT(cv) && !CvXSUB(cv)) {
458 if (GvCV(stubgv) != cv) /* orphaned import */
461 autogv = gv_autoload4(GvSTASH(stubgv),
462 GvNAME(stubgv), GvNAMELEN(stubgv), TRUE);
472 Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
474 char autoload[] = "AUTOLOAD";
475 STRLEN autolen = sizeof(autoload)-1;
483 if (len == autolen && strnEQ(name, autoload, autolen))
486 if (SvTYPE(stash) < SVt_PVHV) {
487 packname = SvPV_nolen((SV*)stash);
491 packname = HvNAME(stash);
494 if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
498 if (!(CvROOT(cv) || CvXSUB(cv)))
502 * Inheriting AUTOLOAD for non-methods works ... for now.
504 if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
505 (GvCVGEN(gv) || GvSTASH(gv) != stash))
506 Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
507 "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
508 packname, (int)len, name);
511 /* rather than lookup/init $AUTOLOAD here
512 * only to have the XSUB do another lookup for $AUTOLOAD
513 * and split that value on the last '::',
514 * pass along the same data via some unused fields in the CV
517 SvPVX(cv) = (char *)name; /* cast to lose constness warning */
523 * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
524 * The subroutine's original name may not be "AUTOLOAD", so we don't
525 * use that, but for lack of anything better we will use the sub's
526 * original package to look up $AUTOLOAD.
528 varstash = GvSTASH(CvGV(cv));
529 vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
533 gv_init(vargv, varstash, autoload, autolen, FALSE);
536 sv_setpv(varsv, packname);
537 sv_catpvn(varsv, "::", 2);
538 sv_catpvn(varsv, name, len);
539 SvTAINTED_off(varsv);
543 /* The "gv" parameter should be the glob known to Perl code as *!
544 * The scalar must already have been magicalized.
547 S_require_errno(pTHX_ GV *gv)
549 HV* stash = gv_stashpvn("Errno",5,FALSE);
551 if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
555 save_scalar(gv); /* keep the value of $! */
556 Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
557 newSVpvn("Errno",5), Nullsv);
560 stash = gv_stashpvn("Errno",5,FALSE);
561 if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
562 Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available");
567 =for apidoc gv_stashpv
569 Returns a pointer to the stash for a specified package. C<name> should
570 be a valid UTF-8 string. If C<create> is set then the package will be
571 created if it does not already exist. If C<create> is not set and the
572 package does not exist then NULL is returned.
578 Perl_gv_stashpv(pTHX_ const char *name, I32 create)
580 return gv_stashpvn(name, strlen(name), create);
584 Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
591 if (namelen + 3 < sizeof smallbuf)
594 New(606, tmpbuf, namelen + 3, char);
595 Copy(name,tmpbuf,namelen,char);
596 tmpbuf[namelen++] = ':';
597 tmpbuf[namelen++] = ':';
598 tmpbuf[namelen] = '\0';
599 tmpgv = gv_fetchpv(tmpbuf, create, SVt_PVHV);
600 if (tmpbuf != smallbuf)
605 GvHV(tmpgv) = newHV();
608 HvNAME(stash) = savepv(name);
613 =for apidoc gv_stashsv
615 Returns a pointer to the stash for a specified package, which must be a
616 valid UTF-8 string. See C<gv_stashpv>.
622 Perl_gv_stashsv(pTHX_ SV *sv, I32 create)
627 return gv_stashpvn(ptr, len, create);
632 Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
634 register const char *name = nambeg;
638 register const char *namend;
641 if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
644 for (namend = name; *namend; namend++) {
645 if ((*namend == ':' && namend[1] == ':')
646 || (*namend == '\'' && namend[1]))
650 if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
658 if (len + 3 < sizeof (smallbuf))
661 New(601, tmpbuf, len+3, char);
662 Copy(name, tmpbuf, len, char);
666 gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
667 gv = gvp ? *gvp : Nullgv;
668 if (gv && gv != (GV*)&PL_sv_undef) {
669 if (SvTYPE(gv) != SVt_PVGV)
670 gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI));
674 if (tmpbuf != smallbuf)
676 if (!gv || gv == (GV*)&PL_sv_undef)
679 if (!(stash = GvHV(gv)))
680 stash = GvHV(gv) = newHV();
683 HvNAME(stash) = savepvn(nambeg, namend - nambeg);
691 return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE);
696 /* $_ should always be in main:: even when our'ed */
697 if (*name == '_' && !name[1])
700 /* No stash in name, so see how we can default */
703 if (isIDFIRST_lazy(name)) {
706 if (isUPPER(*name)) {
707 if (*name == 'S' && (
708 strEQ(name, "SIG") ||
709 strEQ(name, "STDIN") ||
710 strEQ(name, "STDOUT") ||
711 strEQ(name, "STDERR")))
713 else if (*name == 'I' && strEQ(name, "INC"))
715 else if (*name == 'E' && strEQ(name, "ENV"))
717 else if (*name == 'A' && (
718 strEQ(name, "ARGV") ||
719 strEQ(name, "ARGVOUT")))
722 else if (*name == '_' && !name[1])
727 else if (IN_PERL_COMPILETIME) {
729 if (add && (PL_hints & HINT_STRICT_VARS) &&
730 sv_type != SVt_PVCV &&
731 sv_type != SVt_PVGV &&
732 sv_type != SVt_PVFM &&
733 sv_type != SVt_PVIO &&
734 !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
736 gvp = (GV**)hv_fetch(stash,name,len,0);
738 *gvp == (GV*)&PL_sv_undef ||
739 SvTYPE(*gvp) != SVt_PVGV)
743 else if ((sv_type == SVt_PV && !GvIMPORTED_SV(*gvp)) ||
744 (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
745 (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
747 Perl_warn(aTHX_ "Variable \"%c%s\" is not imported",
748 sv_type == SVt_PVAV ? '@' :
749 sv_type == SVt_PVHV ? '%' : '$',
752 Perl_warn(aTHX_ "\t(Did you mean &%s instead?)\n", name);
758 stash = CopSTASH(PL_curcop);
764 /* By this point we should have a stash and a name */
768 register SV *err = Perl_mess(aTHX_
769 "Global symbol \"%s%s\" requires explicit package name",
770 (sv_type == SVt_PV ? "$"
771 : sv_type == SVt_PVAV ? "@"
772 : sv_type == SVt_PVHV ? "%"
774 if (USE_UTF8_IN_NAMES)
777 stash = GvHV(gv_fetchpv("<none>::", GV_ADDMULTI, SVt_PVHV));
783 if (!SvREFCNT(stash)) /* symbol table under destruction */
786 gvp = (GV**)hv_fetch(stash,name,len,add);
787 if (!gvp || *gvp == (GV*)&PL_sv_undef)
790 if (SvTYPE(gv) == SVt_PVGV) {
793 gv_init_sv(gv, sv_type);
794 if (*name=='!' && sv_type == SVt_PVHV && len==1)
798 } else if (add & GV_NOINIT) {
802 /* Adding a new symbol */
804 if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL))
805 Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg);
806 gv_init(gv, stash, name, len, add & GV_ADDMULTI);
807 gv_init_sv(gv, sv_type);
809 if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE)
810 : (PL_dowarn & G_WARN_ON ) ) )
813 /* set up magic where warranted */
816 if (strEQ(name, "ARGV")) {
817 IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
821 if (strnEQ(name, "EXPORT", 6))
825 if (strEQ(name, "ISA")) {
828 sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0);
829 /* NOTE: No support for tied ISA */
830 if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
831 && AvFILLp(av) == -1)
834 av_push(av, newSVpvn(pname = "NDBM_File",9));
835 gv_stashpvn(pname, 9, TRUE);
836 av_push(av, newSVpvn(pname = "DB_File",7));
837 gv_stashpvn(pname, 7, TRUE);
838 av_push(av, newSVpvn(pname = "GDBM_File",9));
839 gv_stashpvn(pname, 9, TRUE);
840 av_push(av, newSVpvn(pname = "SDBM_File",9));
841 gv_stashpvn(pname, 9, TRUE);
842 av_push(av, newSVpvn(pname = "ODBM_File",9));
843 gv_stashpvn(pname, 9, TRUE);
848 if (strEQ(name, "OVERLOAD")) {
851 hv_magic(hv, Nullgv, PERL_MAGIC_overload);
855 if (strEQ(name, "SIG")) {
859 Newz(73, PL_psig_ptr, SIG_SIZE, SV*);
860 Newz(73, PL_psig_name, SIG_SIZE, SV*);
861 Newz(73, PL_psig_pend, SIG_SIZE, int);
865 hv_magic(hv, Nullgv, PERL_MAGIC_sig);
866 for (i = 1; i < SIG_SIZE; i++) {
868 init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
870 sv_setsv(*init, &PL_sv_undef);
878 if (strEQ(name, "VERSION"))
887 sv_type == SVt_PVAV ||
888 sv_type == SVt_PVHV ||
889 sv_type == SVt_PVCV ||
890 sv_type == SVt_PVFM ||
893 PL_sawampersand = TRUE;
899 sv_setpv(GvSV(gv),PL_chopset);
905 #ifdef COMPLEX_STATUS
906 (void)SvUPGRADE(GvSV(gv), SVt_PVLV);
914 /* If %! has been used, automatically load Errno.pm.
915 The require will itself set errno, so in order to
916 preserve its value we have to set up the magic
917 now (rather than going to magicalize)
920 sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
922 if (sv_type == SVt_PVHV)
931 sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0);
936 if (len == 1 && sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
937 Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
938 "$* is no longer supported");
941 if (len == 1 && sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
942 Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
943 "Use of $# is deprecated");
958 case '\001': /* $^A */
959 case '\003': /* $^C */
960 case '\004': /* $^D */
961 case '\006': /* $^F */
962 case '\010': /* $^H */
963 case '\011': /* $^I, NOT \t in EBCDIC */
964 case '\016': /* $^N */
965 case '\020': /* $^P */
972 sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
974 case '\005': /* $^E && $^ENCODING */
975 if (len > 1 && strNE(name, "\005NCODING"))
979 case '\017': /* $^O & $^OPEN */
980 if (len > 1 && strNE(name, "\017PEN"))
983 case '\023': /* $^S */
987 case '\024': /* $^T, ${^TAINT} */
990 else if (strEQ(name, "\024AINT"))
995 if (len > 1 && strNE(name, "\025NICODE"))
999 case '\027': /* $^W & $^WARNING_BITS */
1001 && strNE(name, "\027ARNING_BITS")
1011 sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0);
1024 /* ensures variable is only digits */
1025 /* ${"1foo"} fails this test (and is thus writeable) */
1026 /* added by japhy, but borrowed from is_gv_magical */
1029 const char *end = name + len;
1030 while (--end > name) {
1031 if (!isDIGIT(*end)) return gv;
1036 SvREADONLY_on(GvSV(gv));
1038 sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
1041 case '\014': /* $^L */
1044 sv_setpv(GvSV(gv),"\f");
1045 PL_formfeed = GvSV(gv);
1050 sv_setpv(GvSV(gv),"\034");
1055 (void)SvUPGRADE(sv, SVt_PVNV);
1056 Perl_sv_setpvf(aTHX_ sv,
1057 #if defined(PERL_SUBVERSION) && (PERL_SUBVERSION > 0)
1063 SvNVX(PL_patchlevel));
1064 SvNVX(sv) = SvNVX(PL_patchlevel);
1069 case '\026': /* $^V */
1072 GvSV(gv) = SvREFCNT_inc(PL_patchlevel);
1081 Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain)
1084 HV *hv = GvSTASH(gv);
1089 sv_setpv(sv, prefix ? prefix : "");
1095 if (keepmain || strNE(name, "main")) {
1097 sv_catpvn(sv,"::", 2);
1099 if (((unsigned int)*GvNAME(gv)) <= 26) { /* handle $^FOO */
1100 Perl_sv_catpvf(aTHX_ sv,"^%c", *GvNAME(gv) + 'A' - 1);
1101 sv_catpvn(sv,GvNAME(gv)+1,GvNAMELEN(gv)-1);
1104 sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
1109 Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
1111 gv_fullname4(sv, gv, prefix, TRUE);
1115 Perl_gv_efullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain)
1117 GV *egv = GvEGV(gv);
1120 gv_fullname4(sv, egv, prefix, keepmain);
1124 Perl_gv_efullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
1126 gv_efullname4(sv, gv, prefix, TRUE);
1129 /* XXX compatibility with versions <= 5.003. */
1131 Perl_gv_fullname(pTHX_ SV *sv, GV *gv)
1133 gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
1136 /* XXX compatibility with versions <= 5.003. */
1138 Perl_gv_efullname(pTHX_ SV *sv, GV *gv)
1140 gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
1149 io = (IO*)NEWSV(0,0);
1150 sv_upgrade((SV *)io,SVt_PVIO);
1153 /* Clear the stashcache because a new IO could overrule a
1155 hv_clear(PL_stashcache);
1156 iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
1157 /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
1158 if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
1159 iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
1160 SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
1165 Perl_gv_check(pTHX_ HV *stash)
1172 if (!HvARRAY(stash))
1174 for (i = 0; i <= (I32) HvMAX(stash); i++) {
1175 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
1176 if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
1177 (gv = (GV*)HeVAL(entry)) && isGV(gv) && (hv = GvHV(gv)))
1179 if (hv != PL_defstash && hv != stash)
1180 gv_check(hv); /* nested package */
1182 else if (isALPHA(*HeKEY(entry))) {
1184 gv = (GV*)HeVAL(entry);
1185 if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
1188 /* performance hack: if filename is absolute and it's a standard
1189 * module, don't bother warning */
1191 && PERL_FILE_IS_ABSOLUTE(file)
1192 #ifdef MACOS_TRADITIONAL
1193 && (instr(file, ":lib:")
1195 && (instr(file, "/lib/")
1197 || instr(file, ".pm")))
1201 CopLINE_set(PL_curcop, GvLINE(gv));
1203 CopFILE(PL_curcop) = file; /* set for warning */
1205 CopFILEGV(PL_curcop) = gv_fetchfile(file);
1207 Perl_warner(aTHX_ packWARN(WARN_ONCE),
1208 "Name \"%s::%s\" used only once: possible typo",
1209 HvNAME(stash), GvNAME(gv));
1216 Perl_newGVgen(pTHX_ char *pack)
1218 return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
1222 /* hopefully this is only called on local symbol table entries */
1225 Perl_gp_ref(pTHX_ GP *gp)
1232 /* multi-named GPs cannot be used for method cache */
1233 SvREFCNT_dec(gp->gp_cv);
1238 /* Adding a new name to a subroutine invalidates method cache */
1239 PL_sub_generation++;
1246 Perl_gp_free(pTHX_ GV *gv)
1250 if (!gv || !(gp = GvGP(gv)))
1252 if (gp->gp_refcnt == 0) {
1253 if (ckWARN_d(WARN_INTERNAL))
1254 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
1255 "Attempt to free unreferenced glob pointers");
1259 /* Deleting the name of a subroutine invalidates method cache */
1260 PL_sub_generation++;
1262 if (--gp->gp_refcnt > 0) {
1263 if (gp->gp_egv == gv)
1268 if (gp->gp_sv) SvREFCNT_dec(gp->gp_sv);
1269 if (gp->gp_sv) SvREFCNT_dec(gp->gp_av);
1271 if (PL_stashcache && HvNAME(gp->gp_hv))
1272 hv_delete(PL_stashcache,
1273 HvNAME(gp->gp_hv), strlen(HvNAME(gp->gp_hv)),
1275 SvREFCNT_dec(gp->gp_hv);
1277 if (gp->gp_io) SvREFCNT_dec(gp->gp_io);
1278 if (gp->gp_cv) SvREFCNT_dec(gp->gp_cv);
1279 if (gp->gp_form) SvREFCNT_dec(gp->gp_form);
1286 Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
1288 AMT *amtp = (AMT*)mg->mg_ptr;
1289 if (amtp && AMT_AMAGIC(amtp)) {
1291 for (i = 1; i < NofAMmeth; i++) {
1292 CV *cv = amtp->table[i];
1294 SvREFCNT_dec((SV *) cv);
1295 amtp->table[i] = Nullcv;
1302 /* Updates and caches the CV's */
1305 Perl_Gv_AMupdate(pTHX_ HV *stash)
1309 MAGIC* mg=mg_find((SV*)stash, PERL_MAGIC_overload_table);
1310 AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
1313 if (mg && amtp->was_ok_am == PL_amagic_generation
1314 && amtp->was_ok_sub == PL_sub_generation)
1315 return (bool)AMT_OVERLOADED(amtp);
1316 sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
1318 DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
1321 amt.was_ok_am = PL_amagic_generation;
1322 amt.was_ok_sub = PL_sub_generation;
1323 amt.fallback = AMGfallNO;
1327 int filled = 0, have_ovl = 0;
1331 /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
1333 /* Try to find via inheritance. */
1334 gv = gv_fetchmeth(stash, PL_AMG_names[0], 2, -1);
1339 lim = DESTROY_amg; /* Skip overloading entries. */
1340 else if (SvTRUE(sv))
1341 amt.fallback=AMGfallYES;
1343 amt.fallback=AMGfallNEVER;
1345 for (i = 1; i < lim; i++)
1346 amt.table[i] = Nullcv;
1347 for (; i < NofAMmeth; i++) {
1348 char *cooky = (char*)PL_AMG_names[i];
1349 /* Human-readable form, for debugging: */
1350 char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
1351 STRLEN l = strlen(cooky);
1353 DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
1354 cp, HvNAME(stash)) );
1355 /* don't fill the cache while looking up!
1356 Creation of inheritance stubs in intermediate packages may
1357 conflict with the logic of runtime method substitution.
1358 Indeed, for inheritance A -> B -> C, if C overloads "+0",
1359 then we could have created stubs for "(+0" in A and C too.
1360 But if B overloads "bool", we may want to use it for
1361 numifying instead of C's "+0". */
1362 if (i >= DESTROY_amg)
1363 gv = Perl_gv_fetchmeth_autoload(aTHX_ stash, cooky, l, 0);
1364 else /* Autoload taken care of below */
1365 gv = Perl_gv_fetchmeth(aTHX_ stash, cooky, l, -1);
1367 if (gv && (cv = GvCV(gv))) {
1368 if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
1369 && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
1370 /* This is a hack to support autoloading..., while
1371 knowing *which* methods were declared as overloaded. */
1372 /* GvSV contains the name of the method. */
1375 DEBUG_o( Perl_deb(aTHX_ "Resolving method `%"SVf256\
1376 "' for overloaded `%s' in package `%.256s'\n",
1377 GvSV(gv), cp, HvNAME(stash)) );
1378 if (!SvPOK(GvSV(gv))
1379 || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
1382 /* Can be an import stub (created by `can'). */
1383 SV *gvsv = GvSV(gv);
1384 const char *name = SvPOK(gvsv) ? SvPVX(gvsv) : "???";
1385 Perl_croak(aTHX_ "%s method `%.256s' overloading `%s' "\
1386 "in package `%.256s'",
1387 (GvCVGEN(gv) ? "Stub found while resolving"
1389 name, cp, HvNAME(stash));
1391 cv = GvCV(gv = ngv);
1393 DEBUG_o( Perl_deb(aTHX_ "Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
1394 cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
1395 GvNAME(CvGV(cv))) );
1397 if (i < DESTROY_amg)
1399 } else if (gv) { /* Autoloaded... */
1403 amt.table[i]=(CV*)SvREFCNT_inc(cv);
1406 AMT_AMAGIC_on(&amt);
1408 AMT_OVERLOADED_on(&amt);
1409 sv_magic((SV*)stash, 0, PERL_MAGIC_overload_table,
1410 (char*)&amt, sizeof(AMT));
1414 /* Here we have no table: */
1416 AMT_AMAGIC_off(&amt);
1417 sv_magic((SV*)stash, 0, PERL_MAGIC_overload_table,
1418 (char*)&amt, sizeof(AMTS));
1424 Perl_gv_handler(pTHX_ HV *stash, I32 id)
1430 if (!stash || !HvNAME(stash))
1432 mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
1436 mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
1438 amtp = (AMT*)mg->mg_ptr;
1439 if ( amtp->was_ok_am != PL_amagic_generation
1440 || amtp->was_ok_sub != PL_sub_generation )
1442 if (AMT_AMAGIC(amtp)) {
1443 ret = amtp->table[id];
1444 if (ret && isGV(ret)) { /* Autoloading stab */
1445 /* Passing it through may have resulted in a warning
1446 "Inherited AUTOLOAD for a non-method deprecated", since
1447 our caller is going through a function call, not a method call.
1448 So return the CV for AUTOLOAD, setting $AUTOLOAD. */
1449 GV *gv = gv_fetchmethod(stash, (char*)PL_AMG_names[id]);
1462 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
1466 CV **cvp=NULL, **ocvp=NULL;
1467 AMT *amtp=NULL, *oamtp=NULL;
1468 int off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
1469 int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
1474 if (!(AMGf_noleft & flags) && SvAMAGIC(left)
1475 && (stash = SvSTASH(SvRV(left)))
1476 && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
1477 && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
1478 ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
1480 && ((cv = cvp[off=method+assignshift])
1481 || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
1487 cv = cvp[off=method])))) {
1488 lr = -1; /* Call method for left argument */
1490 if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
1493 /* look for substituted methods */
1494 /* In all the covered cases we should be called with assign==0. */
1498 if ((cv = cvp[off=add_ass_amg])
1499 || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) {
1500 right = &PL_sv_yes; lr = -1; assign = 1;
1505 if ((cv = cvp[off = subtr_ass_amg])
1506 || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) {
1507 right = &PL_sv_yes; lr = -1; assign = 1;
1511 (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg]));
1514 (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg]));
1517 (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg]));
1520 (void)((cv = cvp[off=bool__amg])
1521 || (cv = cvp[off=numer_amg])
1522 || (cv = cvp[off=string_amg]));
1528 * SV* ref causes confusion with the interpreter variable of
1531 SV* tmpRef=SvRV(left);
1532 if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) {
1534 * Just to be extra cautious. Maybe in some
1535 * additional cases sv_setsv is safe, too.
1537 SV* newref = newSVsv(tmpRef);
1538 SvOBJECT_on(newref);
1539 SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef));
1545 if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
1546 && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
1547 SV* nullsv=sv_2mortal(newSViv(0));
1549 SV* lessp = amagic_call(left,nullsv,
1550 lt_amg,AMGf_noright);
1551 logic = SvTRUE(lessp);
1553 SV* lessp = amagic_call(left,nullsv,
1554 ncmp_amg,AMGf_noright);
1555 logic = (SvNV(lessp) < 0);
1558 if (off==subtr_amg) {
1569 if ((cv = cvp[off=subtr_amg])) {
1571 left = sv_2mortal(newSViv(0));
1576 case iter_amg: /* XXXX Eventually should do to_gv. */
1578 return NULL; /* Delegate operation to standard mechanisms. */
1586 return left; /* Delegate operation to standard mechanisms. */
1591 if (!cv) goto not_found;
1592 } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
1593 && (stash = SvSTASH(SvRV(right)))
1594 && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
1595 && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
1596 ? (amtp = (AMT*)mg->mg_ptr)->table
1598 && (cv = cvp[off=method])) { /* Method for right
1601 } else if (((ocvp && oamtp->fallback > AMGfallNEVER
1602 && (cvp=ocvp) && (lr = -1))
1603 || (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
1604 && !(flags & AMGf_unary)) {
1605 /* We look for substitution for
1606 * comparison operations and
1608 if (method==concat_amg || method==concat_ass_amg
1609 || method==repeat_amg || method==repeat_ass_amg) {
1610 return NULL; /* Delegate operation to string conversion */
1620 postpr = 1; off=ncmp_amg; break;
1627 postpr = 1; off=scmp_amg; break;
1629 if (off != -1) cv = cvp[off];
1634 not_found: /* No method found, either report or croak */
1642 return left; /* Delegate operation to standard mechanisms. */
1645 if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */
1646 notfound = 1; lr = -1;
1647 } else if (cvp && (cv=cvp[nomethod_amg])) {
1648 notfound = 1; lr = 1;
1651 if (off==-1) off=method;
1652 msg = sv_2mortal(Perl_newSVpvf(aTHX_
1653 "Operation `%s': no method found,%sargument %s%s%s%s",
1654 AMG_id2name(method + assignshift),
1655 (flags & AMGf_unary ? " " : "\n\tleft "),
1657 "in overloaded package ":
1658 "has no overloaded magic",
1660 HvNAME(SvSTASH(SvRV(left))):
1663 ",\n\tright argument in overloaded package ":
1666 : ",\n\tright argument has no overloaded magic"),
1668 HvNAME(SvSTASH(SvRV(right))):
1670 if (amtp && amtp->fallback >= AMGfallYES) {
1671 DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX(msg)) );
1673 Perl_croak(aTHX_ "%"SVf, msg);
1677 force_cpy = force_cpy || assign;
1682 DEBUG_o(Perl_deb(aTHX_
1683 "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
1685 method+assignshift==off? "" :
1687 method+assignshift==off? "" :
1688 AMG_id2name(method+assignshift),
1689 method+assignshift==off? "" : "')",
1690 flags & AMGf_unary? "" :
1691 lr==1 ? " for right argument": " for left argument",
1692 flags & AMGf_unary? " for argument" : "",
1693 stash ? HvNAME(stash) : "null",
1694 fl? ",\n\tassignment variant used": "") );
1697 /* Since we use shallow copy during assignment, we need
1698 * to dublicate the contents, probably calling user-supplied
1699 * version of copy operator
1701 /* We need to copy in following cases:
1702 * a) Assignment form was called.
1703 * assignshift==1, assign==T, method + 1 == off
1704 * b) Increment or decrement, called directly.
1705 * assignshift==0, assign==0, method + 0 == off
1706 * c) Increment or decrement, translated to assignment add/subtr.
1707 * assignshift==0, assign==T,
1709 * d) Increment or decrement, translated to nomethod.
1710 * assignshift==0, assign==0,
1712 * e) Assignment form translated to nomethod.
1713 * assignshift==1, assign==T, method + 1 != off
1716 /* off is method, method+assignshift, or a result of opcode substitution.
1717 * In the latter case assignshift==0, so only notfound case is important.
1719 if (( (method + assignshift == off)
1720 && (assign || (method == inc_amg) || (method == dec_amg)))
1727 bool oldcatch = CATCH_GET;
1730 Zero(&myop, 1, BINOP);
1731 myop.op_last = (OP *) &myop;
1732 myop.op_next = Nullop;
1733 myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
1735 PUSHSTACKi(PERLSI_OVERLOAD);
1738 PL_op = (OP *) &myop;
1739 if (PERLDB_SUB && PL_curstash != PL_debstash)
1740 PL_op->op_private |= OPpENTERSUB_DB;
1744 EXTEND(SP, notfound + 5);
1745 PUSHs(lr>0? right: left);
1746 PUSHs(lr>0? left: right);
1747 PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no ));
1749 PUSHs( sv_2mortal(newSVpv(AMG_id2name(method + assignshift),0)));
1754 if ((PL_op = Perl_pp_entersub(aTHX)))
1762 CATCH_SET(oldcatch);
1769 ans=SvIV(res)<=0; break;
1772 ans=SvIV(res)<0; break;
1775 ans=SvIV(res)>=0; break;
1778 ans=SvIV(res)>0; break;
1781 ans=SvIV(res)==0; break;
1784 ans=SvIV(res)!=0; break;
1787 SvSetSV(left,res); return left;
1789 ans=!SvTRUE(res); break;
1792 } else if (method==copy_amg) {
1794 Perl_croak(aTHX_ "Copy method did not return a reference");
1796 return SvREFCNT_inc(SvRV(res));
1804 =for apidoc is_gv_magical
1806 Returns C<TRUE> if given the name of a magical GV.
1808 Currently only useful internally when determining if a GV should be
1809 created even in rvalue contexts.
1811 C<flags> is not used at present but available for future extension to
1812 allow selecting particular classes of magical variable.
1817 Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags)
1824 if (len == 3 && strEQ(name, "ISA"))
1828 if (len == 8 && strEQ(name, "OVERLOAD"))
1832 if (len == 3 && strEQ(name, "SIG"))
1835 case '\017': /* $^O & $^OPEN */
1837 || (len == 4 && strEQ(name, "\017PEN")))
1843 if (len > 1 && strEQ(name, "\025NICODE"))
1845 case '\027': /* $^W & $^WARNING_BITS */
1847 || (len == 12 && strEQ(name, "\027ARNING_BITS"))
1879 case '\001': /* $^A */
1880 case '\003': /* $^C */
1881 case '\004': /* $^D */
1882 case '\005': /* $^E */
1883 case '\006': /* $^F */
1884 case '\010': /* $^H */
1885 case '\011': /* $^I, NOT \t in EBCDIC */
1886 case '\014': /* $^L */
1887 case '\016': /* $^N */
1888 case '\020': /* $^P */
1889 case '\023': /* $^S */
1890 case '\026': /* $^V */
1894 case '\024': /* $^T, ${^TAINT} */
1895 if (len == 1 || strEQ(name, "\024AINT"))
1908 char *end = name + len;
1909 while (--end > name) {