A proper, working, stable optimisation for sort {$b cmp $a}

[perl5.git] / XSUB.h

diff --git a/XSUB.h b/XSUB.h
index af42f9c..4306454 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -67,6 +67,14 @@ This is usually handled automatically by C<xsubpp>.
 Sets up the C<ix> variable for an XSUB which has aliases.  This is usually
 handled automatically by C<xsubpp>.
 
+=for apidoc Ams||dUNDERBAR
+Sets up the C<padoff_du> variable for an XSUB that wishes to use
+C<UNDERBAR>.
+
+=for apidoc AmU||UNDERBAR
+The SV* corresponding to the $_ variable. Works even if there
+is a lexical $_ in scope.
+
 =cut
 */
 
@@ -106,6 +114,11 @@ handled automatically by C<xsubpp>.
 #define XSINTERFACE_FUNC_SET(cv,f)     \
                CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f)
 
+#define dUNDERBAR I32 padoff_du = find_rundefsvoffset()
+#define UNDERBAR ((padoff_du == NOT_IN_PAD \
+           || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR) \
+       ? DEFSV : PAD_SVl(padoff_du))
+
 /* Simple macros to put new mortal values onto the stack.   */
 /* Typically used to return values from XS functions.       */
 
@@ -166,7 +179,7 @@ Return an empty list from an XSUB immediately.
 
 =head1 Variables created by C<xsubpp> and C<xsubpp> internal functions
 
-=for apidoc AmU||newXSproto
+=for apidoc AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto
 Used by C<xsubpp> to hook up XSUBs as Perl subs.  Adds Perl prototypes to
 the subs.
 
@@ -267,6 +280,8 @@ C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
            SAVEINT(db->filtering) ;                            \
            db->filtering = TRUE ;                              \
            SAVESPTR(DEFSV) ;                                   \
+            if (name[7] == 's')                                 \
+                arg = newSVsv(arg);                             \
            DEFSV = arg ;                                       \
            SvTEMP_off(arg) ;                                   \
            PUSHMARK(SP) ;                                      \
@@ -276,6 +291,10 @@ C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
            PUTBACK ;                                           \
            FREETMPS ;                                          \
            LEAVE ;                                             \
+            if (name[7] == 's'){                                \
+                arg = sv_2mortal(arg);                          \
+            }                                                   \
+            SvOKp(arg);                                         \
        }
 
 #if 1          /* for compatibility */