[Guile-commits] 01/13: allocate-words intrinsic

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 0faa4144d14723c2774af88c146617e9ef2e066b
Author: Andy Wingo <address@hidden>
Date:   Wed Jun 27 14:36:56 2018 +0200

    allocate-words intrinsic
    
    * libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
    * libguile/intrinsics.c (allocate_words, scm_bootstrap_intrinsics): New
      intrinsic.
    * libguile/vm-engine.c (allocate-words, allocate-words/immediate): Use
      new intrinsic.
---
 libguile/intrinsics.c |  8 ++++++++
 libguile/intrinsics.h |  2 ++
 libguile/vm-engine.c  | 27 ++++++++++++++++++++-------
 3 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 73ad2b0..cc8cd2b 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -26,6 +26,7 @@
 #include "cache-internal.h"
 #include "extensions.h"
 #include "fluids.h"
+#include "gc-inline.h"
 #include "goops.h"
 #include "gsubr.h"
 #include "keywords.h"
@@ -333,6 +334,12 @@ error_wrong_number_of_values (uint32_t expected)
                   scm_list_1 (scm_from_uint32 (expected)));
 }
 
+static SCM
+allocate_words (scm_thread *thread, uint64_t n)
+{
+  return SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n));
+}
+
 
 void
 scm_bootstrap_intrinsics (void)
@@ -386,6 +393,7 @@ scm_bootstrap_intrinsics (void)
   scm_vm_intrinsics.error_no_values = error_no_values;
   scm_vm_intrinsics.error_not_enough_values = error_not_enough_values;
   scm_vm_intrinsics.error_wrong_number_of_values = 
error_wrong_number_of_values;
+  scm_vm_intrinsics.allocate_words = allocate_words;
 
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index ac59661..02045f3 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -62,6 +62,7 @@ typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) 
SCM_NORETURN;
 typedef void (*scm_t_noreturn_intrinsic) (void) SCM_NORETURN;
 typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN;
 typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN;
+typedef SCM (*scm_t_scm_from_thread_u64_intrinsic) (scm_thread*, uint64_t);
 
 #define SCM_FOR_ALL_VM_INTRINSICS(M) \
   M(scm_from_scm_scm, add, "add", ADD) \
@@ -125,6 +126,7 @@ typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) 
SCM_NORETURN;
   M(noreturn, error_not_enough_values, "not-enough-values", 
ERROR_NOT_ENOUGH_VALUES) \
   M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values", 
ERROR_WRONG_NUMBER_OF_VALUES) \
   M(thread, apply_non_program, "apply-non-program", APPLY_NON_PROGRAM) \
+  M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \
   /* 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 88cfb61..7988536 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1155,10 +1155,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int 
resume)
       UNPACK_12_12 (op, dst, size);
 
       SYNC_IP ();
-      SP_SET (dst,
-              SCM_PACK_POINTER
-              (scm_inline_gc_malloc_words (thread, SP_REF_U64 (size))));
-
+      SP_SET (dst, scm_vm_intrinsics.allocate_words (thread, SP_REF_U64 
(size)));
       NEXT (1);
     }
 
@@ -1169,8 +1166,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int 
resume)
       UNPACK_12_12 (op, dst, size);
 
       SYNC_IP ();
-      SP_SET (dst,
-              SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, size)));
+      SP_SET (dst, scm_vm_intrinsics.allocate_words (thread, size));
 
       NEXT (1);
     }
@@ -1945,7 +1941,24 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int 
resume)
       NEXT (2);
     }
 
-  VM_DEFINE_OP (92, unused_92, NULL, NOP)
+  VM_DEFINE_OP (92, call_scm_from_thread, "call-scm<-thread", OP2 (X8_S24, 
C32) | OP_DST)
+    {
+      uint32_t dst;
+      scm_t_scm_from_thread_intrinsic intrinsic;
+      SCM res;
+
+      UNPACK_24 (op, dst);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      res = intrinsic (thread);
+      CACHE_SP ();
+
+      SP_SET (dst, res);
+
+      NEXT (2);
+    }
+
   VM_DEFINE_OP (93, unused_93, NULL, NOP)
   VM_DEFINE_OP (94, unused_94, NULL, NOP)
   VM_DEFINE_OP (95, unused_95, NULL, NOP)