Add my_memrchr() implementation of memrchr()

On platforms that have memrchr(), my_mrchr() maps to use that instead.

This is useful functionality, lacking on many platforms.  This commit
also uses the new function in two places in the core where the comments
previously indicated it would be advantageous to use it if we had it.

It is left usable only in core, so that if this turns out to have been a
bad idea, it can be easily removed.

diff --git a/embed.fnc b/embed.fnc
index 434f225..3860958 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1066,6 +1066,9 @@ Anp       |void   |atfork_lock
 Anp    |void   |atfork_unlock
 Apmb   |I32    |my_lstat
 pX     |I32    |my_lstat_flags |NULLOK const U32 flags
+#if ! defined(HAS_MEMRCHR) && (defined(PERL_CORE) || defined(PERL_EXT))
+Exin   |void * |my_memrchr     |NN const char * s|const char c|const STRLEN len
+#endif
 #if !defined(PERL_IMPLICIT_SYS)
 Ap     |I32    |my_pclose      |NULLOK PerlIO* ptr
 Ap     |PerlIO*|my_popen       |NN const char* cmd|NN const char* mode

diff --git a/embed.h b/embed.h
index cd5ff23..5900678 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -942,6 +942,9 @@
 #define validate_proto(a,b,c,d)        Perl_validate_proto(aTHX_ a,b,c,d)
 #define vivify_defelem(a)      Perl_vivify_defelem(aTHX_ a)
 #define yylex()                        Perl_yylex(aTHX)
+#  if ! defined(HAS_MEMRCHR) && (defined(PERL_CORE) || defined(PERL_EXT))
+#define my_memrchr             S_my_memrchr
+#  endif
 #  if !defined(PERL_EXT_RE_BUILD)
 #    if defined(PERL_IN_REGCOMP_C)
 #define _append_range_to_invlist(a,b,c)        S__append_range_to_invlist(aTHX_ a,b,c)

diff --git a/inline.h b/inline.h
index 96a68ea..2f67af8 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -1762,6 +1762,29 @@ Perl_foldEQ_locale(const char *s1, const char *s2, I32 len)
     return 1;
 }
 
+#if ! defined (HAS_MEMRCHR) && (defined(PERL_CORE) || defined(PERL_EXT))
+
+PERL_STATIC_INLINE void *
+S_my_memrchr(const char * s, const char c, const STRLEN len)
+{
+    /* memrchr(), since many platforms lack it */
+
+    const char * t = s + len - 1;
+
+    PERL_ARGS_ASSERT_MY_MEMRCHR;
+
+    while (t >= s) {
+        if (*t == c) {
+            return (void *) t;
+        }
+        t--;
+    }
+
+    return NULL;
+}
+
+#endif
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */

diff --git a/perl.c b/perl.c
index 25e66f0..9f3898d 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -4825,12 +4825,9 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags)
                libpath = SvPVX(libdir);
                libpath_len = SvCUR(libdir);
 
-               /* This would work more efficiently with memrchr, but as it's
-                  only a GNU extension we'd need to probe for it and
-                  implement our own. Not hard, but maybe not worth it?  */
-
                prefix = SvPVX(prefix_sv);
-               lastslash = strrchr(prefix, '/');
+               lastslash = (char *) my_memrchr(prefix, '/',
+                             SvEND(prefix_sv) - prefix);
 
                /* First time in with the *lastslash = '\0' we just wipe off
                   the trailing /perl from (say) /usr/foo/bin/perl
@@ -4839,7 +4836,10 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags)
                    SV *tempsv;
                    while ((*lastslash = '\0'), /* Do that, come what may.  */
                            (libpath_len >= 3 && _memEQs(libpath, "../")
-                           && (lastslash = strrchr(prefix, '/')))) {
+                           && (lastslash =
+                                  (char *) my_memrchr(prefix, '/',
+                                                   SvEND(prefix_sv) - prefix))))
+                    {
                        if (lastslash[1] == '\0'
                            || (lastslash[1] == '.'
                                && (lastslash[2] == '/' /* ends "/."  */

diff --git a/perl.h b/perl.h
index f299835..00f3fe8 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1497,6 +1497,14 @@ EXTERN_C char *crypt(const char *, const char *);
 #  define my_strlcat    Perl_my_strlcat
 #endif
 
+#if defined(PERL_CORE) || defined(PERL_EXT)
+#  ifdef HAS_MEMRCHR
+#    define my_memrchr memrchr
+#  else
+#    define my_memrchr S_my_memrchr
+#  endif
+#endif
+
 #ifdef HAS_STRLCPY
 #  define my_strlcpy   strlcpy
 #else

diff --git a/proto.h b/proto.h
index c6a9b36..72c3a60 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3785,6 +3785,13 @@ PERL_CALLCONV int        Perl_yylex(pTHX);
 PERL_CALLCONV int      Perl_yyparse(pTHX_ int gramtype);
 PERL_CALLCONV void     Perl_yyquit(pTHX);
 PERL_CALLCONV void     Perl_yyunlex(pTHX);
+#if ! defined(HAS_MEMRCHR) && (defined(PERL_CORE) || defined(PERL_EXT))
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE void *      S_my_memrchr(const char * s, const char c, const STRLEN len);
+#define PERL_ARGS_ASSERT_MY_MEMRCHR    \
+       assert(s)
+#endif
+#endif
 #if !(defined(DEBUGGING))
 #  if !defined(NV_PRESERVES_UV)
 #    if defined(PERL_IN_SV_C)