wingo pushed a commit to branch master in repository guile. commit 8366634db748ad8729f6ea07fc3638c1f5822862 Author: Andy Wingo <wi...@pobox.com> AuthorDate: Thu Jul 30 22:48:39 2020 +0200
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. --- doc/ref/vm.texi | 6 ++++++ libguile/jit.c | 26 ++++++++++++++++++++++++++ libguile/vm-engine.c | 22 +++++++++++++++++++++- module/system/vm/assembler.scm | 10 ++++++++++ module/system/vm/disassembler.scm | 2 +- 5 files changed, 64 insertions(+), 2 deletions(-) diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi index 5064532..1d32f94 100644 --- a/doc/ref/vm.texi +++ b/doc/ref/vm.texi @@ -1756,6 +1756,12 @@ Set the comparison result to @var{EQUAL} if the SCM values @var{a} and @var{b} are @code{eq?}, or @code{NONE} otherwise. @end deftypefn +@deftypefn Instruction {} eq-immediate? s8:@var{a} zi16:@var{b} +Set the comparison result to @var{EQUAL} if the SCM value @var{a} is +equal to the immediate SCM value @var{b} (sign-extended), or @code{NONE} +otherwise. +@end deftypefn + There are a set of macro-instructions for @code{immediate-tag=?} and @code{heap-tag=?} as well that abstract away the precise type tag values. @xref{The SCM Type in Guile}. diff --git a/libguile/jit.c b/libguile/jit.c index d221428..5872ca9 100644 --- a/libguile/jit.c +++ b/libguile/jit.c @@ -4279,6 +4279,31 @@ compile_eq_slow (scm_jit_state *j, uint16_t a, uint16_t b) } static void +compile_eq_immediate (scm_jit_state *j, uint16_t a, SCM b) +{ + jit_reloc_t k; + uint32_t *target; + + emit_sp_ref_scm (j, T0, a); + switch (fuse_conditional_branch (j, &target)) + { + case scm_op_je: + k = jit_beqi (j->jit, T0, SCM_UNPACK (b)); + break; + case scm_op_jne: + k = jit_bnei (j->jit, T0, SCM_UNPACK (b)); + break; + default: + UNREACHABLE (); + } + add_inter_instruction_patch (j, k, target); +} +static void +compile_eq_immediate_slow (scm_jit_state *j, uint16_t a, SCM b) +{ +} + +static void compile_j (scm_jit_state *j, const uint32_t *vcode) { jit_reloc_t jmp; @@ -5618,6 +5643,7 @@ analyze (scm_jit_state *j) case scm_op_immediate_tag_equals: case scm_op_heap_tag_equals: case scm_op_eq: + case scm_op_eq_immediate: case scm_op_heap_numbers_equal: case scm_op_s64_imm_numerically_equal: case scm_op_u64_imm_less: diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index db57ec0..bf64684 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -3416,7 +3416,27 @@ VM_NAME (scm_thread *thread) NEXT (1); } - VM_DEFINE_OP (165, unused_165, NULL, NOP) + /* eq-immediate? a:8 low-bits:16 + * + * Set the comparison result to EQUAL if the SCM value A is equal to + * the immediate whose low bits are LOW-BITS, and whose top bits are + * sign-extended. + */ + VM_DEFINE_OP (165, eq_immediate, "eq-immediate?", OP1 (X8_S8_ZI16)) + { + uint8_t a; + int16_t val; + + UNPACK_8_16 (op, a, val); + + if (scm_is_eq (SP_REF (a), SCM_PACK ((scm_t_signed_bits) val))) + VP->compare_result = SCM_F_COMPARE_EQUAL; + else + VP->compare_result = SCM_F_COMPARE_NONE; + + NEXT (1); + } + VM_DEFINE_OP (166, unused_166, NULL, NOP) VM_DEFINE_OP (167, unused_167, NULL, NOP) VM_DEFINE_OP (168, unused_168, NULL, NOP) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 6e00418..ae527dd 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 1cb7670..28f4338 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)))