mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +02:00
Code Activity

Add intrinsic for foreign-call

Browse source 
* 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:
Andy Wingo 2018-06-26 09:22:07 +02:00
parent 4a2d78b4d4
commit 5448e5a4b0
5 changed files with 19 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/Makefile.am
View file

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

10
libguile/foreign.c
View file

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

3
libguile/foreign.h
View file

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

19
libguile/intrinsics.h
View file

@ -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_ */

2
libguile/vm-engine.c
View file

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