mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-15 08:10:17 +02:00
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!
This commit is contained in:
parent
4a2d78b4d4
commit
5448e5a4b0
5 changed files with 19 additions and 17 deletions
|
@ -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 \
|
||||
|
|
|
@ -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
|
||||
scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
|
||||
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
|
||||
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -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_
|
||||
|
||||
#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_ */
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue