From 6efe8fea5b6c3f1db22e50e8b164d6ffec85578d Mon Sep 17 00:00:00 2001
From: Stefan Muenzel <smuenzel@janestreet.com>
Date: Sat, 23 Mar 2019 22:51:59 +0800
Subject: [PATCH] Optimized 3-way comparisons for int and float (#2250)

Previously, `caml_int_compare` and `caml_float_compare` would compute their -1/0/1 result
at type int, then widen it to type intnat.  On 64-bit platforms this causes an extra sign extension.
This commit changes the code so that the -1/0/1 result is computed directly at type intnat.
---
 Changes          |  5 ++++-
 runtime/floats.c |  8 ++++++--
 runtime/ints.c   | 14 +++++++++-----
 3 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/Changes b/Changes
index 9b0a6bc39..5b0c8bd9f 100644
--- a/Changes
+++ b/Changes
@@ -88,8 +88,11 @@ Working version
 * GPR#2240: Constify "identifier" in struct custom_operations
   (Cedric Cellier, review by Xavier Leroy)
 
+- GPR#2250: Remove extra integer sign-extension in compare functions
+  (Stefan Muenzel, review by Xavier Leroy)
+
 * GPR#2293: Constify "caml_named_value"
-  (Stephen Dolan, review by ??)
+  (Stephen Dolan, review by Xavier Leroy)
 
 ### Standard library:
 
diff --git a/runtime/floats.c b/runtime/floats.c
index 33bf14e81..badac11a4 100644
--- a/runtime/floats.c
+++ b/runtime/floats.c
@@ -1008,8 +1008,12 @@ intnat caml_float_compare_unboxed(double f, double g)
   /* If one or both of f and g is NaN, order according to the convention
      NaN = NaN and NaN < x for all other floats x. */
   /* This branchless implementation is from GPR#164.
-     Note that [f == f] if and only if f is not NaN. */
-  return (f > g) - (f < g) + (f == f) - (g == g);
+     Note that [f == f] if and only if f is not NaN.
+     We expand each subresult of the expression to
+     avoid sign-extension on 64bit. GPR#2250. */
+  intnat res =
+    (intnat)(f > g) - (intnat)(f < g) + (intnat)(f == f) - (intnat)(g == g);
+  return res;
 }
 
 #endif
diff --git a/runtime/ints.c b/runtime/ints.c
index df6c65a4a..c9584e4ab 100644
--- a/runtime/ints.c
+++ b/runtime/ints.c
@@ -25,6 +25,11 @@
 #include "caml/misc.h"
 #include "caml/mlvalues.h"
 
+/* Comparison resulting in -1,0,1, with type intnat,
+   without extra integer width conversion (GPR#2250). */
+#define COMPARE_INT(v1, v2) \
+  (intnat)(v1 > v2) - (intnat)(v1 < v2)
+
 static const char * parse_sign_and_base(const char * p,
                                         /*out*/ int * base,
                                         /*out*/ int * signedness,
@@ -126,8 +131,7 @@ CAMLprim value caml_bswap16(value v)
 
 CAMLprim value caml_int_compare(value v1, value v2)
 {
-  int res = (v1 > v2) - (v1 < v2);
-  return Val_int(res);
+  return Val_long(COMPARE_INT(v1, v2));
 }
 
 CAMLprim value caml_int_of_string(value s)
@@ -314,7 +318,7 @@ CAMLprim value caml_int32_to_float(value v)
 
 intnat caml_int32_compare_unboxed(int32_t i1, int32_t i2)
 {
-  return (i1 > i2) - (i1 < i2);
+  return COMPARE_INT(i1, i2);
 }
 
 CAMLprim value caml_int32_compare(value v1, value v2)
@@ -562,7 +566,7 @@ CAMLprim value caml_int64_to_nativeint(value v)
 
 intnat caml_int64_compare_unboxed(int64_t i1, int64_t i2)
 {
-  return (i1 > i2) - (i1 < i2);
+  return COMPARE_INT(i1, i2);
 }
 
 CAMLprim value caml_int64_compare(value v1, value v2)
@@ -824,7 +828,7 @@ CAMLprim value caml_nativeint_to_int32(value v)
 
 intnat caml_nativeint_compare_unboxed(intnat i1, intnat i2)
 {
-  return (i1 > i2) - (i1 < i2);
+  return COMPARE_INT(i1, i2);
 }
 
 CAMLprim value caml_nativeint_compare(value v1, value v2)