From 7e386bbc70c5b299f7077687722dd5d267e2bd00 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 12 Apr 2018 16:43:57 +0200 Subject: u64->scm, s64->scm intrinsics * libguile/intrinsics.h (u64->scm, s64->scm): New intrinsics. * libguile/intrinsics.c (scm_bootstrap_intrinsics): Initialize new intrinsics. * libguile/vm-engine.c (call-scm<-u64, call-scm<-s64): New intrinsic callers. (u64->scm, s64->scm): Disable instructions. * module/language/cps/reify-primitives.scm (compute-known-primitives): Add new intrinsics as macro-instructions. * module/system/vm/assembler.scm (define-scm<-u64-intrinsic): (define-scm<-s64-intrinsic, u64->scm, s64->scm): Wire up new intrinsics. --- libguile/intrinsics.c | 2 ++ libguile/intrinsics.h | 4 +++ libguile/vm-engine.c | 48 ++++++++++++++++++++++++-------- module/language/cps/reify-primitives.scm | 7 ++--- module/system/vm/assembler.scm | 12 ++++++-- 5 files changed, 54 insertions(+), 19 deletions(-) diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index d8b58ad25..a200995bf 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -104,6 +104,8 @@ scm_bootstrap_intrinsics (void) 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_vm_intrinsics.u64_to_scm = scm_from_uint64; + scm_vm_intrinsics.s64_to_scm = scm_from_int64; scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index aea73dd07..c93592031 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -30,6 +30,8 @@ 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); +typedef SCM (*scm_t_scm_from_u64_intrinsic) (scm_t_uint64); +typedef SCM (*scm_t_scm_from_s64_intrinsic) (scm_t_int64); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -53,6 +55,8 @@ typedef scm_t_int64 (*scm_t_s64_from_scm_intrinsic) (SCM); 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) \ + M(scm_from_u64, u64_to_scm, "u64->scm", U64_TO_SCM) \ + M(scm_from_s64, s64_to_scm, "s64->scm", S64_TO_SCM) \ /* 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 561fc9982..0418a65a7 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -2176,8 +2176,40 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (2); } - VM_DEFINE_OP (78, unused_78, NULL, NOP) - VM_DEFINE_OP (79, unused_79, NULL, NOP) + VM_DEFINE_OP (78, call_scm_from_u64, "call-scm<-u64", OP2 (X8_S12_S12, C32) | OP_DST) + { + scm_t_uint8 dst, src; + SCM res; + scm_t_scm_from_u64_intrinsic intrinsic; + + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (SP_REF_U64 (src)); + CACHE_SP (); + SP_SET (dst, res); + + NEXT (2); + } + + VM_DEFINE_OP (79, call_scm_from_s64, "call-scm<-s64", OP2 (X8_S12_S12, C32) | OP_DST) + { + scm_t_uint8 dst, src; + SCM res; + scm_t_scm_from_s64_intrinsic intrinsic; + + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (SP_REF_S64 (src)); + CACHE_SP (); + SP_SET (dst, res); + + NEXT (2); + } + VM_DEFINE_OP (80, unused_80, NULL, NOP) { vm_error_bad_instruction (op); @@ -2361,11 +2393,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, abort (); /* never reached */ } - /* u64->scm dst:12 src:12 - * - * Pack an unsigned 64-bit integer into a SCM value. - */ - VM_DEFINE_OP (144, u64_to_scm, "u64->scm", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (144, unused_144, NULL, NOP) { scm_t_uint16 dst, src; UNPACK_12_12 (op, dst, src); @@ -2517,11 +2545,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, abort (); /* never reached */ } - /* s64->scm dst:12 src:12 - * - * Pack an signed 64-bit integer into a SCM value. - */ - VM_DEFINE_OP (158, s64_to_scm, "s64->scm", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (158, unused_158, NULL, NOP) { scm_t_uint16 dst, src; UNPACK_12_12 (op, dst, src); diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index 66d00d77d..b9551e803 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -230,11 +230,8 @@ symbol->keyword class-of scm->f64 - scm->u64 - scm->u64/truncate - scm->s64 - u64->s64 - s64->u64 + s64->u64 s64->scm scm->s64 + u64->s64 u64->scm scm->u64 scm->u64/truncate cache-current-module! cached-toplevel-box cached-module-box)) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index e47e6250f..fe3f910e2 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -204,6 +204,8 @@ emit-scm->u64 emit-scm->u64/truncate emit-scm->s64 + emit-u64->scm + emit-s64->scm emit-call emit-call-label @@ -267,9 +269,7 @@ emit-make-array emit-load-f64 emit-load-u64 - emit-u64->scm emit-load-s64 - emit-s64->scm emit-make-atomic-box emit-atomic-box-ref emit-atomic-box-set! @@ -1302,6 +1302,12 @@ returned instead." (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-syntax-rule (define-scm<-u64-intrinsic name) + (define-macro-assembler (name asm dst src) + (emit-call-scm<-u64 asm dst src (intrinsic-name->index 'name)))) +(define-syntax-rule (define-scm<-s64-intrinsic name) + (define-macro-assembler (name asm dst src) + (emit-call-scm<-s64 asm dst src (intrinsic-name->index 'name)))) (define-scm<-scm-scm-intrinsic add) (define-scm<-scm-uimm-intrinsic add/immediate) @@ -1324,6 +1330,8 @@ returned instead." (define-u64<-scm-intrinsic scm->u64) (define-u64<-scm-intrinsic scm->u64/truncate) (define-s64<-scm-intrinsic scm->s64) +(define-scm<-u64-intrinsic u64->scm) +(define-scm<-s64-intrinsic s64->scm) (define-macro-assembler (begin-program asm label properties) (emit-label asm label) -- cgit v1.2.1