summaryrefslogtreecommitdiff
path: root/libguile/vm-engine.c
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2016-01-05 16:30:41 -0500
committerAndy Wingo <wingo@pobox.com>2016-12-18 23:05:15 +0100
commita396e14cb139eba37eeeea44e745bfc57bd1f37d (patch)
treed43075401d719e54382525ca09709adbaa517d4a /libguile/vm-engine.c
parent546eb479b1fc7e3143b05aaeec16175d1cea0e08 (diff)
downloadguile-a396e14cb139eba37eeeea44e745bfc57bd1f37d.tar.gz
FFI: Add support for functions that set 'errno'.
Implements wishlist item <https://debbugs.gnu.org/18592>. Requested by Frank Terbeck <ft@bewatermyfriend.org>. Based on a proposed patch by Nala Ginrut <nalaginrut@gmail.com>. Patch ported to 2.2 by Andy Wingo <wingo@pobox.com>. * libguile/foreign.c (cif_to_procedure): Add 'with_errno' argument. If true, truncate result to only one return value. (scm_i_foreign_call): Separate the arguments. Always return errno. (pointer_to_procedure): New static function. (scm_pointer_to_procedure_with_errno): New C API function, implemented in terms of 'pointer_to_procedure'. (scm_pointer_to_procedure): Reimplement in terms of 'pointer_to_procedure', no longer bound to "pointer->procedure". See below. (scm_i_pointer_to_procedure): New C function bound to "pointer->procedure" which now accepts the optional #:return-errno? keyword argument, implemented in terms of 'pointer_to_procedure'. (k_return_errno): New keyword #:return-errno?. * libguile/foreign.h (scm_pointer_to_procedure_with_errno): Add prototype. * doc/ref/api-foreign.texi (Dynamic FFI): Adjust documentation. * libguile/vm-engine.c (foreign-call): Return two values.
Diffstat (limited to 'libguile/vm-engine.c')
-rw-r--r--libguile/vm-engine.c29
1 files changed, 7 insertions, 22 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 44068458e..195237ab4 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -791,6 +791,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (11, foreign_call, "foreign-call", OP1 (X8_C12_C12))
{
scm_t_uint16 cif_idx, ptr_idx;
+ int err = 0;
SCM closure, cif, pointer, ret;
UNPACK_12_12 (op, cif_idx, ptr_idx);
@@ -800,30 +801,14 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
SYNC_IP ();
-
- // FIXME: separate args
- ret = scm_i_foreign_call (scm_inline_cons (thread, cif, pointer), sp);
-
+ ret = scm_i_foreign_call (cif, pointer, &err, sp);
CACHE_SP ();
- if (SCM_UNLIKELY (SCM_VALUESP (ret)))
- {
- SCM vals = scm_struct_ref (ret, SCM_INUM0);
- long len = scm_ilength (vals);
- ALLOC_FRAME (1 + len);
- while (len--)
- {
- SP_SET (len, SCM_CAR (vals));
- vals = SCM_CDR (vals);
- }
- NEXT (1);
- }
- else
- {
- ALLOC_FRAME (2);
- SP_SET (0, ret);
- NEXT (1);
- }
+ ALLOC_FRAME (3);
+ SP_SET (1, ret);
+ SP_SET (0, scm_from_int (err));
+
+ NEXT (1);
}
/* continuation-call contregs:24