From 49d77b1243aecfd250e4f6160c66603555c4e86a Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 1 Sep 2016 10:51:57 +0200
Subject: [PATCH] Add unboxed logxor on u64 values

* libguile/vm-engine.c (ulogxor): New instruction.
* module/language/cps/effects-analysis.scm (ulogxor):
* module/language/cps/slot-allocation.scm (compute-var-representations):
* module/language/cps/types.scm (ulogxor):
* module/system/vm/assembler.scm (emit-ulogxor): Add support for new
  instruction.
* doc/ref/vm.texi (Unboxed Integer Arithmetic): Document ulogxor.
---
 doc/ref/vm.texi                          |  5 +++--
 libguile/vm-engine.c                     | 17 ++++++++++++++++-
 module/language/cps/effects-analysis.scm |  1 +
 module/language/cps/slot-allocation.scm  |  2 +-
 module/language/cps/types.scm            |  6 ++++++
 module/system/vm/assembler.scm           |  1 +
 6 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 4505a019c..2f32c511f 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -1565,9 +1565,10 @@ operand is an immediate unsigned 8-bit integer.
 
 @deftypefn Instruction {} ulogand s8:@var{dst} s8:@var{a} s8:@var{b}
 @deftypefnx Instruction {} ulogior s8:@var{dst} s8:@var{a} s8:@var{b}
+@deftypefnx Instruction {} ulogxor s8:@var{dst} s8:@var{a} s8:@var{b}
 @deftypefnx Instruction {} ulogsub s8:@var{dst} s8:@var{a} s8:@var{b}
-Like @code{logand}, @code{logior}, and @code{logsub}, but operating on
-unboxed unsigned 64-bit integers.
+Like @code{logand}, @code{logior}, @code{logxor}, and @code{logsub}, but
+operating on unboxed unsigned 64-bit integers.
 @end deftypefn
 
 @deftypefn Instruction {} ulsh s8:@var{dst} s8:@var{a} s8:@var{b}
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 4b5b70bd2..f508cd2f2 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -3802,7 +3802,22 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       NEXT (1);
     }
 
-  VM_DEFINE_OP (177, unused_177, NULL, NOP)
+  /* ulogxor dst:8 a:8 b:8
+   *
+   * Place the bitwise exclusive OR of the u64 values in A and B into
+   * DST.
+   */
+  VM_DEFINE_OP (177, ulogxor, "ulogxor", OP1 (X8_S8_S8_S8) | OP_DST)
+    {
+      scm_t_uint8 dst, a, b;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+
+      SP_SET_U64 (dst, SP_REF_U64 (a) ^ SP_REF_U64 (b));
+
+      NEXT (1);
+    }
+
   VM_DEFINE_OP (178, unused_178, NULL, NOP)
   VM_DEFINE_OP (179, unused_179, NULL, NOP)
   VM_DEFINE_OP (180, unused_180, NULL, NOP)
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index 5698fcd57..aed47d464 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -475,6 +475,7 @@ is or might be a read or a write to the same location as A."
   ((lognot . _)                    &type-check)
   ((ulogand . _))
   ((ulogior . _))
+  ((ulogxor . _))
   ((ulogsub . _))
   ((ursh . _))
   ((ulsh . _))
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 654dbda39..32f0ace99 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -805,7 +805,7 @@ are comparable with eqv?.  A tmp slot may be used."
                                'char->integer
                                'bv-length 'vector-length 'string-length
                                'uadd 'usub 'umul
-                               'ulogand 'ulogior 'ulogsub 'ursh 'ulsh
+                               'ulogand 'ulogior 'ulogxor 'ulogsub 'ursh 'ulsh
                                'uadd/immediate 'usub/immediate 'umul/immediate
                                'ursh/immediate 'ulsh/immediate
                                'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 633fef51b..266cb743d 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1356,6 +1356,12 @@ minimum, and maximum."
 ;; For our purposes, treat logxor the same as logior.
 (define-type-aliases logior logxor)
 
+(define-simple-type-checker (ulogxor &u64 &u64))
+(define-type-inferrer (ulogxor a b result)
+  (restrict! a &u64 0 &u64-max)
+  (restrict! b &u64 0 &u64-max)
+  (define! result &u64 0 &u64-max))
+
 (define-simple-type-checker (lognot &exact-integer))
 (define-type-inferrer (lognot a result)
   (restrict! a &exact-integer -inf.0 +inf.0)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 20a652c66..c9ef5f191 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -161,6 +161,7 @@
             emit-logsub
             emit-ulogand
             emit-ulogior
+            emit-ulogxor
             emit-ulogsub
             emit-ursh
             emit-ulsh