From: Mark H Weaver <mhw@netris.org>
To: Andy Wingo <wingo@pobox.com>
Cc: 13809@debbugs.gnu.org, guile-devel@gnu.org
Subject: bug#13809: [PATCH] Support calling foreign functions of 10 or more arguments
Date: Tue, 26 Feb 2013 17:40:09 -0500 [thread overview]
Message-ID: <878v6azol2.fsf_-___47199.6740358465$1361918513$gmane$org@tines.lan> (raw)
In-Reply-To: <87a9qs937u.fsf@pobox.com> (Andy Wingo's message of "Mon, 25 Feb 2013 10:01:41 +0100")
[-- Attachment #1: Type: text/plain, Size: 849 bytes --]
Hi Andy,
Andy Wingo <wingo@pobox.com> writes:
> On Mon 25 Feb 2013 01:34, Mark H Weaver <mhw@netris.org> writes:
>
>> The current limitation of 10 arguments to foreign functions is proving
>> to be a problem for some libraries, in particular the Allegro game
>> library.
>>
>> Is there a reason why raising this limit to 16 or 20 would be
>> undesirable? What tradeoffs are involved?
>
> Each arity of foreign functions gets a little VM program stub that
> checks the argument count then actually does the call. We statically
> generate the first N of those arities (currently 10), and then for the
> rest we should dynamically allocate the objcode stubs. Dynamic
> allocation is currently unimplemented.
I've attached a patch that implements dynamic allocation of objcode
stubs for larger arities. What do you think?
Thanks,
Mark
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Support calling foreign functions of 10 or more arguments --]
[-- Type: text/x-diff, Size: 5562 bytes --]
From 29aaa7add08849503bde5a9be43b162e492a4297 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 26 Feb 2013 17:25:51 -0500
Subject: [PATCH] Support calling foreign functions of 10 or more arguments.
* libguile/foreign.c (large_objcode_trampolines,
large_objcode_trampolines_mutex): New static variables.
(make_objcode_trampoline, get_objcode_trampoline): New static
functions.
(cif_to_procedure): Use 'get_objcode_trampoline'.
(scm_init_foreign): Initialize 'large_objcode_trampolines'.
* test-suite/standalone/test-ffi-lib.c (test_ffi_sum_many):
New function.
* test-suite/standalone/test-ffi: Add test.
---
libguile/foreign.c | 59 ++++++++++++++++++++++++++++++----
test-suite/standalone/test-ffi | 15 +++++++++
test-suite/standalone/test-ffi-lib.c | 17 ++++++++++
3 files changed, 84 insertions(+), 7 deletions(-)
diff --git a/libguile/foreign.c b/libguile/foreign.c
index f5819c4..f8b88de 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -880,21 +880,64 @@ static const SCM objcode_trampolines[10] = {
SCM_PACK (objcode_cells.cells+18),
};
+static SCM large_objcode_trampolines;
+static scm_i_pthread_mutex_t large_objcode_trampolines_mutex =
+ SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
static SCM
-cif_to_procedure (SCM cif, SCM func_ptr)
+make_objcode_trampoline (unsigned int nargs)
{
- ffi_cif *c_cif;
- unsigned int nargs;
- SCM objcode, table, ret;
+ const int size = sizeof (struct scm_objcode) + 8
+ + sizeof (struct scm_objcode) + 32;
+ const scm_t_uint8 *bytes_0 = raw_bytecode.bytes + 0;
+ const scm_t_uint8 *bytes_1 = raw_bytecode.bytes + size;
+ SCM bytecode = scm_c_make_bytevector (size);
+ scm_t_uint8 *bytes = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bytecode);
+ int i;
+
+ for (i = 0; i < size; i++)
+ {
+ if (bytes_0[i] == bytes_1[i])
+ bytes[i] = bytes_0[i];
+ else if (bytes_0[i] == 0 && bytes_1[i] == 1)
+ bytes[i] = nargs;
+ else
+ scm_syserror ("make_objcode_trampoline");
+ }
+ return scm_bytecode_to_native_objcode (bytecode);
+}
- c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
- nargs = c_cif->nargs;
+static SCM
+get_objcode_trampoline (unsigned int nargs)
+{
+ SCM objcode;
if (nargs < 10)
objcode = objcode_trampolines[nargs];
+ else if (nargs < 256)
+ {
+ scm_i_scm_pthread_mutex_lock (&large_objcode_trampolines_mutex);
+ objcode = scm_c_vector_ref (large_objcode_trampolines, nargs);
+ if (SCM_UNBNDP (objcode))
+ scm_c_vector_set_x (large_objcode_trampolines, nargs,
+ objcode = make_objcode_trampoline (nargs));
+ scm_i_pthread_mutex_unlock (&large_objcode_trampolines_mutex);
+ }
else
- scm_misc_error ("make-foreign-function", "args >= 10 currently unimplemented",
+ scm_misc_error ("make-foreign-function", "args >= 256 currently unimplemented",
SCM_EOL);
+
+ return objcode;
+}
+
+static SCM
+cif_to_procedure (SCM cif, SCM func_ptr)
+{
+ ffi_cif *c_cif;
+ SCM objcode, table, ret;
+
+ c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
+ objcode = get_objcode_trampoline (c_cif->nargs);
table = scm_c_make_vector (2, SCM_UNDEFINED);
SCM_SIMPLE_VECTOR_SET (table, 0, scm_cons (cif, func_ptr));
@@ -1308,6 +1351,8 @@ scm_init_foreign (void)
null_pointer = scm_cell (scm_tc7_pointer, 0);
scm_define (sym_null, null_pointer);
+
+ large_objcode_trampolines = scm_c_make_vector (256, SCM_UNDEFINED);
}
void
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index ad68660..0a91f63 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -170,6 +170,21 @@ exec guile -q -s "$0" "$@"
(+ -1 2000 -30000 40000000000))
;;
+;; More than ten arguments
+;;
+(define f-sum-many
+ (pointer->procedure int64 (dynamic-func "test_ffi_sum_many" lib)
+ (list uint8 uint16 uint32 uint64
+ int8 int16 int32 int64
+ int8 int16 int32 int64)))
+(test (f-sum-many 255 65535 4294967295 1844674407370955161
+ -1 2000 -30000 40000000000
+ 5 -6000 70000 -80000000000)
+ (+ 255 65535 4294967295 1844674407370955161
+ -1 2000 -30000 40000000000
+ 5 -6000 70000 -80000000000))
+
+;;
;; Structs
;;
(define f-sum-struct
diff --git a/test-suite/standalone/test-ffi-lib.c b/test-suite/standalone/test-ffi-lib.c
index 37d6e43..f265339 100644
--- a/test-suite/standalone/test-ffi-lib.c
+++ b/test-suite/standalone/test-ffi-lib.c
@@ -194,6 +194,23 @@ scm_t_int64 test_ffi_sum (scm_t_int8 a, scm_t_int16 b,
}
+scm_t_int64 test_ffi_sum_many (scm_t_uint8 a, scm_t_uint16 b,
+ scm_t_uint32 c, scm_t_uint64 d,
+ scm_t_int8 e, scm_t_int16 f,
+ scm_t_int32 g, scm_t_int64 h,
+ scm_t_int8 i, scm_t_int16 j,
+ scm_t_int32 k, scm_t_int64 l);
+scm_t_int64 test_ffi_sum_many (scm_t_uint8 a, scm_t_uint16 b,
+ scm_t_uint32 c, scm_t_uint64 d,
+ scm_t_int8 e, scm_t_int16 f,
+ scm_t_int32 g, scm_t_int64 h,
+ scm_t_int8 i, scm_t_int16 j,
+ scm_t_int32 k, scm_t_int64 l)
+{
+ return l + k + j + i + h + g + f + e + d + c + b + a;
+}
+
+
struct foo
{
scm_t_int8 a;
--
1.7.10.4
next prev parent reply other threads:[~2013-02-26 22:40 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-02-25 0:34 bug#13809: Wishlist: support > 10 args to foreign functions Mark H Weaver
2013-02-25 9:01 ` Andy Wingo
2013-02-26 22:40 ` Mark H Weaver [this message]
[not found] ` <878v6azol2.fsf_-_@tines.lan>
2013-02-27 9:25 ` bug#13809: [PATCH] Support calling foreign functions of 10 or more arguments Andy Wingo
[not found] ` <87fw0ixg4p.fsf@pobox.com>
2013-02-27 22:11 ` Mark H Weaver
[not found] ` <87ppzlxv95.fsf@tines.lan>
2013-02-28 8:40 ` Andy Wingo
2013-02-28 11:40 ` Mark H Weaver
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='878v6azol2.fsf_-___47199.6740358465$1361918513$gmane$org@tines.lan' \
--to=mhw@netris.org \
--cc=13809@debbugs.gnu.org \
--cc=guile-devel@gnu.org \
--cc=wingo@pobox.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).