From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.bugs Subject: bug#13809: [PATCH] Support calling foreign functions of 10 or more arguments Date: Tue, 26 Feb 2013 17:40:09 -0500 Message-ID: <878v6azol2.fsf_-___47199.6740358465$1361918513$gmane$org@tines.lan> References: <87621h6xkl.fsf@tines.lan> <87a9qs937u.fsf@pobox.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1361918489 8192 80.91.229.3 (26 Feb 2013 22:41:29 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 26 Feb 2013 22:41:29 +0000 (UTC) Cc: 13809@debbugs.gnu.org, guile-devel@gnu.org To: Andy Wingo Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Tue Feb 26 23:41:52 2013 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UATDb-0001oq-1O for guile-bugs@m.gmane.org; Tue, 26 Feb 2013 23:41:51 +0100 Original-Received: from localhost ([::1]:60007 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UATDG-0000Vr-96 for guile-bugs@m.gmane.org; Tue, 26 Feb 2013 17:41:30 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:56563) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UATD8-0000VT-UT for bug-guile@gnu.org; Tue, 26 Feb 2013 17:41:28 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UATD1-0001Ml-UV for bug-guile@gnu.org; Tue, 26 Feb 2013 17:41:22 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:46322) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UATD1-0001Mg-QJ for bug-guile@gnu.org; Tue, 26 Feb 2013 17:41:15 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1UATEk-0008OR-FY for bug-guile@gnu.org; Tue, 26 Feb 2013 17:43:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Mark H Weaver Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-guile@gnu.org Resent-Date: Tue, 26 Feb 2013 22:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 13809 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 13809-submit@debbugs.gnu.org id=B13809.136191854032208 (code B ref 13809); Tue, 26 Feb 2013 22:43:02 +0000 Original-Received: (at 13809) by debbugs.gnu.org; 26 Feb 2013 22:42:20 +0000 Original-Received: from localhost ([127.0.0.1]:51785 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1UATE3-0008NO-0m for submit@debbugs.gnu.org; Tue, 26 Feb 2013 17:42:20 -0500 Original-Received: from world.peace.net ([96.39.62.75]:59809) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1UATDy-0008NE-PI for 13809@debbugs.gnu.org; Tue, 26 Feb 2013 17:42:16 -0500 Original-Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=tines.lan) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1UATC6-0004E5-16; Tue, 26 Feb 2013 17:40:18 -0500 In-Reply-To: <87a9qs937u.fsf@pobox.com> (Andy Wingo's message of "Mon, 25 Feb 2013 10:01:41 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.2 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 140.186.70.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:6795 Archived-At: --=-=-= Content-Type: text/plain Hi Andy, Andy Wingo writes: > On Mon 25 Feb 2013 01:34, Mark H Weaver 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Support-calling-foreign-functions-of-10-or-more-argu.patch Content-Description: [PATCH] Support calling foreign functions of 10 or more arguments >From 29aaa7add08849503bde5a9be43b162e492a4297 Mon Sep 17 00:00:00 2001 From: Mark H Weaver 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 --=-=-=--