[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 07/15: scm->u64, scm->s64, scm->u64/truncate intrinsics
From: |
Andy Wingo |
Subject: |
[Guile-commits] 07/15: scm->u64, scm->s64, scm->u64/truncate intrinsics |
Date: |
Fri, 13 Apr 2018 04:41:12 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit dd88fc569d287101e3527138440e7e14eaca43a5
Author: Andy Wingo <address@hidden>
Date: Thu Apr 12 16:22:40 2018 +0200
scm->u64, scm->s64, scm->u64/truncate intrinsics
* libguile/intrinsics.c (scm_to_uint64_truncate): New intrinsic.
(scm_bootstrap_intrinsics): Init new intrinsics.
* libguile/intrinsics.h: Add scm->u64, scm->u64/truncate, and scm->s64
as intrinsics, with their corresponding types.
* libguile/vm-engine.c (call-u64<-scm, call-s64<-scm): New intrinsic
calling ops.
(scm->u64, scm->s64, scm->u64/truncate): Disable opcodes.
* module/language/cps/reify-primitives.scm (compute-known-primitives):
Add intrinsics as new macroinstructions.
* module/system/vm/assembler.scm: Declare new intrinsic assemblers.
---
libguile/intrinsics.c | 12 +++++++
libguile/intrinsics.h | 5 +++
libguile/vm-engine.c | 55 ++++++++++++++++++++------------
module/language/cps/reify-primitives.scm | 3 ++
module/system/vm/assembler.scm | 15 +++++++--
5 files changed, 66 insertions(+), 24 deletions(-)
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 0814b0d..d8b58ad 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -71,6 +71,15 @@ string_to_number (SCM str)
return scm_string_to_number (str, SCM_UNDEFINED /* radix = 10 */);
}
+static scm_t_uint64
+scm_to_uint64_truncate (SCM x)
+{
+ if (SCM_I_INUMP (x))
+ return (scm_t_uint64) SCM_I_INUM (x);
+ else
+ return scm_to_uint64 (scm_logand (x, scm_from_uint64 ((scm_t_uint64) -1)));
+}
+
void
scm_bootstrap_intrinsics (void)
{
@@ -92,6 +101,9 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword;
scm_vm_intrinsics.class_of = scm_class_of;
scm_vm_intrinsics.scm_to_f64 = scm_to_double;
+ scm_vm_intrinsics.scm_to_u64 = scm_to_uint64;
+ scm_vm_intrinsics.scm_to_u64_truncate = scm_to_uint64_truncate;
+ scm_vm_intrinsics.scm_to_s64 = scm_to_int64;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index b14bb47..aea73dd 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -28,6 +28,8 @@ typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM,
scm_t_uint8);
typedef void (*scm_t_scm_u64_u64_intrinsic) (SCM, scm_t_uint64, scm_t_uint64);
typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM);
typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
+typedef scm_t_uint64 (*scm_t_u64_from_scm_intrinsic) (SCM);
+typedef scm_t_int64 (*scm_t_s64_from_scm_intrinsic) (SCM);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \
@@ -48,6 +50,9 @@ typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
M(scm_from_scm, symbol_to_keyword, "symbol->keyword", SYMBOL_TO_KEYWORD) \
M(scm_from_scm, class_of, "class-of", CLASS_OF) \
M(f64_from_scm, scm_to_f64, "scm->f64", SCM_TO_F64) \
+ M(u64_from_scm, scm_to_u64, "scm->u64", SCM_TO_U64) \
+ M(u64_from_scm, scm_to_u64_truncate, "scm->u64/truncate",
SCM_TO_U64_TRUNCATE) \
+ M(s64_from_scm, scm_to_s64, "scm->s64", SCM_TO_S64) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 2b274aa..0e89292 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1580,10 +1580,21 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (2);
}
- VM_DEFINE_OP (56, unused_56, NULL, NOP)
+ VM_DEFINE_OP (56, call_u64_from_scm, "call-u64<-scm", OP2 (X8_S12_S12, C32)
| OP_DST)
{
- vm_error_bad_instruction (op);
- abort (); /* never reached */
+ scm_t_uint8 dst, src;
+ scm_t_uint64 res;
+ scm_t_u64_from_scm_intrinsic intrinsic;
+
+ UNPACK_12_12 (op, dst, src);
+ intrinsic = intrinsics[ip[1]];
+
+ SYNC_IP ();
+ res = intrinsic (SP_REF (src));
+ CACHE_SP ();
+ SP_SET_U64 (dst, res);
+
+ NEXT (2);
}
@@ -2148,7 +2159,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (2);
}
- VM_DEFINE_OP (77, unused_77, NULL, NOP)
+ VM_DEFINE_OP (77, call_s64_from_scm, "call-s64<-scm", OP2 (X8_S12_S12, C32)
| OP_DST)
+ {
+ scm_t_uint8 dst, src;
+ scm_t_int64 res;
+ scm_t_s64_from_scm_intrinsic intrinsic;
+
+ UNPACK_12_12 (op, dst, src);
+ intrinsic = intrinsics[ip[1]];
+
+ SYNC_IP ();
+ res = intrinsic (SP_REF (src));
+ CACHE_SP ();
+ SP_SET_S64 (dst, res);
+
+ NEXT (2);
+ }
+
VM_DEFINE_OP (78, unused_78, NULL, NOP)
VM_DEFINE_OP (79, unused_79, NULL, NOP)
VM_DEFINE_OP (80, unused_80, NULL, NOP)
@@ -2328,11 +2355,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (0);
}
- /* scm->u64 dst:12 src:12
- *
- * Unpack an unsigned 64-bit integer from SRC and place it in DST.
- */
- VM_DEFINE_OP (143, scm_to_u64, "scm->u64", OP1 (X8_S12_S12) | OP_DST)
+ VM_DEFINE_OP (143, unused_143, NULL, NOP)
{
scm_t_uint16 dst, src;
UNPACK_12_12 (op, dst, src);
@@ -2491,11 +2514,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (3);
}
- /* scm->s64 dst:12 src:12
- *
- * Unpack a signed 64-bit integer from SRC and place it in DST.
- */
- VM_DEFINE_OP (157, scm_to_s64, "scm->s64", OP1 (X8_S12_S12) | OP_DST)
+ VM_DEFINE_OP (157, unused_157, NULL, NOP)
{
scm_t_uint16 dst, src;
UNPACK_12_12 (op, dst, src);
@@ -2647,13 +2666,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
- /* scm->u64/truncate dst:12 src:12
- *
- * Unpack an exact integer from SRC and place it in the unsigned
- * 64-bit register DST, truncating any high bits. If the number in
- * SRC is negative, all the high bits will be set.
- */
- VM_DEFINE_OP (167, scm_to_u64_truncate, "scm->u64/truncate", OP1
(X8_S12_S12) | OP_DST)
+ VM_DEFINE_OP (167, unused_167, NULL, NOP)
{
scm_t_uint16 dst, src;
SCM x;
diff --git a/module/language/cps/reify-primitives.scm
b/module/language/cps/reify-primitives.scm
index c1ebd1c..66d00d7 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -230,6 +230,9 @@
symbol->keyword
class-of
scm->f64
+ scm->u64
+ scm->u64/truncate
+ scm->s64
u64->s64
s64->u64
cache-current-module!
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 88f713a..e47e625 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -201,6 +201,9 @@
emit-symbol->keyword
emit-class-of
emit-scm->f64
+ emit-scm->u64
+ emit-scm->u64/truncate
+ emit-scm->s64
emit-call
emit-call-label
@@ -263,11 +266,8 @@
emit-ulsh/immediate
emit-make-array
emit-load-f64
- emit-scm->u64
- emit-scm->u64/truncate
emit-load-u64
emit-u64->scm
- emit-scm->s64
emit-load-s64
emit-s64->scm
emit-make-atomic-box
@@ -1296,6 +1296,12 @@ returned instead."
(define-syntax-rule (define-f64<-scm-intrinsic name)
(define-macro-assembler (name asm dst src)
(emit-call-f64<-scm asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-u64<-scm-intrinsic name)
+ (define-macro-assembler (name asm dst src)
+ (emit-call-u64<-scm asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-s64<-scm-intrinsic name)
+ (define-macro-assembler (name asm dst src)
+ (emit-call-s64<-scm asm dst src (intrinsic-name->index 'name))))
(define-scm<-scm-scm-intrinsic add)
(define-scm<-scm-uimm-intrinsic add/immediate)
@@ -1315,6 +1321,9 @@ returned instead."
(define-scm<-scm-intrinsic symbol->keyword)
(define-scm<-scm-intrinsic class-of)
(define-f64<-scm-intrinsic scm->f64)
+(define-u64<-scm-intrinsic scm->u64)
+(define-u64<-scm-intrinsic scm->u64/truncate)
+(define-s64<-scm-intrinsic scm->s64)
(define-macro-assembler (begin-program asm label properties)
(emit-label asm label)
- [Guile-commits] 06/15: Remove scm->f64, f64->scm implementations, (continued)
- [Guile-commits] 06/15: Remove scm->f64, f64->scm implementations, Andy Wingo, 2018/04/13
- [Guile-commits] 04/15: Instruction explosion for f64->scm, Andy Wingo, 2018/04/13
- [Guile-commits] 03/15: Add reifier for fadd/immediate., Andy Wingo, 2018/04/13
- [Guile-commits] 02/15: Slim heap-allocated flonums, Andy Wingo, 2018/04/13
- [Guile-commits] 01/15: Add scm->f64 intrinsic, Andy Wingo, 2018/04/13
- [Guile-commits] 11/15: logsub is intrinsic, Andy Wingo, 2018/04/13
- [Guile-commits] 09/15: u64->scm, s64->scm intrinsics, Andy Wingo, 2018/04/13
- [Guile-commits] 08/15: Remove scm->u64, etc implementations, Andy Wingo, 2018/04/13
- [Guile-commits] 10/15: Remove implementations of obsolete s64->scm, u64->scm insts, Andy Wingo, 2018/04/13
- [Guile-commits] 12/15: Remove implementation of logsub VM op, Andy Wingo, 2018/04/13
- [Guile-commits] 07/15: scm->u64, scm->s64, scm->u64/truncate intrinsics,
Andy Wingo <=
- [Guile-commits] 14/15: Remove implementation of atomic box ops, Andy Wingo, 2018/04/13
- [Guile-commits] 13/15: Explode atomic box ops to new atomic instructions, Andy Wingo, 2018/04/13
- [Guile-commits] 15/15: Remove unused macros in vm-engine, Andy Wingo, 2018/04/13