From 5448e5a4b008a1e25b24f00dc627c08457b69914 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 26 Jun 2018 09:22:07 +0200 Subject: [PATCH] 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 70f3abcb3..4e782f215 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 431fda811..739d45912 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 37938ee47..01a1ef88a 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 16760e3c8..df1551529 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -17,14 +17,16 @@ License along with Guile. If not, see . */ -#ifndef _SCM_VM_INTRINSICS_H_ -#define _SCM_VM_INTRINSICS_H_ +#ifndef _SCM_INTRINSICS_H_ +#define _SCM_INTRINSICS_H_ + +#ifndef BUILDING_LIBGUILE +#error intrinsics.h is private and uninstalled +#endif #include +#include -#ifdef BUILDING_LIBGUILE - -#include 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 ac47da67b..8e863827d 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);