diff options
author | Mark H Weaver <mhw@netris.org> | 2016-01-05 16:30:41 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-12-18 23:05:15 +0100 |
commit | a396e14cb139eba37eeeea44e745bfc57bd1f37d (patch) | |
tree | d43075401d719e54382525ca09709adbaa517d4a /libguile/vm-engine.c | |
parent | 546eb479b1fc7e3143b05aaeec16175d1cea0e08 (diff) | |
download | guile-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.c | 29 |
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 |