From 5fb6746396aaf06e315d1179cfe26d1c33f0334c Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Fri, 25 Sep 2015 00:40:43 -0400
Subject: [PATCH] make sv_backoff tailcall friendly

sv_backoff has only 1.5 function calls in it, there is a memcpy of a U32 *
for alignment reasons (I wont discuss U32_ALIGNMENT_REQUIRED) inside of
SvOOK_offset, and the explicit Move()/memmove. GCC and clang often inline
memcpy/memmove when the length is a constant and is small. Sometimes
a CC might also do unaligned memory reads if OS/CPU allows it
http://lists.llvm.org/pipermail/llvm-commits/Week-of-Mon-20130513/174807.html
so I'll assume memcpy by short constant isn't a func call for discussion.
By moving SvFLAGS modification before the one and only func call, and
changing the return type to void, there is no code to execute after the
Move func call so the CC, if it wants (OS/ABI/CPU, specifically I am
thinking about x86-64) can tailcall jump to memmove. Also var sv can be
stored in a cheaper vol reg since it is not saved around any func calls
(SvFLAGS set was moved) assuming the memcpy by short constant was inlined.

The before machine code size of Perl_sv_backoff with VC 2003 -O1 was
0x6d bytes. After size is 0x61. .text section size of perl523.dll was
after was 0xD2733 bytes long, before was 0xD2743 bytes long. VC perl does
not inline memcpys by default.

In commit a0d0e21ea6 "perl 5.000" the return 0 was added. The int ret type
is from day 1 of sv_backoff function existing/day 1 of SV *s
from commit 79072805bf "perl 5.0 alpha 2". str_backoff didn't exist AFAIK,
only str_grow would retake the memory at the start of the block. Since
sv_backoff is usually used in a "&& func()" macro (SvOOK_off), it needed a
non void ret type, a simple ", 0" in the macro fixes that. All CCs optimize
and remove "if(0)" machine instructions so the ", 0" is optimized away in
the perl binary.
---
 embed.fnc         |    2 +-
 pod/perldelta.pod |    8 +++++++-
 proto.h           |    2 +-
 sv.c              |   10 +++++++---
 sv.h              |    2 +-
 5 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index d9b43d1..db731be 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1374,7 +1374,7 @@ Apd	|I32	|sv_true	|NULLOK SV *const sv
 sd	|void	|sv_add_arena	|NN char *const ptr|const U32 size \
 				|const U32 flags
 #endif
-Apdn	|int	|sv_backoff	|NN SV *const sv
+Apdn	|void	|sv_backoff	|NN SV *const sv
 Apd	|SV*	|sv_bless	|NN SV *const sv|NN HV *const stash
 #if defined(PERL_DEBUG_READONLY_COW)
 p	|void	|sv_buf_to_ro	|NN SV *sv
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index db9e601..7c6b5e7 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -323,7 +323,13 @@ well.
 
 =item *
 
-XXX
+L<perlapi/sv_backoff> had its return type changed fron C<int> to C<void>.  It
+previously has always returned C<0> since 5.000 stable but that was
+undocumented.  Although C<sv_backoff> is marked as public API, XS code is not
+expected to be impacted since the proper API call would be through public API
+C<sv_setsv(sv, &PL_sv_undef)>, or quasi-public C<SvOOK_off>, or non-public
+C<SvOK_off> calls, and the return value of C<sv_backoff> was previously a
+meaningless constant that can be rewritten as C<(sv_backoff(sv),0)>.
 
 =back
 
diff --git a/proto.h b/proto.h
index 6d49f47..fdc509c 100644
--- a/proto.h
+++ b/proto.h
@@ -2900,7 +2900,7 @@ PERL_CALLCONV char*	Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp);
 PERL_CALLCONV UV	Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags);
 #define PERL_ARGS_ASSERT_SV_2UV_FLAGS	\
 	assert(sv)
-PERL_CALLCONV int	Perl_sv_backoff(SV *const sv);
+PERL_CALLCONV void	Perl_sv_backoff(SV *const sv);
 #define PERL_ARGS_ASSERT_SV_BACKOFF	\
 	assert(sv)
 PERL_CALLCONV SV*	Perl_sv_bless(pTHX_ SV *const sv, HV *const stash);
diff --git a/sv.c b/sv.c
index dc2ba8b..d7d6dee 100644
--- a/sv.c
+++ b/sv.c
@@ -1525,7 +1525,11 @@ wrapper instead.
 =cut
 */
 
-int
+/* prior to 5.000 stable, this function returned the new OOK-less SvFLAGS
+   prior to 5.23.4 this function always returned 0
+*/
+
+void
 Perl_sv_backoff(SV *const sv)
 {
     STRLEN delta;
@@ -1541,9 +1545,9 @@ Perl_sv_backoff(SV *const sv)
     
     SvLEN_set(sv, SvLEN(sv) + delta);
     SvPV_set(sv, SvPVX(sv) - delta);
-    Move(s, SvPVX(sv), SvCUR(sv)+1, char);
     SvFLAGS(sv) &= ~SVf_OOK;
-    return 0;
+    Move(s, SvPVX(sv), SvCUR(sv)+1, char);
+    return;
 }
 
 /*
diff --git a/sv.h b/sv.h
index 331b823..9cb9cf6 100644
--- a/sv.h
+++ b/sv.h
@@ -949,7 +949,7 @@ in gv.h: */
 
 #define SvOOK(sv)		(SvFLAGS(sv) & SVf_OOK)
 #define SvOOK_on(sv)		(SvFLAGS(sv) |= SVf_OOK)
-#define SvOOK_off(sv)		((void)(SvOOK(sv) && sv_backoff(sv)))
+#define SvOOK_off(sv)		((void)(SvOOK(sv) && (sv_backoff(sv),0)))
 
 #define SvFAKE(sv)		(SvFLAGS(sv) & SVf_FAKE)
 #define SvFAKE_on(sv)		(SvFLAGS(sv) |= SVf_FAKE)
-- 
1.7.9.msysgit.0