[Guile-commits] 14/26: Add intrinsic for foreign-call

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 5448e5a4b008a1e25b24f00dc627c08457b69914
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 26 09:22:07 2018 +0200

    Add intrinsic for foreign-call
    
    * libguile/Makefile.am (noinst_HEADERS, modinclude_HEADERS): Change to
      not install intrinsics.h.
    * libguile/intrinsics.h: Add an error if BUILDING_LIBGUILE isn't set, to
      catch any stray bad inclusions.  Add intrinsic for foreign-call.
    * libguile/foreign.c (foreign_call): Rename from scm_i_foreign_call, and
      set as the foreign-call intrinsic.
    * libguile/vm-engine.c (foreign-call): Use the intrinsic.  In the future
      we'll want to totally revamp the FFI, if we know that a JIT is
      available!
---
 libguile/Makefile.am  |  2 +-
 libguile/foreign.c    | 10 ++++++----
 libguile/foreign.h    |  3 ---
 libguile/intrinsics.h | 19 +++++++++++--------
 libguile/vm-engine.c  |  2 +-
 5 files changed, 19 insertions(+), 17 deletions(-)

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 70f3abc..4e782f2 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -516,6 +516,7 @@ uninstall-hook:
 ## working.
 noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c            \
                  elf.h                                         \
+                 intrinsics.h                                  \
                  srfi-14.i.c                                   \
                  quicksort.i.c                                  \
                  atomics-internal.h                            \
@@ -631,7 +632,6 @@ modinclude_HEADERS =                                \
        init.h                                  \
        inline.h                                \
        instructions.h                          \
-       intrinsics.h                            \
        ioext.h                                 \
        iselect.h                               \
        keywords.h                              \
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 431fda8..739d459 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -38,6 +38,7 @@
 #include "finalizers.h"
 #include "gsubr.h"
 #include "instructions.h"
+#include "intrinsics.h"
 #include "keywords.h"
 #include "list.h"
 #include "modules.h"
@@ -870,7 +871,7 @@ cif_to_procedure (SCM cif, SCM func_ptr, int with_errno)
 /* Set *LOC to the foreign representation of X with TYPE.  */
 static void
 unpack (const ffi_type *type, void *loc, SCM x, int return_value_p)
-#define FUNC_NAME "scm_i_foreign_call"
+#define FUNC_NAME "foreign-call"
 {
   switch (type->type)
     {
@@ -1016,9 +1017,9 @@ pack (const ffi_type * type, const void *loc, int 
return_value_p)
 
 #define MAX(A, B) ((A) >= (B) ? (A) : (B))
 
-SCM
-scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
-                    const union scm_vm_stack_element *argv)
+static SCM
+foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
+              const union scm_vm_stack_element *argv)
 {
   /* FOREIGN is the pair that cif_to_procedure set as the 0th element of the
      objtable. */
@@ -1305,5 +1306,6 @@ scm_register_foreign (void)
                             "scm_init_foreign",
                             (scm_t_extension_init_func)scm_init_foreign,
                             NULL);
+  scm_vm_intrinsics.foreign_call = foreign_call;
   pointer_weak_refs = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
 }
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 37938ee..01a1ef8 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -106,9 +106,6 @@ SCM_API SCM scm_pointer_to_procedure_with_errno (SCM 
return_type, SCM func_ptr,
                                                  SCM arg_types);
 SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr,
                                      SCM arg_types);
-SCM_INTERNAL SCM scm_i_foreign_call (SCM cif_scm, SCM pointer_scm,
-                                     int *errno_ret,
-                                     const union scm_vm_stack_element *argv);
 
 
 
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 16760e3..df15515 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -17,14 +17,16 @@
    License along with Guile.  If not, see
    <https://www.gnu.org/licenses/>.  */
 
-#ifndef _SCM_VM_INTRINSICS_H_
-#define _SCM_VM_INTRINSICS_H_
+#ifndef _SCM_INTRINSICS_H_
+#define _SCM_INTRINSICS_H_
 
-#include <libguile/scm.h>
+#ifndef BUILDING_LIBGUILE
+#error intrinsics.h is private and uninstalled
+#endif
 
-#ifdef BUILDING_LIBGUILE
+#include <libguile/scm.h>
+#include <libguile/threads.h>
 
-#include <libguile/vm.h>
 
 typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM);
 typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, uint8_t);
@@ -48,6 +50,8 @@ typedef uint32_t (*scm_t_u32_from_thread_u32_u32_intrinsic) 
(scm_i_thread*, uint
 typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_i_thread*, 
uint32_t,
                                                           uint32_t, SCM, 
uint8_t,
                                                           uint8_t);
+typedef SCM (*scm_t_scm_from_scm_scm_intp_sp_intrinsic) (SCM, SCM, int*,
+                                                         const union 
scm_vm_stack_element*);
 
 #define SCM_FOR_ALL_VM_INTRINSICS(M) \
   M(scm_from_scm_scm, add, "add", ADD) \
@@ -97,6 +101,7 @@ typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) 
(scm_i_thread*, uint32_
   M(u32_from_thread_u32_u32, compute_kwargs_npositional, 
"compute-kwargs-npositional", COMPUTE_KWARGS_NPOSITIONAL) \
   M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \
   M(thread, push_interrupt_frame, "push-interrupt-frame", 
PUSH_INTERRUPT_FRAME) \
+  M(scm_from_scm_scm_intp_sp, foreign_call, "foreign-call", FOREIGN_CALL) \
   /* Add new intrinsics here; also update scm_bootstrap_intrinsics.  */
 
 enum scm_vm_intrinsic
@@ -114,11 +119,9 @@ SCM_INTERNAL struct scm_vm_intrinsics
 #undef DEFINE_MEMBER
 } scm_vm_intrinsics;
 
-#endif /* BUILDING_LIBGUILE  */
-
 SCM_INTERNAL SCM scm_intrinsic_list (void);
 
 SCM_INTERNAL void scm_bootstrap_intrinsics (void);
 SCM_INTERNAL void scm_init_intrinsics (void);
 
-#endif /* _SCM_VM_INTRINSICS_H_ */
+#endif /* _SCM_INTRINSICS_H_ */
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index ac47da6..8e86382 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -645,7 +645,7 @@ VM_NAME (scm_i_thread *thread, jmp_buf *registers, int 
resume)
       pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
 
       SYNC_IP ();
-      ret = scm_i_foreign_call (cif, pointer, &err, sp);
+      ret = scm_vm_intrinsics.foreign_call (cif, pointer, &err, sp);
       CACHE_SP ();
 
       ALLOC_FRAME (3);