From: Kevin M. Rosenberg Date: Fri, 22 Mar 2002 20:51:08 +0000 (+0000) Subject: r1617: *** empty log message *** X-Git-Tag: v1.6.1~551 X-Git-Url: http://git.kpe.io/?p=uffi.git;a=commitdiff_plain;h=379a7c3e7b8249ace498d8733c87a3f575a7c799 r1617: *** empty log message *** --- diff --git a/ChangeLog b/ChangeLog index 300f25e..c2fe731 100644 --- a/ChangeLog +++ b/ChangeLog @@ -13,10 +13,11 @@ See TODO file -- actively maintained. Includes changes that you * Added double-float vector example to c-test-fns * Reworked cstring on Lispworks to have LW handle string conversion * First pass at with-foreign-object -- unoptimized - * Added gethostname2 to examples/gethostname.cl which uses with-foreign-object - * Added char-array-to-pointer function to encapsulate converting a char array - to a pointer to char + * Added gethostname2 example which uses with-foreign-object + * Added char-array-to-pointer function to encapsulate + converting a char array to a char pointer * Converted with-foreign-object to use stack allocation on CMUCL and LW + * Added benchmark code, first file is for allocation 20 Mar 2002 * Updated strings.cl so that foreign-strings are always unsigned. diff --git a/examples/gethostname.cl b/examples/gethostname.cl index 0062e40..fcec16e 100644 --- a/examples/gethostname.cl +++ b/examples/gethostname.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: gethostname.cl,v 1.7 2002/03/21 15:57:01 kevin Exp $ +;;;; $Id: gethostname.cl,v 1.8 2002/03/22 20:51:08 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -44,5 +44,6 @@ (error "gethostname() failed.")))) #+test-uffi -(format t "~&Hostname: ~A" (gethostname)) +(format t "~&Hostname (technique 1): ~A" (gethostname)) +(format t "~&Hostname (technique 2): ~A" (gethostname2)) diff --git a/src/objects.cl b/src/objects.cl index 6a33f9b..b510b35 100644 --- a/src/objects.cl +++ b/src/objects.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: objects.cl,v 1.13 2002/03/21 16:47:46 kevin Exp $ +;;;; $Id: objects.cl,v 1.14 2002/03/22 20:51:08 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -107,20 +107,20 @@ an array of TYPE with size SIZE." obj ) -;; Simple first pass. Will later create optimized routines for -;; various platforms. (defmacro with-foreign-object ((var type) &rest body) - #+allegro + #-(or cmu lispworks) ; default version `(let ((,var (allocate-foreign-object ,type))) (unwind-protect (progn ,@body) (free-foreign-object ,var))) #+cmu - `(alien:with-alien ((,var ,(convert-from-uffi-type type :allocate))) - (setq ,var (alien:addr ,var)) - ,@body) + (let ((obj (gensym))) + `(alien:with-alien ((,obj ,(convert-from-uffi-type type :allocate))) + (let ((,var (alien:addr ,obj))) + ,@body))) #+lispworks - `(fli:with-dynamic-foreign-objects ((,var ,(convert-from-uffi-type type :allocate))) + `(fli:with-dynamic-foreign-objects ((,var ,(convert-from-uffi-type + type :allocate))) ,@body) ) diff --git a/src/strings.cl b/src/strings.cl index ba4dfa2..75496e0 100644 --- a/src/strings.cl +++ b/src/strings.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: strings.cl,v 1.11 2002/03/21 11:38:07 kevin Exp $ +;;;; $Id: strings.cl,v 1.12 2002/03/22 20:51:08 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -150,6 +150,7 @@ that LW/CMU automatically converts strings from c-calls." ) (defmacro with-foreign-string ((foreign-string lisp-string) &body body) + #-(or lispworks cmu) (let ((result (gensym))) `(let* ((,foreign-string (convert-to-foreign-string ,lisp-string)) (,result (progn ,@body))) diff --git a/tests/gethostname.cl b/tests/gethostname.cl index 0062e40..fcec16e 100644 --- a/tests/gethostname.cl +++ b/tests/gethostname.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: gethostname.cl,v 1.7 2002/03/21 15:57:01 kevin Exp $ +;;;; $Id: gethostname.cl,v 1.8 2002/03/22 20:51:08 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -44,5 +44,6 @@ (error "gethostname() failed.")))) #+test-uffi -(format t "~&Hostname: ~A" (gethostname)) +(format t "~&Hostname (technique 1): ~A" (gethostname)) +(format t "~&Hostname (technique 2): ~A" (gethostname2))