Change 23665 by [EMAIL PROTECTED] on 2004/12/21 18:26:15
Integrate:
[ 23587]
Tidy up the reference name stringification to save getting the
hash name twice. Pleasant side effect is 44 byte smaller object
file. (A small win is still a win)
[ 23602]
Pull out the duplicateded push @INC, $_ if -e $_ code from
S_pushinc into a new function S_pushinc_if_exists
Avoid the SV copy when pushing onto @INC by creating a new scratch
SV each time a push is done.
[ 23603]
Fix a typo in an assert(). It helps to compile with -DDEBUGGING
[ 23604]
There are clearer ways of saying m/^[ab]$/ than strchr("ab", c)
They seem to produce slightly smaller object code too.
[ 23605]
Small code tidy up in gv_fullname4
[ 23606]
use (c == '$' || c == '@' || c == '%') instead of strchr("[EMAIL
PROTECTED]", c)
The latter gives larger code, is less clear and can't be any faster
[ 23607]
Remove double checking of acceptable switches on tr/// ops.
[ 23609]
gv_fullname4() can get rid of the main:: for us.
(well, actually, it never puts it in)
[ 23612]
Turn gv_fullname3 and gv_efullname3 into macros that call
gv_fullname4 and gv_efullname4 directly, saving overhead.
[ 23614]
Remove spurious semicolons
(As these 2 are spare, I guess I should send them to Mark Rhodes
(former office mate) as he often said that he kept mislaying his)
[ 23617]
Break out setting $^X into its own static function S_set_caret_X
[ 23623]
Revert part of the change to gv_fullname4(), as the change seems to
be fractionally slower. Re-investigation prompted by a comment from
Tim Bunce, who seems to be more on the ball than I am.
[ 23626]
Avoid getting the stash name twice (at least visually, if not also
in the generated code)
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#56 integrate
... //depot/maint-5.8/perl/embed.h#53 integrate
... //depot/maint-5.8/perl/gv.c#22 integrate
... //depot/maint-5.8/perl/gv.h#5 integrate
... //depot/maint-5.8/perl/op.c#69 integrate
... //depot/maint-5.8/perl/perl.c#94 integrate
... //depot/maint-5.8/perl/proto.h#47 integrate
... //depot/maint-5.8/perl/sv.c#119 integrate
... //depot/maint-5.8/perl/toke.c#51 integrate
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#56 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#55~23585~ Wed Dec 1 05:52:46 2004
+++ perl/embed.fnc Tue Dec 21 10:26:15 2004
@@ -258,7 +258,7 @@
|I32 method
Ap |void |gv_check |HV* stash
Ap |void |gv_efullname |SV* sv|GV* gv
-Ap |void |gv_efullname3 |SV* sv|GV* gv|const char* prefix
+Amb |void |gv_efullname3 |SV* sv|GV* gv|const char* prefix
Ap |void |gv_efullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain
Ap |GV* |gv_fetchfile |const char* name
Apd |GV* |gv_fetchmeth |HV* stash|const char* name|STRLEN len \
@@ -270,7 +270,7 @@
|I32 autoload
Ap |GV* |gv_fetchpv |const char* name|I32 add|I32 sv_type
Ap |void |gv_fullname |SV* sv|GV* gv
-Ap |void |gv_fullname3 |SV* sv|GV* gv|const char* prefix
+Amb |void |gv_fullname3 |SV* sv|GV* gv|const char* prefix
Ap |void |gv_fullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain
Ap |void |gv_init |GV* gv|HV* stash|const char* name \
|STRLEN len|int multi
==== //depot/maint-5.8/perl/embed.h#53 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#52~23582~ Wed Dec 1 05:28:06 2004
+++ perl/embed.h Tue Dec 21 10:26:15 2004
@@ -322,7 +322,6 @@
#define gv_autoload4 Perl_gv_autoload4
#define gv_check Perl_gv_check
#define gv_efullname Perl_gv_efullname
-#define gv_efullname3 Perl_gv_efullname3
#define gv_efullname4 Perl_gv_efullname4
#define gv_fetchfile Perl_gv_fetchfile
#define gv_fetchmeth Perl_gv_fetchmeth
@@ -331,7 +330,6 @@
#define gv_fetchmethod_autoload Perl_gv_fetchmethod_autoload
#define gv_fetchpv Perl_gv_fetchpv
#define gv_fullname Perl_gv_fullname
-#define gv_fullname3 Perl_gv_fullname3
#define gv_fullname4 Perl_gv_fullname4
#define gv_init Perl_gv_init
#define gv_stashpv Perl_gv_stashpv
@@ -2857,7 +2855,6 @@
#define gv_autoload4(a,b,c,d) Perl_gv_autoload4(aTHX_ a,b,c,d)
#define gv_check(a) Perl_gv_check(aTHX_ a)
#define gv_efullname(a,b) Perl_gv_efullname(aTHX_ a,b)
-#define gv_efullname3(a,b,c) Perl_gv_efullname3(aTHX_ a,b,c)
#define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d)
#define gv_fetchfile(a) Perl_gv_fetchfile(aTHX_ a)
#define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d)
@@ -2866,7 +2863,6 @@
#define gv_fetchmethod_autoload(a,b,c) Perl_gv_fetchmethod_autoload(aTHX_
a,b,c)
#define gv_fetchpv(a,b,c) Perl_gv_fetchpv(aTHX_ a,b,c)
#define gv_fullname(a,b) Perl_gv_fullname(aTHX_ a,b)
-#define gv_fullname3(a,b,c) Perl_gv_fullname3(aTHX_ a,b,c)
#define gv_fullname4(a,b,c,d) Perl_gv_fullname4(aTHX_ a,b,c,d)
#define gv_init(a,b,c,d,e) Perl_gv_init(aTHX_ a,b,c,d,e)
#define gv_stashpv(a,b) Perl_gv_stashpv(aTHX_ a,b)
==== //depot/maint-5.8/perl/gv.c#22 (text) ====
Index: perl/gv.c
--- perl/gv.c#21~23625~ Tue Dec 7 15:09:13 2004
+++ perl/gv.c Tue Dec 21 10:26:15 2004
@@ -751,7 +751,8 @@
sv_type != SVt_PVGV &&
sv_type != SVt_PVFM &&
sv_type != SVt_PVIO &&
- !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
+ !(len == 1 && sv_type == SVt_PV &&
+ (*name == 'a' || *name == 'b')) )
{
gvp = (GV**)hv_fetch(stash,name,len,0);
if (!gvp ||
@@ -1103,10 +1104,10 @@
}
sv_setpv(sv, prefix ? prefix : "");
- if (!HvNAME(hv))
+ name = HvNAME(hv);
+ if (!name)
name = "__ANON__";
- else
- name = HvNAME(hv);
+
if (keepmain || strNE(name, "main")) {
sv_catpv(sv,name);
sv_catpvn(sv,"::", 2);
==== //depot/maint-5.8/perl/gv.h#5 (text) ====
Index: perl/gv.h
--- perl/gv.h#4~19400~ Sun May 4 01:29:43 2003
+++ perl/gv.h Tue Dec 21 10:26:15 2004
@@ -153,3 +153,6 @@
#define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there
*/
#define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval
*/
#define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV
*/
+
+#define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE)
+#define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE)
==== //depot/maint-5.8/perl/op.c#69 (text) ====
Index: perl/op.c
--- perl/op.c#68~23582~ Wed Dec 1 05:28:06 2004
+++ perl/op.c Tue Dec 21 10:26:15 2004
@@ -6264,9 +6264,7 @@
OP *sibling = o2->op_sibling;
SV *n = newSVpvn("",0);
op_free(o2);
- gv_fullname3(n, gv, "");
- if (SvCUR(n)>6 && strnEQ(SvPVX(n),"main::",6))
- sv_chop(n, SvPVX(n)+6);
+ gv_fullname4(n, gv, "", FALSE);
o2 = newSVOP(OP_CONST, 0, n);
prev->op_sibling = o2;
o2->op_sibling = sibling;
==== //depot/maint-5.8/perl/perl.c#94 (text) ====
Index: perl/perl.c
--- perl/perl.c#93~23529~ Tue Nov 23 07:17:07 2004
+++ perl/perl.c Tue Dec 21 10:26:15 2004
@@ -3560,7 +3560,8 @@
/* Sanity check on buffer end */
while ((*s) && !isSPACE(*s)) s++;
for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 &&
- (isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ;
+ (isDIGIT(s2[-1]) || s2[-1] == '.' || s2[-1] == '_'
+ || s2[-1] == '-')); s2--) ;
/* Sanity check on buffer start */
if ( (s2-4 < SvPV(PL_linestr,n_a)+2 || strnNE(s2-4,"perl",4)) &&
(s-9 < SvPV(PL_linestr,n_a)+2 || strnNE(s-9,"perl",4)) )
@@ -3847,7 +3848,8 @@
s2 = s;
while (*s == ' ' || *s == '\t') s++;
if (*s++ == '-') {
- while (isDIGIT(s2[-1]) || strchr("-._", s2[-1])) s2--;
+ while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
+ || s2[-1] == '_') s2--;
if (strnEQ(s2-4,"perl",4))
/*SUPPRESS 530*/
while ((s = moreswitches(s)))
@@ -4185,6 +4187,22 @@
#endif /* HAS_PROCSELFEXE */
STATIC void
+S_set_caret_X(pTHX) {
+ GV* tmpgv = gv_fetchpv("\030",TRUE, SVt_PV); /* $^X */
+ if (tmpgv) {
+#ifdef HAS_PROCSELFEXE
+ S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
+#else
+#ifdef OS2
+ sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
+#else
+ sv_setpv(GvSV(tmpgv),PL_origargv[0]);
+#endif
+#endif
+ }
+}
+
+STATIC void
S_init_postdump_symbols(pTHX_ register int argc, register char **argv,
register char **env)
{
char *s;
@@ -4212,17 +4230,7 @@
magicname("0", "0", 1);
#endif
}
- if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */
-#ifdef HAS_PROCSELFEXE
- S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
-#else
-#ifdef OS2
- sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
-#else
- sv_setpv(GvSV(tmpgv),PL_origargv[0]);
-#endif
-#endif
- }
+ S_set_caret_X(aTHX);
if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {
HV *hv;
GvMULTI_on(PL_envgv);
@@ -4420,6 +4428,21 @@
# define PERLLIB_MANGLE(s,n) (s)
#endif
+/* Push a directory onto @INC if it exists.
+ Generate a new SV if we do this, to save needing to copy the SV we push
+ onto @INC */
+STATIC SV *
+S_incpush_if_exists(pTHX_ SV *dir)
+{
+ Stat_t tmpstatbuf;
+ if (PerlLIO_stat(SvPVX(dir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode)) {
+ av_push(GvAVn(PL_incgv), dir);
+ dir = NEWSV(0,0);
+ }
+ return dir;
+}
+
STATIC void
S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers, int usesep)
{
@@ -4429,7 +4452,7 @@
return;
if (addsubdirs || addoldvers) {
- subdir = sv_newmortal();
+ subdir = NEWSV(0,0);
}
/* Break at all separators */
@@ -4475,7 +4498,6 @@
const char *incverlist[] = { PERL_INC_VERSION_LIST };
const char **incver;
#endif
- Stat_t tmpstatbuf;
#ifdef VMS
char *unix;
STRLEN len;
@@ -4505,23 +4527,18 @@
libdir,
(int)PERL_REVISION, (int)PERL_VERSION,
(int)PERL_SUBVERSION, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ subdir = S_incpush_if_exists(aTHX_ subdir);
/* .../version if -d .../version */
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH, libdir,
(int)PERL_REVISION, (int)PERL_VERSION,
(int)PERL_SUBVERSION);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ subdir = S_incpush_if_exists(aTHX_ subdir);
/* .../archname if -d .../archname */
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir,
ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ subdir = S_incpush_if_exists(aTHX_ subdir);
+
}
#ifdef PERL_INC_VERSION_LIST
@@ -4529,9 +4546,7 @@
for (incver = incverlist; *incver; incver++) {
/* .../xxx if -d .../xxx */
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir,
*incver);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ subdir = S_incpush_if_exists(aTHX_ subdir);
}
}
#endif
@@ -4539,6 +4554,10 @@
/* finally push this lib directory on the end of @INC */
av_push(GvAVn(PL_incgv), libdir);
+ }
+ if (subdir) {
+ assert (SvREFCNT(subdir) == 1);
+ SvREFCNT_dec(subdir);
}
}
==== //depot/maint-5.8/perl/proto.h#47 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#46~23585~ Wed Dec 1 05:52:46 2004
+++ perl/proto.h Tue Dec 21 10:26:15 2004
@@ -241,7 +241,7 @@
PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name,
STRLEN len, I32 method);
PERL_CALLCONV void Perl_gv_check(pTHX_ HV* stash);
PERL_CALLCONV void Perl_gv_efullname(pTHX_ SV* sv, GV* gv);
-PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char*
prefix);
+/* PERL_CALLCONV void gv_efullname3(pTHX_ SV* sv, GV* gv, const char*
prefix); */
PERL_CALLCONV void Perl_gv_efullname4(pTHX_ SV* sv, GV* gv, const char*
prefix, bool keepmain);
PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name);
PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name,
STRLEN len, I32 level);
@@ -250,7 +250,7 @@
PERL_CALLCONV GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const
char* name, I32 autoload);
PERL_CALLCONV GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32
sv_type);
PERL_CALLCONV void Perl_gv_fullname(pTHX_ SV* sv, GV* gv);
-PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char*
prefix);
+/* PERL_CALLCONV void gv_fullname3(pTHX_ SV* sv, GV* gv, const char* prefix);
*/
PERL_CALLCONV void Perl_gv_fullname4(pTHX_ SV* sv, GV* gv, const char*
prefix, bool keepmain);
PERL_CALLCONV void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name,
STRLEN len, int multi);
PERL_CALLCONV HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create);
==== //depot/maint-5.8/perl/sv.c#119 (text) ====
Index: perl/sv.c
--- perl/sv.c#118~23625~ Tue Dec 7 15:09:13 2004
+++ perl/sv.c Tue Dec 21 10:26:15 2004
@@ -3126,14 +3126,13 @@
default: s = "UNKNOWN"; break;
}
tsv = NEWSV(0,0);
- if (SvOBJECT(sv))
- if (HvNAME(SvSTASH(sv)))
- Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)),
s);
- else
- Perl_sv_setpvf(aTHX_ tsv, "__ANON__=%s", s);
+ if (SvOBJECT(sv)) {
+ const char *name = HvNAME(SvSTASH(sv));
+ Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
+ name ? name : "__ANON__" , s, PTR2UV(sv));
+ }
else
- sv_setpv(tsv, s);
- Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
+ Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", s, PTR2UV(sv));
goto tokensaveref;
}
*lp = strlen(s);
@@ -7613,10 +7612,8 @@
Perl_sv_reftype(pTHX_ SV *sv, int ob)
{
if (ob && SvOBJECT(sv)) {
- if (HvNAME(SvSTASH(sv)))
- return HvNAME(SvSTASH(sv));
- else
- return "__ANON__";
+ char *name = HvNAME(SvSTASH(sv));
+ return name ? name : "__ANON__";
}
else {
switch (SvTYPE(sv)) {
==== //depot/maint-5.8/perl/toke.c#51 (text) ====
Index: perl/toke.c
--- perl/toke.c#50~23625~ Tue Dec 7 15:09:13 2004
+++ perl/toke.c Tue Dec 21 10:26:15 2004
@@ -1837,8 +1837,10 @@
weight -= 5; /* cope with negative subscript */
break;
default:
- if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
- isALPHA(*s) && s[1] && isALPHA(s[1])) {
+ if (!isALNUM(last_un_char)
+ && !(last_un_char == '$' || last_un_char == '@'
+ || last_un_char == '&')
+ && isALPHA(*s) && s[1] && isALPHA(s[1])) {
char *d = tmpbuf;
while (isALPHA(*s))
*d++ = *s++;
@@ -2245,7 +2247,8 @@
oldmod = PL_lex_casestack[--PL_lex_casemods];
PL_lex_casestack[PL_lex_casemods] = '\0';
- if (PL_bufptr != PL_bufend && strchr("LUQ", oldmod)) {
+ if (PL_bufptr != PL_bufend
+ && (oldmod == 'L' || oldmod == 'U' || oldmod == 'Q')) {
PL_bufptr += 2;
PL_lex_state = LEX_INTERPCONCAT;
}
@@ -2268,7 +2271,7 @@
else {
if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
tmp = *s, *s = s[2], s[2] = (char)tmp; /*
misordered... */
- if (strchr("LU", *s) &&
+ if ((*s == 'L' || *s == 'U') &&
(strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack,
'U'))) {
PL_lex_casestack[--PL_lex_casemods] = '\0';
return ')';
@@ -2462,7 +2465,8 @@
sv_catpv(PL_linestr,"chomp;");
if (PL_minus_a) {
if (PL_minus_F) {
- if (strchr("/'\"", *PL_splitstr)
+ if ((*PL_splitstr == '/' || *PL_splitstr == '\''
+ || *PL_splitstr == '"')
&& strchr(PL_splitstr + 1, *PL_splitstr))
Perl_sv_catpvf(aTHX_ PL_linestr, "our
@F=split(%s);", PL_splitstr);
else {
@@ -3575,7 +3579,8 @@
PL_expect = XTERM; /* e.g. print $fh 3 */
else if (*s == '.' && isDIGIT(s[1]))
PL_expect = XTERM; /* e.g. print $fh .3 */
- else if (strchr("/?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
+ else if ((*s == '?' || *s == '-' || *s == '+')
+ && !isSPACE(s[1]) && s[1] != '=')
PL_expect = XTERM; /* e.g. print $fh -1 */
else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
PL_expect = XTERM; /* print $fh <<"EOF" */
@@ -4109,7 +4114,8 @@
}
safe_bareword:
- if (lastchar && strchr("*%&", lastchar) &&
ckWARN_d(WARN_AMBIGUOUS)) {
+ if ((lastchar == '*' || lastchar == '%' || lastchar == '&')
+ && ckWARN_d(WARN_AMBIGUOUS)) {
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Operator or semicolon missing before %c%s",
lastchar, PL_tokenbuf);
@@ -6241,7 +6247,7 @@
return s;
}
if (*s == '$' && s[1] &&
- (isALNUM_lazy_if(s+1,UTF) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
+ (isALNUM_lazy_if(s+1,UTF) || s[1] == '$' || s[1] == '{' ||
strnEQ(s+1,"::",2)) )
{
return s;
}
@@ -6494,15 +6500,23 @@
}
complement = del = squash = 0;
- while (strchr("cds", *s)) {
- if (*s == 'c')
+ while (1) {
+ switch (*s) {
+ case 'c':
complement = OPpTRANS_COMPLEMENT;
- else if (*s == 'd')
+ break;
+ case 'd':
del = OPpTRANS_DELETE;
- else if (*s == 's')
+ break;
+ case 's':
squash = OPpTRANS_SQUASH;
+ break;
+ default:
+ goto no_more;
+ }
s++;
}
+ no_more:
New(803, tbl, complement&&!del?258:256, short);
o = newPVOP(OP_TRANS, 0, (char*)tbl);
@@ -6534,7 +6548,7 @@
if (!outer)
*d++ = '\n';
for (peek = s; SPACE_OR_TAB(*peek); peek++) ;
- if (*peek && strchr("`'\"",*peek)) {
+ if (*peek == '`' || *peek == '\'' || *peek =='"') {
s = peek;
term = *s++;
s = delimcpy(d, e, s, PL_bufend, term, &len);
@@ -7493,7 +7507,7 @@
}
/* read exponent part, if present */
- if (*s && strchr("eE",*s) && strchr("+-0123456789_", s[1])) {
+ if ((*s == 'e' || *s == 'E') && strchr("+-0123456789_", s[1])) {
floatit = TRUE;
s++;
End of Patch.
