This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #115112] avoid repeated calls to path_is_absolute() and rename it
authorTony Cook <tony@develop-help.com>
Sun, 2 Jun 2013 01:33:44 +0000 (11:33 +1000)
committerTony Cook <tony@develop-help.com>
Tue, 4 Jun 2013 09:13:20 +0000 (19:13 +1000)
A micro-optimization inspired by bulk88's perl #115112.

The original proposal suggested applying a two changes that removed the
duplicate calls, and then explicitly inlined path_is_absolute().

This version removes the duplicate calls, renames the function to better
match it's purpose and asks the compiler to inline it.

embed.fnc
embed.h
pp_ctl.c
proto.h

index b17ea71..3551161 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1926,7 +1926,7 @@ sR        |PerlIO *|check_type_and_open|NN SV *name
 sR     |PerlIO *|doopen_pm     |NN SV *name
 #endif
 s      |SV **  |adjust_stack_on_leave|NN SV **newsp|NN SV **sp|NN SV **mark|I32 gimme|U32 flags
-sRn    |bool   |path_is_absolute|NN const char *name
+iRn    |bool   |path_is_searchable|NN const char *name
 sR     |I32    |run_user_filter|int idx|NN SV *buf_sv|int maxlen
 sR     |PMOP*  |make_matcher   |NN REGEXP* re
 sR     |bool   |matcher_matches_sv|NN PMOP* matcher|NN SV* sv
diff --git a/embed.h b/embed.h
index 47b46ef..9446875 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define make_matcher(a)                S_make_matcher(aTHX_ a)
 #define matcher_matches_sv(a,b)        S_matcher_matches_sv(aTHX_ a,b)
 #define num_overflow           S_num_overflow
-#define path_is_absolute       S_path_is_absolute
+#define path_is_searchable     S_path_is_searchable
 #define run_user_filter(a,b,c) S_run_user_filter(aTHX_ a,b,c)
 #define rxres_free(a)          S_rxres_free(aTHX_ a)
 #define rxres_restore(a,b)     S_rxres_restore(aTHX_ a,b)
index 6f2ab5a..b3e813e 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3624,6 +3624,32 @@ S_doopen_pm(pTHX_ SV *name)
 #  define doopen_pm(name) check_type_and_open(name)
 #endif /* !PERL_DISABLE_PMC */
 
+/* require doesn't search for absolute names, or when the name is
+   explicity relative the current directory */
+PERL_STATIC_INLINE bool
+S_path_is_searchable(const char *name)
+{
+    PERL_ARGS_ASSERT_PATH_IS_SEARCHABLE;
+
+    if (PERL_FILE_IS_ABSOLUTE(name)
+#ifdef WIN32
+       || (*name == '.' && ((name[1] == '/' ||
+                            (name[1] == '.' && name[2] == '/'))
+                        || (name[1] == '\\' ||
+                            ( name[1] == '.' && name[2] == '\\')))
+           )
+#else
+       || (*name == '.' && (name[1] == '/' ||
+                            (name[1] == '.' && name[2] == '/')))
+#endif
+        )
+    {
+       return FALSE;
+    }
+    else
+       return TRUE;
+}
+
 PP(pp_require)
 {
     dVAR; dSP;
@@ -3651,6 +3677,7 @@ PP(pp_require)
     SV *encoding;
     OP *op;
     int saved_errno;
+    bool path_searchable;
 
     sv = POPs;
     if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
@@ -3715,6 +3742,7 @@ PP(pp_require)
        DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
 
+    path_searchable = path_is_searchable(name);
 
 #ifdef VMS
     /* The key in the %ENV hash is in the syntax of file passed as the argument
@@ -3754,12 +3782,12 @@ PP(pp_require)
 
     /* prepare to compile file */
 
-    if (path_is_absolute(name)) {
+    if (!path_searchable) {
        /* At this point, name is SvPVX(sv)  */
        tryname = name;
        tryrsfp = doopen_pm(sv);
     }
-    if (!tryrsfp && !(errno == EACCES && path_is_absolute(name))) {
+    if (!tryrsfp && !(errno == EACCES && !path_searchable)) {
        AV * const ar = GvAVn(PL_incgv);
        I32 i;
 #ifdef VMS
@@ -3889,8 +3917,7 @@ PP(pp_require)
                    }
                }
                else {
-                 if (!path_is_absolute(name)
-                 ) {
+                 if (path_searchable) {
                    const char *dir;
                    STRLEN dirlen;
 
@@ -5509,32 +5536,6 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     return status;
 }
 
-/* perhaps someone can come up with a better name for
-   this?  it is not really "absolute", per se ... */
-static bool
-S_path_is_absolute(const char *name)
-{
-    PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE;
-
-    if (PERL_FILE_IS_ABSOLUTE(name)
-#ifdef WIN32
-       || (*name == '.' && ((name[1] == '/' ||
-                            (name[1] == '.' && name[2] == '/'))
-                        || (name[1] == '\\' ||
-                            ( name[1] == '.' && name[2] == '\\')))
-           )
-#else
-       || (*name == '.' && (name[1] == '/' ||
-                            (name[1] == '.' && name[2] == '/')))
-#endif
-        )
-    {
-       return TRUE;
-    }
-    else
-       return FALSE;
-}
-
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/proto.h b/proto.h
index cc94108..cad9f2e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6202,10 +6202,10 @@ STATIC bool     S_matcher_matches_sv(pTHX_ PMOP* matcher, SV* sv)
 STATIC bool    S_num_overflow(NV value, I32 fldsize, I32 frcsize)
                        __attribute__warn_unused_result__;
 
-STATIC bool    S_path_is_absolute(const char *name)
+PERL_STATIC_INLINE bool        S_path_is_searchable(const char *name)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(1);
-#define PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE      \
+#define PERL_ARGS_ASSERT_PATH_IS_SEARCHABLE    \
        assert(name)
 
 STATIC I32     S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)