1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00

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.
This commit is contained in:
Mark H Weaver 2016-01-05 16:30:41 -05:00 committed by Andy Wingo
parent 546eb479b1
commit a396e14cb1
4 changed files with 101 additions and 72 deletions

View file

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