diff options
| -rw-r--r-- | cop.h | 3 | ||||
| -rw-r--r-- | embed.fnc | 5 | ||||
| -rw-r--r-- | embed.h | 4 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | gv.c | 24 | ||||
| -rw-r--r-- | pod/perlapi.pod | 12 | ||||
| -rw-r--r-- | proto.h | 10 | ||||
| -rw-r--r-- | toke.c | 17 | ||||
| -rw-r--r-- | util.c | 21 |
9 files changed, 78 insertions, 20 deletions
@@ -160,8 +160,10 @@ struct cop { # 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 @@ struct cop { # 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 @@ -278,6 +278,8 @@ Ap |void |gv_efullname |NN SV* sv|NN const GV* gv 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 @@ p |I32 |same_dirent |NN const char* a|NN const char* b 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 @@ s |void |checkcomma |NN const char *s|NN const char *name \ |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 @@ -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) diff --git a/global.sym b/global.sym index 4ab45b56a0..449063aa8d 100644 --- a/global.sym +++ b/global.sym @@ -133,6 +133,7 @@ Perl_gv_efullname 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_rsignal_state Perl_savepv Perl_savepvn Perl_savesharedpv +Perl_savesharedpvn Perl_savesvpv Perl_savestack_grow Perl_savestack_grow_cnt @@ -104,31 +104,39 @@ 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[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); diff --git a/pod/perlapi.pod b/pod/perlapi.pod index d2259d5234..1ce3684370 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2323,6 +2323,18 @@ which is shared between threads. =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> @@ -624,6 +624,9 @@ PERL_CALLCONV void Perl_gv_efullname4(pTHX_ SV* sv, const GV* gv, const char* pr 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 @@ PERL_CALLCONV char* Perl_savesharedpv(pTHX_ const char* pv) __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 bool S_feature_is_enabled(pTHX_ const char* name, STRLEN namelen) 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) @@ -735,13 +735,12 @@ Perl_lex_end(pTHX) */ 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 @@ S_incline(pTHX_ char *s) 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 @@ S_incline(pTHX_ char *s) 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 @@ S_incline(pTHX_ char *s) } #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); } @@ -953,6 +953,27 @@ Perl_savesharedpv(pTHX_ const char *pv) } /* +=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 |