[Guile-commits] 02/05: Add support for dynamic-state-related intrinsics

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 4779a10223078c89db4734857850df9af3d6830d
Author: Andy Wingo <address@hidden>
Date:   Sun Apr 29 10:09:01 2018 +0200

    Add support for dynamic-state-related intrinsics
    
    * libguile/vm-engine.c (call-thread, call-thread-scm-scm)
      (call-scm<-thread-scm): New intrinsics.
    * module/system/vm/assembler.scm (define-thread-scm-scm-intrinsic)
      (define-thread-intrinsic, define-scm<-thread-scm-intrinsic): New
      helpers.
      (encode-X8_S12_S12-C32!/shuffle): New shuffler.
    * libguile/intrinsics.h: Add new intrinsic types.
---
 libguile/intrinsics.h          |  3 +++
 libguile/vm-engine.c           | 49 +++++++++++++++++++++++++++++++++++++++---
 module/system/vm/assembler.scm | 19 ++++++++++++++++
 3 files changed, 68 insertions(+), 3 deletions(-)

diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 331e12a..b0f6d65 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -32,6 +32,9 @@ 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);
+typedef void (*scm_t_thread_scm_scm_intrinsic) (scm_i_thread*, SCM, SCM);
+typedef void (*scm_t_thread_intrinsic) (scm_i_thread*);
+typedef SCM (*scm_t_scm_from_thread_scm_intrinsic) (scm_i_thread*, SCM);
 
 #define SCM_FOR_ALL_VM_INTRINSICS(M) \
   M(scm_from_scm_scm, add, "add", ADD) \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 256a279..19c263f 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2255,9 +2255,52 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       NEXT (4);
     }
 
-  VM_DEFINE_OP (87, unused_87, NULL, NOP)
-  VM_DEFINE_OP (88, unused_88, NULL, NOP)
-  VM_DEFINE_OP (89, unused_89, NULL, NOP)
+  VM_DEFINE_OP (87, call_thread_scm_scm, "call-thread-scm-scm", OP2 
(X8_S12_S12, C32))
+    {
+      scm_t_uint16 a, b;
+      scm_t_thread_scm_scm_intrinsic intrinsic;
+
+      UNPACK_12_12 (op, a, b);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      intrinsic (thread, SP_REF (a), SP_REF (b));
+      CACHE_SP ();
+
+      NEXT (2);
+    }
+
+  VM_DEFINE_OP (88, call_thread, "call-thread", OP2 (X32, C32))
+    {
+      scm_t_thread_intrinsic intrinsic;
+
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      intrinsic (thread);
+      CACHE_SP ();
+
+      NEXT (2);
+    }
+
+  VM_DEFINE_OP (89, call_scm_from_thread_scm, "call-scm<-thread-scm", OP2 
(X8_S12_S12, C32) | OP_DST)
+    {
+      scm_t_uint16 dst, src;
+      scm_t_scm_from_thread_scm_intrinsic intrinsic;
+      SCM res;
+
+      UNPACK_12_12 (op, dst, src);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      res = intrinsic (thread, SP_REF (src));
+      CACHE_SP ();
+
+      SP_SET (dst, res);
+
+      NEXT (2);
+    }
+
   VM_DEFINE_OP (90, unused_90, NULL, NOP)
   VM_DEFINE_OP (91, unused_91, NULL, NOP)
   VM_DEFINE_OP (92, unused_92, NULL, NOP)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 6b249d4..973179a 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -909,6 +909,15 @@ later by the linker."
     (emit-push asm src)
     (encode-X8_S12_S12-C32 asm 0 0 c32 opcode)
     (emit-pop asm dst))))
+(define (encode-X8_S12_S12-C32!/shuffle asm a b c32 opcode)
+  (cond
+   ((< (logior a b) (ash 1 12))
+    (encode-X8_S12_S12-C32 asm a b c32 opcode))
+   (else
+    (emit-push asm a)
+    (emit-push asm b)
+    (encode-X8_S12_S12-C32 asm 1 0 c32 opcode)
+    (emit-drop asm 2))))
 
 (eval-when (expand)
   (define (id-append ctx a b)
@@ -931,6 +940,7 @@ later by the linker."
       (('<- 'X8_S8_S8_C8 'C32)   #'encode-X8_S8_S8_C8-C32<-/shuffle)
       (('! 'X8_S8_S8_C8 'C32)    #'encode-X8_S8_S8_C8-C32!/shuffle)
       (('<- 'X8_S12_S12 'C32)    #'encode-X8_S12_S12-C32<-/shuffle)
+      (('! 'X8_S12_S12 'C32)     #'encode-X8_S12_S12-C32!/shuffle)
       (('! 'X8_S8_C8_S8)         #'encode-X8_S8_C8_S8!/shuffle)
       (('<- 'X8_S8_C8_S8)        #'encode-X8_S8_C8_S8<-/shuffle)
       (else (encoder-name operands))))
@@ -1311,6 +1321,15 @@ returned instead."
 (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-syntax-rule (define-thread-scm-scm-intrinsic name)
+  (define-macro-assembler (name asm a b)
+    (emit-call-thread-scm-scm asm a b (intrinsic-name->index 'name))))
+(define-syntax-rule (define-thread-intrinsic name)
+  (define-macro-assembler (name asm)
+    (emit-call-thread asm (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-thread-scm-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-scm<-thread-scm asm dst src (intrinsic-name->index 'name))))
 
 (define-scm<-scm-scm-intrinsic add)
 (define-scm<-scm-uimm-intrinsic add/immediate)