Change 30015 by [EMAIL PROTECTED] on 2007/01/26 16:16:29
Stop S_incline needing to temporarily write a '\0' into its passed-in
buffer. (Requires adding gv_fetchfile_flags(), savesharedpvn() and
CopFILE_setn() to provide pointer/length versions of APIs)
Affected files ...
... //depot/perl/cop.h#138 edit
... //depot/perl/embed.fnc#456 edit
... //depot/perl/embed.h#660 edit
... //depot/perl/global.sym#322 edit
... //depot/perl/gv.c#351 edit
... //depot/perl/pod/perlapi.pod#281 edit
... //depot/perl/proto.h#794 edit
... //depot/perl/toke.c#742 edit
... //depot/perl/util.c#611 edit
Differences ...
==== //depot/perl/cop.h#138 (text) ====
Index: perl/cop.h
--- perl/cop.h#137~29922~ 2007-01-22 11:38:12.000000000 -0800
+++ perl/cop.h 2007-01-26 08:16:29.000000000 -0800
@@ -160,8 +160,10 @@
# ifdef NETWARE
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepv((pv),(l)))
# else
# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
+# define CopFILE_setn(c,pv,l) ((c)->cop_file = savesharedpvn((pv),(l)))
# endif
# define CopFILESV(c) (CopFILE(c) \
@@ -203,6 +205,7 @@
# define CopFILEGV(c) ((c)->cop_filegv)
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+# define CopFILE_setn(c,pv,l) CopFILEGV_set((c),
gv_fetchfile_flags((pv),(l),0))
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
# ifdef DEBUGGING
==== //depot/perl/embed.fnc#456 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#455~29977~ 2007-01-25 12:57:56.000000000 -0800
+++ perl/embed.fnc 2007-01-26 08:16:29.000000000 -0800
@@ -278,6 +278,8 @@
Apmb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char*
prefix
Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char*
prefix|bool keepmain
Ap |GV* |gv_fetchfile |NN const char* name
+Ap |GV* |gv_fetchfile_flags|NN const char *const name|const STRLEN len\
+ |const U32 flags
Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN
len|I32 level
Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char*
name|STRLEN len|I32 level
Apdmb |GV* |gv_fetchmethod |NULLOK HV* stash|NN const char* name
@@ -704,6 +706,7 @@
Apda |char* |savepv |NULLOK const char* pv
Apda |char* |savepvn |NULLOK const char* pv|I32 len
Apda |char* |savesharedpv |NULLOK const char* pv
+Apda |char* |savesharedpvn |NN const char *const pv|const STRLEN len
Apda |char* |savesvpv |NN SV* sv
Ap |void |savestack_grow
Ap |void |savestack_grow_cnt |I32 need
@@ -1488,7 +1491,7 @@
|NN const char *what
s |bool |feature_is_enabled|NN const char* name|STRLEN namelen
s |void |force_ident |NN const char *s|int kind
-s |void |incline |NN char *s
+s |void |incline |NN const char *s
s |int |intuit_method |NN char *s|NULLOK GV *gv|NULLOK CV *cv
s |int |intuit_more |NN char *s
s |I32 |lop |I32 f|int x|NN char *s
==== //depot/perl/embed.h#660 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#659~29905~ 2007-01-21 03:44:16.000000000 -0800
+++ perl/embed.h 2007-01-26 08:16:29.000000000 -0800
@@ -266,6 +266,7 @@
#define gv_efullname Perl_gv_efullname
#define gv_efullname4 Perl_gv_efullname4
#define gv_fetchfile Perl_gv_fetchfile
+#define gv_fetchfile_flags Perl_gv_fetchfile_flags
#define gv_fetchmeth Perl_gv_fetchmeth
#define gv_fetchmeth_autoload Perl_gv_fetchmeth_autoload
#define gv_fetchmethod_autoload Perl_gv_fetchmethod_autoload
@@ -718,6 +719,7 @@
#define savepv Perl_savepv
#define savepvn Perl_savepvn
#define savesharedpv Perl_savesharedpv
+#define savesharedpvn Perl_savesharedpvn
#define savesvpv Perl_savesvpv
#define savestack_grow Perl_savestack_grow
#define savestack_grow_cnt Perl_savestack_grow_cnt
@@ -2469,6 +2471,7 @@
#define gv_efullname(a,b) Perl_gv_efullname(aTHX_ a,b)
#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_fetchfile_flags(a,b,c) Perl_gv_fetchfile_flags(aTHX_ a,b,c)
#define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d)
#define gv_fetchmeth_autoload(a,b,c,d) Perl_gv_fetchmeth_autoload(aTHX_
a,b,c,d)
#define gv_fetchmethod_autoload(a,b,c) Perl_gv_fetchmethod_autoload(aTHX_
a,b,c)
@@ -2927,6 +2930,7 @@
#define savepv(a) Perl_savepv(aTHX_ a)
#define savepvn(a,b) Perl_savepvn(aTHX_ a,b)
#define savesharedpv(a) Perl_savesharedpv(aTHX_ a)
+#define savesharedpvn(a,b) Perl_savesharedpvn(aTHX_ a,b)
#define savesvpv(a) Perl_savesvpv(aTHX_ a)
#define savestack_grow() Perl_savestack_grow(aTHX)
#define savestack_grow_cnt(a) Perl_savestack_grow_cnt(aTHX_ a)
==== //depot/perl/global.sym#322 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#321~29853~ 2007-01-17 10:24:50.000000000 -0800
+++ perl/global.sym 2007-01-26 08:16:29.000000000 -0800
@@ -133,6 +133,7 @@
Perl_gv_efullname3
Perl_gv_efullname4
Perl_gv_fetchfile
+Perl_gv_fetchfile_flags
Perl_gv_fetchmeth
Perl_gv_fetchmeth_autoload
Perl_gv_fetchmethod
@@ -406,6 +407,7 @@
Perl_savepv
Perl_savepvn
Perl_savesharedpv
+Perl_savesharedpvn
Perl_savesvpv
Perl_savestack_grow
Perl_savestack_grow_cnt
==== //depot/perl/gv.c#351 (text) ====
Index: perl/gv.c
--- perl/gv.c#350~30000~ 2007-01-26 03:18:02.000000000 -0800
+++ perl/gv.c 2007-01-26 08:16:29.000000000 -0800
@@ -104,31 +104,39 @@
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[128];
char *tmpbuf;
- STRLEN tmplen;
+ const STRLEN tmplen = namelen + 2;
GV *gv;
+ PERL_UNUSED_ARG(flags);
+
if (!PL_defstash)
return NULL;
- tmplen = strlen(name);
- if (tmplen + 2 <= sizeof smallbuf)
+ if (tmplen <= sizeof smallbuf)
tmpbuf = smallbuf;
else
Newx(tmpbuf, tmplen, char);
/* This is where the debugger's %{"::_<$filename"} hash is created */
tmpbuf[0] = '_';
tmpbuf[1] = '<';
- memcpy(tmpbuf + 2, name, tmplen);
- gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen + 2, TRUE);
+ memcpy(tmpbuf + 2, name, namelen);
+ gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
if (!isGV(gv)) {
- gv_init(gv, PL_defstash, tmpbuf, tmplen + 2, FALSE);
+ gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
#ifdef PERL_DONT_CREATE_GVSV
- GvSV(gv) = newSVpvn(name, tmplen);
+ GvSV(gv) = newSVpvn(name, namelen);
#else
- sv_setpvn(GvSV(gv), name, tmplen);
+ sv_setpvn(GvSV(gv), name, namelen);
#endif
if (PERLDB_LINE)
hv_magic(GvHVn(gv_AVadd(gv)), NULL, PERL_MAGIC_dbfile);
==== //depot/perl/pod/perlapi.pod#281 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod#280~29977~ 2007-01-25 12:57:56.000000000 -0800
+++ perl/pod/perlapi.pod 2007-01-26 08:16:29.000000000 -0800
@@ -2323,6 +2323,18 @@
=for hackers
Found in file util.c
+=item savesharedpvn
+X<savesharedpvn>
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+ char* savesharedpvn(const char *const pv, const STRLEN len)
+
+=for hackers
+Found in file util.c
+
=item savesvpv
X<savesvpv>
==== //depot/perl/proto.h#794 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#793~29977~ 2007-01-25 12:57:56.000000000 -0800
+++ perl/proto.h 2007-01-26 08:16:29.000000000 -0800
@@ -624,6 +624,9 @@
PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name)
__attribute__nonnull__(pTHX_1);
+PERL_CALLCONV GV* Perl_gv_fetchfile_flags(pTHX_ const char *const name,
const STRLEN len, const U32 flags)
+ __attribute__nonnull__(pTHX_1);
+
PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name,
STRLEN len, I32 level)
__attribute__nonnull__(pTHX_2);
@@ -1930,6 +1933,11 @@
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV char* Perl_savesharedpvn(pTHX_ const char *const pv, const
STRLEN len)
+ __attribute__malloc__
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+
PERL_CALLCONV char* Perl_savesvpv(pTHX_ SV* sv)
__attribute__malloc__
__attribute__warn_unused_result__
@@ -3991,7 +3999,7 @@
STATIC void S_force_ident(pTHX_ const char *s, int kind)
__attribute__nonnull__(pTHX_1);
-STATIC void S_incline(pTHX_ char *s)
+STATIC void S_incline(pTHX_ const char *s)
__attribute__nonnull__(pTHX_1);
STATIC int S_intuit_method(pTHX_ char *s, GV *gv, CV *cv)
==== //depot/perl/toke.c#742 (text) ====
Index: perl/toke.c
--- perl/toke.c#741~30000~ 2007-01-26 03:18:02.000000000 -0800
+++ perl/toke.c 2007-01-26 08:16:29.000000000 -0800
@@ -735,13 +735,12 @@
*/
STATIC void
-S_incline(pTHX_ char *s)
+S_incline(pTHX_ const char *s)
{
dVAR;
- char *t;
- char *n;
- char *e;
- char ch;
+ const char *t;
+ const char *n;
+ const char *e;
CopLINE_inc(PL_curcop);
if (*s++ != '#')
@@ -781,9 +780,8 @@
if (*e != '\n' && *e != '\0')
return; /* false alarm */
- ch = *t;
- *t = '\0';
if (t - s > 0) {
+ const STRLEN len = t - s;
#ifndef USE_ITHREADS
const char * const cf = CopFILE(PL_curcop);
STRLEN tmplen = cf ? strlen(cf) : 0;
@@ -793,7 +791,7 @@
char smallbuf[128], smallbuf2[128];
char *tmpbuf, *tmpbuf2;
GV **gvp, *gv2;
- STRLEN tmplen2 = strlen(s);
+ STRLEN tmplen2 = len;
if (tmplen + 2 <= sizeof smallbuf)
tmpbuf = smallbuf;
else
@@ -823,9 +821,8 @@
}
#endif
CopFILE_free(PL_curcop);
- CopFILE_set(PL_curcop, s);
+ CopFILE_setn(PL_curcop, s, len);
}
- *t = ch;
CopLINE_set(PL_curcop, atoi(n)-1);
}
==== //depot/perl/util.c#611 (text) ====
Index: perl/util.c
--- perl/util.c#610~29692~ 2007-01-05 01:45:08.000000000 -0800
+++ perl/util.c 2007-01-26 08:16:29.000000000 -0800
@@ -953,6 +953,27 @@
}
/*
+=for apidoc savesharedpvn
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+=cut
+*/
+char *
+Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
+{
+ char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
+ assert(pv);
+ if (!newaddr) {
+ return write_no_mem();
+ }
+ newaddr[len] = '\0';
+ return (char*)memcpy(newaddr, pv, len);
+}
+
+/*
=for apidoc savesvpv
A version of C<savepv()>/C<savepvn()> which gets the string to duplicate from
End of Patch.
