summaryrefslogtreecommitdiff
path: root/libguile/vm-engine.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-12-03 09:01:24 +0100
committerAndy Wingo <wingo@pobox.com>2015-12-03 09:01:24 +0100
commit1d4b4ec39cc7a7fa18c9e352e5ff4cc59874e039 (patch)
treef7485a9e67c6cc49b8c33ce16ec1a85905867d9f /libguile/vm-engine.c
parent97755a1adecbb5af084f33b1ca816c70cb8cb2de (diff)
downloadguile-1d4b4ec39cc7a7fa18c9e352e5ff4cc59874e039.tar.gz
Add support for comparing u64 values with SCM values
* libguile/vm-engine.c (BR_U64_SCM_COMPARISON): New helper. (br-if-u64-<=-scm, br-if-u64-<-scm, br-if-u64-=-scm) (br-if-u64->-scm, br-if-u64->=-scm): New instructions, to compare an untagged u64 with a tagged SCM. Avoids many u64->scm operations. * module/language/cps/compile-bytecode.scm (compile-function): * module/language/cps/effects-analysis.scm: * module/language/cps/type-fold.scm: * module/system/vm/assembler.scm: * module/system/vm/disassembler.scm (code-annotation, compute-labels): * module/language/cps/primitives.scm (*branching-primcall-arities*): Add support for new opcodes. * module/language/cps/specialize-numbers.scm (specialize-u64-scm-comparison): New helper. * module/language/cps/specialize-numbers.scm (specialize-operations): Specialize u64 comparisons. * module/language/cps/types.scm (true-comparison-restrictions): New helper. (define-comparison-inferrer): Use the new helper. Add support for u64-<-scm et al.
Diffstat (limited to 'libguile/vm-engine.c')
-rw-r--r--libguile/vm-engine.c98
1 files changed, 93 insertions, 5 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 34b95fbd6..0bd3e78e9 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -3640,11 +3640,99 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
- VM_DEFINE_OP (170, unused_170, NULL, NOP)
- VM_DEFINE_OP (171, unused_171, NULL, NOP)
- VM_DEFINE_OP (172, unused_172, NULL, NOP)
- VM_DEFINE_OP (173, unused_173, NULL, NOP)
- VM_DEFINE_OP (174, unused_174, NULL, NOP)
+#define BR_U64_SCM_COMPARISON(x, y, unboxed, boxed) \
+ do { \
+ scm_t_uint32 a, b; \
+ scm_t_uint64 x; \
+ SCM y_scm; \
+ \
+ UNPACK_24 (op, a); \
+ UNPACK_24 (ip[1], b); \
+ x = SP_REF_U64 (a); \
+ y_scm = SP_REF (b); \
+ \
+ if (SCM_I_INUMP (y_scm)) \
+ { \
+ scm_t_signed_bits y = SCM_I_INUM (y_scm); \
+ \
+ if ((ip[2] & 0x1) ? !(unboxed) : (unboxed)) \
+ { \
+ scm_t_int32 offset = ip[2]; \
+ offset >>= 8; /* Sign-extending shift. */ \
+ if (offset <= 0) \
+ VM_HANDLE_INTERRUPTS; \
+ NEXT (offset); \
+ } \
+ NEXT (3); \
+ } \
+ else \
+ { \
+ SCM res; \
+ SYNC_IP (); \
+ res = boxed (scm_from_uint64 (x), y_scm); \
+ CACHE_SP (); \
+ if ((ip[2] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \
+ { \
+ scm_t_int32 offset = ip[2]; \
+ offset >>= 8; /* Sign-extending shift. */ \
+ if (offset <= 0) \
+ VM_HANDLE_INTERRUPTS; \
+ NEXT (offset); \
+ } \
+ NEXT (3); \
+ } \
+ } while (0)
+
+ /* br-if-u64-=-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+ *
+ * If the U64 value in A is = to the SCM value in B, add OFFSET, a
+ * signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (170, br_if_u64_ee_scm, "br-if-u64-=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+ {
+ BR_U64_SCM_COMPARISON(x, y, y >= 0 && (scm_t_uint64) y == x, scm_num_eq_p);
+ }
+
+ /* br-if-u64-<-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+ *
+ * If the U64 value in A is < than the SCM value in B, add OFFSET, a
+ * signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (171, br_if_u64_lt_scm, "br-if-u64-<-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+ {
+ BR_U64_SCM_COMPARISON(x, y, y >= 0 && (scm_t_uint64) y > x, scm_less_p);
+ }
+
+ /* br-if-u64-=-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+ *
+ * If the U64 value in A is <= than the SCM value in B, add OFFSET, a
+ * signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (172, br_if_u64_le_scm, "br-if-u64-<=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+ {
+ BR_U64_SCM_COMPARISON(x, y, y >= 0 && (scm_t_uint64) y >= x, scm_leq_p);
+ }
+
+ /* br-if-u64->-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+ *
+ * If the U64 value in A is > than the SCM value in B, add OFFSET, a
+ * signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (173, br_if_u64_gt_scm, "br-if-u64->-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+ {
+ BR_U64_SCM_COMPARISON(x, y, y < 0 || (scm_t_uint64) y < x, scm_gr_p);
+ }
+
+ /* br-if-u64->=-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+ *
+ * If the U64 value in A is >= than the SCM value in B, add OFFSET, a
+ * signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (174, br_if_u64_ge_scm, "br-if-u64->=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+ {
+ BR_U64_SCM_COMPARISON(x, y, y <= 0 || (scm_t_uint64) y <= x, scm_geq_p);
+ }
+
VM_DEFINE_OP (175, unused_175, NULL, NOP)
VM_DEFINE_OP (176, unused_176, NULL, NOP)
VM_DEFINE_OP (177, unused_177, NULL, NOP)