[Guile-commits] 09/15: u64->scm, s64->scm intrinsics

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 7e386bbc70c5b299f7077687722dd5d267e2bd00
Author: Andy Wingo <address@hidden>
Date:   Thu Apr 12 16:43:57 2018 +0200

    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 d8b58ad..a200995 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 aea73dd..c935920 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 561fc99..0418a65 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 66d00d7..b9551e8 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 e47e625..fe3f910 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)