[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Add sign-extending make-immediate instruction
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 02/02: Add sign-extending make-immediate instruction |
|
Date: |
Thu, 30 Jul 2020 11:40:27 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 172e5ccfc1e0a26880fd328ef72c7bbcb9c2fca1
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jul 30 17:36:11 2020 +0200
Add sign-extending make-immediate instruction
* doc/ref/vm.texi (Instruction Set, Constant Instructions): Document new
instruction.
* libguile/instructions.c (FOR_EACH_INSTRUCTION_WORD_TYPE): New first
word kind with zi16 operand.
* libguile/jit.c (compile_make_immediate, compile_make_immediate_slow):
New compilers.
(COMPILE_X8_S8_ZI16): New operand kind.
* libguile/vm-engine.c (make-immediate): New instruction.
* module/language/bytecode.scm:
* module/system/vm/assembler.scm (encode-X8_S8_ZI16<-/shuffle):
(signed-bits, load-constant): Support the new instruction kind.
* module/system/vm/disassembler.scm (disassemblers)
(sign-extended-immediate, code-annotation): Support for zi16
operands.
---
doc/ref/vm.texi | 10 ++++++++--
libguile/instructions.c | 1 +
libguile/jit.c | 19 +++++++++++++++++++
libguile/vm-engine.c | 18 ++++++++++++++++--
module/language/bytecode.scm | 1 +
module/system/vm/assembler.scm | 32 ++++++++++++++++++++++++++++++++
module/system/vm/disassembler.scm | 12 +++++++++++-
7 files changed, 88 insertions(+), 5 deletions(-)
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index a94c605..5064532 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -579,10 +579,12 @@ An unsigned @var{n}-bit integer, indicating a constant
value.
@item l24
An offset from the current @code{ip}, in 32-bit units, as a signed
24-bit value. Indicates a bytecode address, for a relative jump.
-@item i16
+@item zi16
+@itemx i16
@itemx i32
An immediate Scheme value (@pxref{Immediate Objects}), encoded directly
-in 16 or 32 bits.
+in 16 or 32 bits. @code{zi16} is sign-extended; the others are
+zero-extended.
@item a32
@itemx b32
An immediate Scheme value, encoded as a pair of 32-bit words.
@@ -1358,6 +1360,10 @@ two kinds.
The first set of instructions loads immediate values. These
instructions encode the immediate directly into the instruction stream.
+@deftypefn Instruction {} make-immediate s8:@var{dst} zi16:@var{low-bits}
+Make an immediate whose low bits are @var{low-bits}, sign-extended.
+@end deftypefn
+
@deftypefn Instruction {} make-short-immediate s8:@var{dst} i16:@var{low-bits}
Make an immediate whose low bits are @var{low-bits}, and whose top bits are
0.
diff --git a/libguile/instructions.c b/libguile/instructions.c
index f0db433..dcee8a2 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -44,6 +44,7 @@ SCM_SYMBOL (sym_bang, "!");
M(X8_L24) \
M(X8_C24) \
M(X8_S8_I16) \
+ M(X8_S8_ZI16) \
M(X8_S12_S12) \
M(X8_S12_C12) \
M(X8_S12_Z12) \
diff --git a/libguile/jit.c b/libguile/jit.c
index 75dbe64..d221428 100644
--- a/libguile/jit.c
+++ b/libguile/jit.c
@@ -2817,6 +2817,17 @@ compile_call_u64_from_scm_slow (scm_jit_state *j,
uint16_t dst, uint16_t a, uint
}
static void
+compile_make_immediate (scm_jit_state *j, uint8_t dst, SCM a)
+{
+ emit_movi (j, T0, SCM_UNPACK (a));
+ emit_sp_set_scm (j, dst, T0);
+}
+static void
+compile_make_immediate_slow (scm_jit_state *j, uint8_t dst, SCM a)
+{
+}
+
+static void
compile_make_short_immediate (scm_jit_state *j, uint8_t dst, SCM a)
{
emit_movi (j, T0, SCM_UNPACK (a));
@@ -5274,6 +5285,14 @@ compile_s64_to_f64_slow (scm_jit_state *j, uint16_t dst,
uint16_t src)
comp (j, a, SCM_PACK (b)); \
}
+#define COMPILE_X8_S8_ZI16(j, comp) \
+ { \
+ uint8_t a; \
+ int16_t b; \
+ UNPACK_8_16 (j->ip[0], a, b); \
+ comp (j, a, SCM_PACK ((scm_t_signed_bits) b)); \
+ }
+
#define COMPILE_X32__C32(j, comp) \
{ \
comp (j, j->ip[1]); \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 7482581..db57ec0 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1,4 +1,4 @@
-/* Copyright 2001,2009-2015,2017-2019
+/* Copyright 2001,2009-2015,2017-2020
Free Software Foundation, Inc.
This file is part of Guile.
@@ -3401,7 +3401,21 @@ VM_NAME (scm_thread *thread)
NEXT (offset);
}
- VM_DEFINE_OP (164, unused_164, NULL, NOP)
+ /* make-immediate dst:8 low-bits:16
+ *
+ * Make an immediate whose low bits are LOW-BITS, and whose top bits
+ * are sign-extended.
+ */
+ VM_DEFINE_OP (164, make_immediate, "make-immediate", DOP1 (X8_S8_ZI16))
+ {
+ uint8_t dst;
+ int16_t val;
+
+ UNPACK_8_16 (op, dst, val);
+ SP_SET (dst, SCM_PACK ((scm_t_signed_bits) val));
+ NEXT (1);
+ }
+
VM_DEFINE_OP (165, unused_165, NULL, NOP)
VM_DEFINE_OP (166, unused_166, NULL, NOP)
VM_DEFINE_OP (167, unused_167, NULL, NOP)
diff --git a/module/language/bytecode.scm b/module/language/bytecode.scm
index f10bc68..b304e35 100644
--- a/module/language/bytecode.scm
+++ b/module/language/bytecode.scm
@@ -44,6 +44,7 @@
((X8_C24) 1)
((X8_L24) 1)
((X8_S8_I16) 2)
+ ((X8_S8_ZI16) 2)
((X8_S12_S12) 2)
((X8_S12_C12) 2)
((X8_S12_Z12) 2)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index e0a39d3..6e00418 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -682,6 +682,10 @@ later by the linker."
(emit asm opcode))
((X8_S8_I16 a imm)
(emit asm (pack-u8-u8-u16 opcode a (immediate-bits asm imm))))
+ ((X8_S8_ZI16 a imm)
+ (emit asm (pack-u8-u8-u16 opcode a
+ (signed-bits asm (immediate-bits asm imm)
+ 16))))
((X8_S12_S12 a b)
(emit asm (pack-u8-u12-u12 opcode a b)))
((X8_S12_C12 a b)
@@ -906,6 +910,15 @@ 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 dst imm opcode)
+ (cond
+ ((< dst (ash 1 8))
+ (encode-X8_S8_ZI16 asm dst imm opcode))
+ (else
+ ;; Push garbage value to make space for dst.
+ (emit-push asm dst)
+ (encode-X8_S8_ZI16 asm 0 imm opcode)
+ (emit-pop asm dst))))
(define (encode-X8_S8_S8_S8!/shuffle asm a b c opcode)
(cond
((< (logior a b c) (ash 1 8))
@@ -1030,6 +1043,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_S8_S8) #'encode-X8_S8_S8_S8!/shuffle)
(('<- 'X8_S8_S8_S8) #'encode-X8_S8_S8_S8<-/shuffle)
(('<- 'X8_S8_S8_C8) #'encode-X8_S8_S8_C8<-/shuffle)
@@ -1076,6 +1090,7 @@ later by the linker."
('X8_C24 #'(arg))
('X8_L24 #'(label))
('X8_S8_I16 #'(a imm))
+ ('X8_S8_ZI16 #'(a imm))
('X8_S12_S12 #'(a b))
('X8_S12_C12 #'(a b))
('X8_S12_Z12 #'(a b))
@@ -1209,6 +1224,21 @@ immediate, and @code{#f} otherwise."
(and (not (zero? (logand bits 6)))
bits))))
+(define (signed-bits asm uimm n)
+ "Given the immediate-bits encoding @var{uimm}, return its bit pattern
+if it can be restricted to a sign-extended bitfield of @var{n} bits, or
+@code{#f} otherwise."
+ (let* ((all-bits (1- (ash 1 (* (asm-word-size asm) 8))))
+ (fixed-bits (1- (ash 1 n)))
+ (sign-bits (lognot (ash fixed-bits -1))))
+ (cond
+ ((eqv? (logand all-bits sign-bits) (logand uimm sign-bits))
+ (logand uimm fixed-bits))
+ ((zero? (logand uimm sign-bits))
+ uimm)
+ (else
+ #f))))
+
(define-record-type <stringbuf>
(make-stringbuf string)
stringbuf?
@@ -1368,6 +1398,8 @@ returned instead."
((immediate-bits asm obj)
=> (lambda (bits)
(cond
+ ((and (< dst 256) (signed-bits asm bits 16))
+ (emit-make-immediate asm dst obj))
((and (< dst 256) (zero? (ash bits -16)))
(emit-make-short-immediate asm dst obj))
((zero? (ash bits -32))
diff --git a/module/system/vm/disassembler.scm
b/module/system/vm/disassembler.scm
index d51c14d..1cb7670 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -95,7 +95,7 @@
#'((ash word -8)))
((X8_L24)
#'((unpack-s24 (ash word -8))))
- ((X8_S8_I16)
+ ((X8_S8_I16 X8_S8_ZI16)
#'((logand (ash word -8) #xff)
(ash word -16)))
((X8_S12_S12
@@ -205,6 +205,14 @@ address of that offset."
(visit-heap-tags define-heap-tag-annotation)
+(define (sign-extended-immediate uimm n)
+ (unpack-scm
+ (if (>= uimm (ash 1 (- n 1)))
+ (let ((word-bits (* (sizeof '*) 8))) ; FIXME
+ (logand (1- (ash 1 word-bits))
+ (- uimm (ash 1 n))))
+ uimm)))
+
(define (code-annotation code len offset start labels context push-addr!)
;; FIXME: Print names for register loads and stores that correspond to
;; access to named locals.
@@ -227,6 +235,8 @@ 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)
+ (list "~S" (sign-extended-immediate imm 16)))
(((or 'make-short-immediate 'make-long-immediate) _ imm)
(list "~S" (unpack-scm imm)))
(('make-long-long-immediate _ high low)