[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/07: Add new-style test and branch instructions
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/07: Add new-style test and branch instructions |
Date: |
Thu, 26 Oct 2017 10:07:16 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit a7f9c32816f3569a60b088171a9a4313ed0dee70
Author: Andy Wingo <address@hidden>
Date: Tue Oct 24 21:12:19 2017 +0200
Add new-style test and branch instructions
* libguile/vm-engine.c (UNPACK_16_16): New definition.
(u64=?, u64<?, s64=?, s64<?, f64=?, f64<?, =?, <?, arguments<?)
(positional-arguments<=?, immediate-tag=?, heap-tag=?, eq?): New
comparison instructions.
(j, jl, je, jnl, jne, jge, jnge): New branch instructions.
---
libguile/vm-engine.c | 390 ++++++++++++++++++++++++++++++++++++++++++++++++---
libguile/vm.c | 2 +
libguile/vm.h | 10 +-
3 files changed, 381 insertions(+), 21 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 94bf352..1969ce9 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -60,6 +60,13 @@
} \
while (0)
+#define UNPACK_16_16(op,a,b) \
+ do \
+ { \
+ a = op & 0xffff; \
+ b = op >> 16; \
+ } \
+ while (0)
/* Assign some registers by hand. There used to be a bigger list here,
but it was never tested, and in the case of x86-32, was a source of
@@ -4025,26 +4032,369 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
- VM_DEFINE_OP (193, unused_193, NULL, NOP)
- VM_DEFINE_OP (194, unused_194, NULL, NOP)
- VM_DEFINE_OP (195, unused_195, NULL, NOP)
- VM_DEFINE_OP (196, unused_196, NULL, NOP)
- VM_DEFINE_OP (197, unused_197, NULL, NOP)
- VM_DEFINE_OP (198, unused_198, NULL, NOP)
- VM_DEFINE_OP (199, unused_199, NULL, NOP)
- VM_DEFINE_OP (200, unused_200, NULL, NOP)
- VM_DEFINE_OP (201, unused_201, NULL, NOP)
- VM_DEFINE_OP (202, unused_202, NULL, NOP)
- VM_DEFINE_OP (203, unused_203, NULL, NOP)
- VM_DEFINE_OP (204, unused_204, NULL, NOP)
- VM_DEFINE_OP (205, unused_205, NULL, NOP)
- VM_DEFINE_OP (206, unused_206, NULL, NOP)
- VM_DEFINE_OP (207, unused_207, NULL, NOP)
- VM_DEFINE_OP (208, unused_208, NULL, NOP)
- VM_DEFINE_OP (209, unused_209, NULL, NOP)
- VM_DEFINE_OP (210, unused_210, NULL, NOP)
- VM_DEFINE_OP (211, unused_211, NULL, NOP)
- VM_DEFINE_OP (212, unused_212, NULL, NOP)
+ VM_DEFINE_OP (193, u64_numerically_equal, "u64=?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ scm_t_uint64 x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF_U64 (a);
+ y = SP_REF_U64 (b);
+
+ vp->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE;
+
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (194, u64_less, "u64<?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ scm_t_uint64 x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF_U64 (a);
+ y = SP_REF_U64 (b);
+
+ vp->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN :
SCM_F_COMPARE_NONE;
+
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (195, s64_numerically_equal, "s64=?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ scm_t_int64 x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF_S64 (a);
+ y = SP_REF_S64 (b);
+
+ vp->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE;
+
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (196, s64_less, "s64<?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ scm_t_int64 x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF_S64 (a);
+ y = SP_REF_S64 (b);
+
+ vp->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN :
SCM_F_COMPARE_NONE;
+
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (197, f64_numerically_equal, "f64=?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ double x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF_F64 (a);
+ y = SP_REF_F64 (b);
+
+ if (x == y)
+ vp->compare_result = SCM_F_COMPARE_EQUAL;
+ else
+ /* This is also the case for NaN. */
+ vp->compare_result = SCM_F_COMPARE_NONE;
+
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (198, f64_less, "f64<?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ double x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF_F64 (a);
+ y = SP_REF_F64 (b);
+
+ if (x < y)
+ vp->compare_result = SCM_F_COMPARE_LESS_THAN;
+ else if (x >= y)
+ vp->compare_result = SCM_F_COMPARE_NONE;
+ else
+ /* NaN. */
+ vp->compare_result = SCM_F_COMPARE_INVALID;
+
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (199, numerically_equal, "=?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ SCM x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF (a);
+ y = SP_REF (b);
+
+ SYNC_IP ();
+ if (scm_is_true (scm_num_eq_p (x, y)))
+ vp->compare_result = SCM_F_COMPARE_EQUAL;
+ else
+ vp->compare_result = SCM_F_COMPARE_NONE;
+ CACHE_SP ();
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (200, less, "<?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ SCM x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF (a);
+ y = SP_REF (b);
+
+ SYNC_IP ();
+ if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y)))
+ vp->compare_result = SCM_F_COMPARE_INVALID;
+ else if (scm_is_true (scm_less_p (x, y)))
+ vp->compare_result = SCM_F_COMPARE_LESS_THAN;
+ else
+ vp->compare_result = SCM_F_COMPARE_NONE;
+ CACHE_SP ();
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (201, check_arguments, "arguments<=?", OP1 (X8_S24))
+ {
+ scm_t_uint8 compare_result;
+ scm_t_uint32 expected;
+ scm_t_ptrdiff nargs;
+
+ UNPACK_24 (op, expected);
+ nargs = FRAME_LOCALS_COUNT ();
+
+ if (nargs < (scm_t_ptrdiff) expected)
+ compare_result = SCM_F_COMPARE_LESS_THAN;
+ else if (nargs == (scm_t_ptrdiff) expected)
+ compare_result = SCM_F_COMPARE_EQUAL;
+ else
+ compare_result = SCM_F_COMPARE_NONE;
+
+ vp->compare_result = compare_result;
+
+ NEXT (1);
+ }
+
+ VM_DEFINE_OP (202, check_positional_arguments, "positional-arguments<=?",
OP2 (X8_C24, X8_C24))
+ {
+ scm_t_uint8 compare_result;
+ scm_t_uint32 nreq, expected;
+ scm_t_ptrdiff nargs;
+
+ UNPACK_24 (op, nreq);
+ UNPACK_24 (ip[1], expected);
+ nargs = FRAME_LOCALS_COUNT ();
+
+ /* We can only have too many positionals if there are more
+ arguments than NPOS. */
+ if (nargs < (scm_t_ptrdiff) nreq)
+ compare_result = SCM_F_COMPARE_LESS_THAN;
+ else
+ {
+ scm_t_ptrdiff npos = nreq;
+ for (npos = nreq; npos < nargs && npos <= expected; npos++)
+ if (scm_is_keyword (FP_REF (npos)))
+ break;
+
+ if (npos < (scm_t_ptrdiff) expected)
+ compare_result = SCM_F_COMPARE_LESS_THAN;
+ else if (npos == (scm_t_ptrdiff) expected)
+ compare_result = SCM_F_COMPARE_EQUAL;
+ else
+ compare_result = SCM_F_COMPARE_NONE;
+ }
+
+ vp->compare_result = compare_result;
+
+ NEXT (2);
+ }
+
+ VM_DEFINE_OP (203, immediate_tag_equals, "immediate-tag=?", OP2 (X8_S24,
C16_C16))
+ {
+ scm_t_uint32 a;
+ scm_t_uint16 mask, expected;
+ SCM x;
+
+ UNPACK_24 (op, a);
+ UNPACK_16_16 (ip[1], mask, expected);
+ x = SP_REF (a);
+
+ if ((SCM_UNPACK (x) & mask) == expected)
+ vp->compare_result = SCM_F_COMPARE_EQUAL;
+ else
+ vp->compare_result = SCM_F_COMPARE_NONE;
+
+ NEXT (2);
+ }
+
+ VM_DEFINE_OP (204, heap_tag_equals, "heap-tag=?", OP2 (X8_S24, C16_C16))
+ {
+ scm_t_uint32 a;
+ scm_t_uint16 mask, expected;
+ SCM x;
+
+ UNPACK_24 (op, a);
+ UNPACK_16_16 (ip[1], mask, expected);
+ x = SP_REF (a);
+
+ if ((SCM_CELL_TYPE (x) & mask) == expected)
+ vp->compare_result = SCM_F_COMPARE_EQUAL;
+ else
+ vp->compare_result = SCM_F_COMPARE_NONE;
+
+ NEXT (2);
+ }
+
+ VM_DEFINE_OP (205, eq, "eq?", OP1 (X8_S12_S12))
+ {
+ scm_t_uint16 a, b;
+ SCM x, y;
+
+ UNPACK_12_12 (op, a, b);
+ x = SP_REF (a);
+ y = SP_REF (b);
+
+ if (scm_is_eq (x, y))
+ vp->compare_result = SCM_F_COMPARE_EQUAL;
+ else
+ vp->compare_result = SCM_F_COMPARE_NONE;
+
+ NEXT (1);
+ }
+
+ /* j offset:24
+ *
+ * Add OFFSET, a signed 24-bit number, to the current instruction
+ * pointer.
+ */
+ VM_DEFINE_OP (206, j, "j", OP1 (X8_L24))
+ {
+ scm_t_int32 offset = op;
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+
+ /* jl offset:24
+ *
+ * If the flags register is equal to SCM_F_COMPARE_LESS_THAN, add
+ * OFFSET, a signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (207, jl, "jl", OP1 (X8_L24))
+ {
+ if (vp->compare_result == SCM_F_COMPARE_LESS_THAN)
+ {
+ scm_t_int32 offset = op;
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+ else
+ NEXT (1);
+ }
+
+ /* je offset:24
+ *
+ * If the flags register is equal to SCM_F_COMPARE_EQUAL, add
+ * OFFSET, a signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (208, je, "je", OP1 (X8_L24))
+ {
+ if (vp->compare_result == SCM_F_COMPARE_EQUAL)
+ {
+ scm_t_int32 offset = op;
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+ else
+ NEXT (1);
+ }
+
+ /* jnl offset:24
+ *
+ * If the flags register is not equal to SCM_F_COMPARE_LESS_THAN, add
+ * OFFSET, a signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (209, jnl, "jnl", OP1 (X8_L24))
+ {
+ if (vp->compare_result != SCM_F_COMPARE_LESS_THAN)
+ {
+ scm_t_int32 offset = op;
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+ else
+ NEXT (1);
+ }
+
+ /* jne offset:24
+ *
+ * If the flags register is not equal to SCM_F_COMPARE_EQUAL, add
+ * OFFSET, a signed 24-bit number, to the current instruction pointer.
+ */
+ VM_DEFINE_OP (210, jne, "jne", OP1 (X8_L24))
+ {
+ if (vp->compare_result != SCM_F_COMPARE_EQUAL)
+ {
+ scm_t_int32 offset = op;
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+ else
+ NEXT (1);
+ }
+
+ /* jge offset:24
+ *
+ * If the flags register is equal to SCM_F_COMPARE_NONE, add OFFSET, a
+ * signed 24-bit number, to the current instruction pointer. This is
+ * intended for use after a "<?" comparison, and is different from
+ * "jnl" in the way it handles not-a-number (NaN) values: "<?" sets
+ * SCM_F_COMPARE_UNORDERED instead of SCM_F_COMPARE_NONE if either
+ * value is a NaN. For exact numbers, "jge" is the same as "jnl".
+ */
+ VM_DEFINE_OP (211, jge, "jge", OP1 (X8_L24))
+ {
+ if (vp->compare_result == SCM_F_COMPARE_NONE)
+ {
+ scm_t_int32 offset = op;
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+ else
+ NEXT (1);
+ }
+
+ /* jnge offset:24
+ *
+ * If the flags register is not equal to SCM_F_COMPARE_NONE, add
+ * OFFSET, a signed 24-bit number, to the current instruction pointer.
+ * This is intended for use after a "<?" comparison, and is different
+ * from "jl" in the way it handles not-a-number (NaN) values: "<?"
+ * sets SCM_F_COMPARE_UNORDERED instead of SCM_F_COMPARE_NONE if
+ * either value is a NaN. For exact numbers, "jnge" is the same as
+ * "jl".
+ */
+ VM_DEFINE_OP (212, jnge, "jnge", OP1 (X8_L24))
+ {
+ if (vp->compare_result != SCM_F_COMPARE_NONE)
+ {
+ scm_t_int32 offset = op;
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+ else
+ NEXT (1);
+ }
+
VM_DEFINE_OP (213, unused_213, NULL, NOP)
VM_DEFINE_OP (214, unused_214, NULL, NOP)
VM_DEFINE_OP (215, unused_215, NULL, NOP)
diff --git a/libguile/vm.c b/libguile/vm.c
index daa1593..6db2611 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -23,6 +23,7 @@
#include <stdlib.h>
#include <alloca.h>
#include <alignof.h>
+#include <math.h>
#include <string.h>
#include <stdint.h>
#include <unistd.h>
@@ -886,6 +887,7 @@ make_vm (void)
vp->sp = vp->stack_top;
vp->sp_min_since_gc = vp->sp;
vp->fp = vp->stack_top;
+ vp->compare_result = SCM_F_COMPARE_NONE;
vp->engine = vm_default_engine;
vp->trace_level = 0;
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
diff --git a/libguile/vm.h b/libguile/vm.h
index a1cac39..d9e5430 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software
Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Free
Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -35,10 +35,18 @@ enum {
#define SCM_VM_DEBUG_ENGINE 1
#define SCM_VM_NUM_ENGINES 2
+enum scm_compare {
+ SCM_F_COMPARE_NONE = 0x0,
+ SCM_F_COMPARE_EQUAL = 0x1,
+ SCM_F_COMPARE_LESS_THAN = 0x2,
+ SCM_F_COMPARE_INVALID = 0x3
+};
+
struct scm_vm {
scm_t_uint32 *ip; /* instruction pointer */
union scm_vm_stack_element *sp; /* stack pointer */
union scm_vm_stack_element *fp; /* frame pointer */
+ scm_t_uint8 compare_result; /* flags register: a value from scm_compare */
union scm_vm_stack_element *stack_limit; /* stack limit address */
int trace_level; /* traces enabled if trace_level > 0 */
union scm_vm_stack_element *sp_min_since_gc; /* deepest sp since last gc */
- [Guile-commits] branch master updated (214e887 -> cd947a1), Andy Wingo, 2017/10/26
- [Guile-commits] 04/07: Add assembler and disassembler support for new instructions, Andy Wingo, 2017/10/26
- [Guile-commits] 03/07: Add (system base types internal)., Andy Wingo, 2017/10/26
- [Guile-commits] 01/07: Add support for C16_C16 instruction words, Andy Wingo, 2017/10/26
- [Guile-commits] 02/07: Add new-style test and branch instructions,
Andy Wingo <=
- [Guile-commits] 07/07: Model all special immediates under one type bit (with range), Andy Wingo, 2017/10/26
- [Guile-commits] 05/07: First step towards emitting new instructions: "j" instead of "br", Andy Wingo, 2017/10/26
- [Guile-commits] 06/07: Type inference distinguishes &fixnum and &bignum types, Andy Wingo, 2017/10/26