Add eq-immediate? instruction

* libguile/jit.c (compile_eq_immediate, compile_eq_immediate_slow): Add
  JIT compiler.
* libguile/vm-engine.c (eq_immediate): New instruction.
* doc/ref/vm.texi (Comparison Instructions): Document.
* module/system/vm/assembler.scm (encode-X8_S8_ZI16!/shuffle): New
  shuffler.
* module/system/vm/disassembler.scm (code-annotation): Add eq-immediate?
  case.

2 files changed, 11 insertions, 1 deletions

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 6e00418af..ae527ddda 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -81,6 +81,7 @@
             emit-immediate-tag=?
             emit-heap-tag=?
             emit-eq?
+            emit-eq-immediate?
             emit-heap-numbers-equal?
             emit-j
             emit-jl
@@ -910,6 +911,14 @@ later by the linker."
     (emit-push asm dst)
     (encode-X8_S8_I16 asm 0 imm opcode)
     (emit-pop asm dst))))
+(define (encode-X8_S8_ZI16!/shuffle asm a imm opcode)
+  (cond
+   ((< a (ash 1 8))
+    (encode-X8_S8_ZI16 asm a imm opcode))
+   (else
+    (emit-push asm a)
+    (encode-X8_S8_ZI16 asm 0 imm opcode)
+    (emit-drop asm 1))))
 (define (encode-X8_S8_ZI16<-/shuffle asm dst imm opcode)
   (cond
    ((< dst (ash 1 8))
@@ -1043,6 +1052,7 @@ later by the linker."
       (('<- 'X8_S12_C12)         #'encode-X8_S12_C12<-/shuffle)
       (('! 'X8_S12_Z12)          #'encode-X8_S12_Z12!/shuffle)
       (('<- 'X8_S8_I16)          #'encode-X8_S8_I16<-/shuffle)
+      (('! 'X8_S8_ZI16)          #'encode-X8_S8_ZI16!/shuffle)
       (('<- 'X8_S8_ZI16)         #'encode-X8_S8_ZI16<-/shuffle)
       (('! 'X8_S8_S8_S8)         #'encode-X8_S8_S8_S8!/shuffle)
       (('<- 'X8_S8_S8_S8)        #'encode-X8_S8_S8_S8<-/shuffle)
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 1cb767093..28f4338d6 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -235,7 +235,7 @@ address of that offset."
     (('prompt tag escape-only? proc-slot handler)
      ;; The H is for handler.
      (list "H -> ~A" (vector-ref labels (- (+ offset handler) start))))
-    (('make-immediate _ imm)
+    (((or 'make-immediate 'eq-immediate?) _ imm)
      (list "~S" (sign-extended-immediate imm 16)))
     (((or 'make-short-immediate 'make-long-immediate) _ imm)
      (list "~S" (unpack-scm imm)))