Perl_do_print: stringify an SVt_IV IV/UV more efficiently

doio.c

@@ -2205,11 +2205,23 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
         return TRUE;
     if (SvTYPE(sv) == SVt_IV && SvIOK(sv)) {
         assert(!SvGMAGICAL(sv));
-        if (SvIsUV(sv))
-            PerlIO_printf(fp, "%" UVuf, (UV)SvUVX(sv));
-        else
-            PerlIO_printf(fp, "%" IVdf, (IV)SvIVX(sv));
-        return !PerlIO_error(fp);
+
+        /* Adapted from Perl_sv_2pv_flags */
+        const U32 isUIOK = SvIsUV(sv);
+        /* The purpose of this union is to ensure that arr is aligned on
+           a 2 byte boundary, because that is what uiv_2buf() requires */
+        union {
+            char arr[TYPE_CHARS(UV)];
+            U16 dummy;
+        } buf;
+        char *ebuf, *ptr;
+        STRLEN len;
+        UV tempuv = SvUVX(sv);
+        ptr = uiv_2buf(buf.arr, SvIVX(sv), tempuv, isUIOK, &ebuf);
+        len = ebuf - ptr;
+
+        bool happy = !(len && (PerlIO_write(fp,ptr,len) == 0));
+        return happy && !PerlIO_error(fp);
     }
     else {
         STRLEN len;
@@ -2222,7 +2234,6 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
          * Safefree(free_me) will free it.  This saves having to have extra
          * logic. */
         void *free_me = NULL;
-        bool happy = TRUE;
 
         if (PerlIO_isutf8(fp)) { /* If the stream is utf8 ... */
             if (!SvUTF8(sv)) {	/* Convert to utf8 if necessary */
@@ -2253,10 +2264,9 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
          * but only until the system hard limit/the filesystem limit,
          * at which we would get EPERM.  Note that when using buffered
          * io the write failure can be delayed until the flush/close. --jhi */
-        if (len && (PerlIO_write(fp,tmps,len) == 0))
-            happy = FALSE;
+        bool happy = !(len && (PerlIO_write(fp,tmps,len) == 0));
         Safefree(free_me);
-        return happy ? !PerlIO_error(fp) : FALSE;
+        return happy && !PerlIO_error(fp);
     }
 }
 

embed.fnc

@@ -3644,6 +3644,11 @@ EXop	|bool	|try_amagic_bin |int method				\
 				|int flags
 EXop	|bool	|try_amagic_un	|int method				\
 				|int flags
+ARTp	|char * |uiv_2buf	|NN char * const buf			\
+				|const IV iv				\
+				|UV uv					\
+				|const int is_uv			\
+				|NN char ** const peob
 Adp	|SSize_t|unpackstring	|NN const char *pat			\
 				|NN const char *patend			\
 				|NN const char *s			\
@@ -5886,11 +5891,6 @@ ST	|STRLEN |sv_pos_u2b_midway					\
 				|const STRLEN uend
 i	|void	|sv_unglob	|NN SV * const sv			\
 				|U32 flags
-RTi	|char * |uiv_2buf	|NN char * const buf			\
-				|const IV iv				\
-				|UV uv					\
-				|const int is_uv			\
-				|NN char ** const peob
 S	|void	|utf8_mg_len_cache_update				\
 				|NN SV * const sv			\
 				|NN MAGIC ** const mgp			\

embed.h

@@ -851,6 +851,7 @@
 # define to_uni_lower(a,b,c)                    Perl_to_uni_lower(aTHX_ a,b,c)
 # define to_uni_title(a,b,c)                    Perl_to_uni_title(aTHX_ a,b,c)
 # define to_uni_upper(a,b,c)                    Perl_to_uni_upper(aTHX_ a,b,c)
+# define uiv_2buf                               Perl_uiv_2buf
 # define unpackstring(a,b,c,d,e)                Perl_unpackstring(aTHX_ a,b,c,d,e)
 # define unshare_hek(a)                         Perl_unshare_hek(aTHX_ a)
 # define unsharepvn(a,b,c)                      Perl_unsharepvn(aTHX_ a,b,c)
@@ -2181,7 +2182,6 @@
 #     define sv_pos_u2b_forwards                S_sv_pos_u2b_forwards
 #     define sv_pos_u2b_midway                  S_sv_pos_u2b_midway
 #     define sv_unglob(a,b)                     S_sv_unglob(aTHX_ a,b)
-#     define uiv_2buf                           S_uiv_2buf
 #     define utf8_mg_len_cache_update(a,b,c)    S_utf8_mg_len_cache_update(aTHX_ a,b,c)
 #     define utf8_mg_pos_cache_update(a,b,c,d,e) S_utf8_mg_pos_cache_update(aTHX_ a,b,c,d,e)
 #     define visit(a,b,c)                       S_visit(aTHX_ a,b,c)

handy.h

@@ -3103,7 +3103,6 @@ STMT_START {                    \
     (x) ^= ((x) << 26);         \
 } STMT_END
 
-#ifdef PERL_CORE
 /* Convenience macros for dealing with IV_MIN:
    In two's complement system, the absolute value of IV_MIN (i.e. -IV_MIN)
    cannot be represented in an IV.  Thus we cannot use simple negation
@@ -3160,8 +3159,6 @@ undefined behavior when C<uv> is equal to C<L</ABS_IV_MIN>>.
 #  define NEGATE_2IV(uv) (ASSUME((uv) <= ABS_IV_MIN), \
                           (uv) < 8U ? -(IV)(uv) : -(IV)((uv) - 8U) - 8)
 
-#endif  /* PERL_CORE */
-
 #endif  /* PERL_HANDY_H_ */
 
 /*

pod/perldelta.pod

@@ -89,6 +89,12 @@ There may well be none in a stable release.
 
 =item *
 
+The stringification of integers by L<perlfunc/print> and L<perlfunc/say>,
+when coming from an SVt_IV, is now more efficient.
+[GH #22927]
+
+=item *
+
 XXX
 
 =back

sv.c

@@ -2794,20 +2794,31 @@ static const union {
     '9', '8', '9', '9'
 }};
 
-/* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
- * UV as a string towards the end of buf, and return pointers to start and
- * end of it.
+/* uiv_2buf(): originally a private routine for use by sv_2pv_flags(),
+ * now in use by do_print() and part of the public API. It prints an
+ * IV or UV as a string towards the end of buf, and return pointers
+ * to the start and end of it.
  *
  * We assume that buf is at least TYPE_CHARS(UV) long.
  */
 
-PERL_STATIC_INLINE char *
-S_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const peob)
+/*
+=for apidoc uiv_2buf
+
+This function converts an IV or UV to its string representation.
+
+It is used internally by sv_2pv_flags() and do_print().
+
+=cut
+*/
+
+char *
+Perl_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const peob)
 {
     char *ptr = buf + TYPE_CHARS(UV);
     char * const ebuf = ptr;
-    int sign;
-    U16 *word_ptr, *word_table;
+    U16 *word_ptr;
+    U16 const *word_table;
 
     PERL_ARGS_ASSERT_UIV_2BUF;
 
@@ -2816,16 +2827,17 @@ S_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const pe
     /* we are going to read/write two bytes at a time */
     word_ptr = (U16*)ptr;
     word_table = (U16*)int2str_table.arr;
-
-    if (UNLIKELY(is_uv))
-        sign = 0;
-    else if (iv >= 0) {
-        uv = iv;
-        sign = 0;
-    } else {
-        /* Using 0- here to silence bogus warning from MS VC */
-        uv = (UV) (0 - (UV) iv);
-        sign = 1;
+    bool sign = false;
+    if (LIKELY(!is_uv)) {
+        if (iv >= 0) {
+            uv = iv;
+        } else {
+            /* This is NEGATE_2UV(iv), which can be found in handy.h. */
+            /* sv_inline.h does not include handy.h because the latter
+             * would then get included twice into .c files. */
+            uv = (ASSUME((iv) < 0), (UV)-((iv) + 1) + 1U);
+            sign = 1;
+        }
     }
 
     while (uv > 99) {

t/perf/benchmarks

@@ -1938,6 +1938,18 @@
         code    => '$p = pos($s);',
     },
 
+    # func::print::iv_stringify should outperform func::print::iv_strings
+    'func::print::iv_stringify' => {
+        desc    => 'do_print stringification of SVt_IV integers',
+        setup   => 'open(my $fh, ">", \$x) or die $!;',
+        code    => 'print $fh 1,2,3,4,5,6,7,8,9,0;',
+    },
+    'func::print::iv_strings' => {
+        desc    => 'do_print pre-stringified SVt_IV integers',
+        setup   => 'open(my $fh, ">", \$x) or die $!;',
+        code    => 'print $fh "1","2","3","4","5","6","7","8","9","0";',
+    },
+
     'func::ref::notaref_bool' => {
         desc    => 'ref($notaref) in boolean context',
         setup   => 'my $r = "boo"',
@@ -1970,8 +1982,6 @@
         code    => '$x = ref $r',
     },
 
-
-
     'func::sort::num' => {
         desc    => 'plain numeric sort',
         setup   => 'my (@a, @b); @a = reverse 1..10;',
@@ -2034,7 +2044,6 @@
         code    => '@a = sort f @a',
     },
 
-
     'func::split::vars' => {
         desc    => 'split into two lexical vars',
         setup   => 'my $s = "abc:def";',