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

@@ -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				\

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,8 +1017,8 @@ pack (const ffi_type * type, const void *loc, int return_value_p)
 
 #define MAX(A, B) ((A) >= (B) ? (A) : (B))
 
-SCM
+static SCM
-scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
+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
@@ -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);
 }

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);
 
 
 

libguile/intrinsics.h

@@ -17,14 +17,16 @@
    License along with Guile.  If not, see
    <https://www.gnu.org/licenses/>.  */
 
-#ifndef _SCM_VM_INTRINSICS_H_
+#ifndef _SCM_INTRINSICS_H_
-#define _SCM_VM_INTRINSICS_H_
+#define _SCM_INTRINSICS_H_
+
+#ifndef BUILDING_LIBGUILE
+#error intrinsics.h is private and uninstalled
+#endif
 
 #include <libguile/scm.h>
+#include <libguile/threads.h>
 
-#ifdef BUILDING_LIBGUILE
-
-#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_ */

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);