From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Thu, 21 Mar 2002 09:54:34 +0000 (+0000)
Subject: r1604: *** empty log message ***
X-Git-Tag: v1.6.1~562
X-Git-Url: http://git.kpe.io/?a=commitdiff_plain;h=c55832db4eb5a0535762f291674b3b26d288ad17;hp=1796f8c038481234982c983cb0ee611c3ffac4c6;p=uffi.git

r1604: *** empty log message ***
---

diff --git a/ChangeLog b/ChangeLog
index e69da6a..ec60019 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -10,6 +10,7 @@ See TODO file -- actively maintained. Includes changes that you
 	* Added 2-d array example to examples/arrays.cl	
 	* Fixed documentation error on gethostname
 	* Added ensure-char-* and def-union to documentation
+	* Added double-float vector example to c-test-fns
 	
 20 Mar 2002
 	* Updated strings.cl so that foreign-strings are always unsigned.
diff --git a/doc/ref.sgml b/doc/ref.sgml
index 714d8e9..58ac773 100644
--- a/doc/ref.sgml
+++ b/doc/ref.sgml
@@ -1101,7 +1101,7 @@ array of <parameter>type</parameter> that is <parameter>size</parameter> members
     <refentry id="ensure-char-character">
       <refnamediv>
 	<refname>ensure-char-character</refname>
-	<refpurpose>Ensures that a dereferenced :char pointer is
+	<refpurpose>Ensures that a dereferenced <constant>:char</constant> pointer is
 a character.
 	</refpurpose>
 	<refclass>Macro</refclass>
@@ -1169,7 +1169,7 @@ integer.</para>
     <refentry id="ensure-char-integer">
       <refnamediv>
 	<refname>ensure-char-integer</refname>
-	<refpurpose>Ensures that a dereferenced :char pointer is
+	<refpurpose>Ensures that a dereferenced <constant>:char</constant> pointer is
 an integer.
 	</refpurpose>
 	<refclass>Macro</refclass>
diff --git a/examples/c-test-fns.c b/examples/c-test-fns.c
index 7358114..cab2dd6 100644
--- a/examples/c-test-fns.c
+++ b/examples/c-test-fns.c
@@ -6,7 +6,7 @@
  *  Programer:    Kevin M. Rosenberg
  *  Date Started: Mar 2002
  *
- *  CVS Id:   $Id: c-test-fns.c,v 1.3 2002/03/21 05:29:57 kevin Exp $
+ *  CVS Id:   $Id: c-test-fns.c,v 1.4 2002/03/21 09:54:34 kevin Exp $
  *
  * This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
  *
@@ -36,6 +36,8 @@ BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll,
 
 #include <ctype.h>
 #include <stdlib.h>
+#include <math.h>
+
 
 /* Test of constant input string */
 DLLEXPORT
@@ -79,5 +81,16 @@ cs_make_random (int size, char* buffer)
 }
 
     
+/* Test of input/output vector */
+DLLEXPORT
+void
+half_double_vector (int size, double* vec)
+{
+  int i;
+  for (i = 0; i < size; i++)
+    vec[i] /= 2.;
+}
+
+    
 
     
diff --git a/examples/c-test-fns.cl b/examples/c-test-fns.cl
index 3bb4f61..45f144d 100644
--- a/examples/c-test-fns.cl
+++ b/examples/c-test-fns.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: c-test-fns.cl,v 1.1 2002/03/21 04:04:45 kevin Exp $
+;;;; $Id: c-test-fns.cl,v 1.2 2002/03/21 09:54:34 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -45,6 +45,40 @@
   (uffi:with-cstring (str-cstring str)
     (cs-count-upper str-cstring)))
 
+(uffi:def-function ("half_double_vector" half-double-vector)
+    ((size :int)
+     (vec (* :double)))
+  :returning :void)
+
+(uffi:def-constant +double-vec-length+ 10)
+(defun test-half-double-vector ()
+  (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+))
+	results)
+    (dotimes (i +double-vec-length+)
+      (setf (uffi:deref-array vec '(:array :double) i) 
+	    (coerce i 'double-float)))
+    (half-double-vector +double-vec-length+ vec)
+    (dotimes (i +double-vec-length+)
+      (push (uffi:deref-array vec '(:array :double) i) results))
+    (uffi:free-foreign-object vec)
+    (nreverse results)))
+
+(defun t2 ()
+  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+    (dotimes (i +double-vec-length+)
+      (setf (aref vec i) (coerce i 'double-float)))
+    (half-double-vector +double-vec-length+ vec)
+    vec))
+
+#+cmu
+(defun t3 ()
+  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+    (dotimes (i +double-vec-length+)
+      (setf (aref vec i) (coerce i 'double-float)))
+    (system:without-gcing
+     (half-double-vector +double-vec-length+ (system:vector-sap vec)))
+    vec))
+    
 #+test-uffi
 (format t "~&(string-to-upper \"this is a test\") => ~A" 
 	(string-to-upper "this is a test"))
@@ -61,6 +95,6 @@
 (format t "~&(string-count-upper nil) => ~A" 
 	(string-count-upper nil))
 
-
-
+#+test-uffi
+(format t "~&Half vector: ~S" (test-half-double-vector))
 
diff --git a/tests/c-test-fns.c b/tests/c-test-fns.c
index 7358114..cab2dd6 100644
--- a/tests/c-test-fns.c
+++ b/tests/c-test-fns.c
@@ -6,7 +6,7 @@
  *  Programer:    Kevin M. Rosenberg
  *  Date Started: Mar 2002
  *
- *  CVS Id:   $Id: c-test-fns.c,v 1.3 2002/03/21 05:29:57 kevin Exp $
+ *  CVS Id:   $Id: c-test-fns.c,v 1.4 2002/03/21 09:54:34 kevin Exp $
  *
  * This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
  *
@@ -36,6 +36,8 @@ BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll,
 
 #include <ctype.h>
 #include <stdlib.h>
+#include <math.h>
+
 
 /* Test of constant input string */
 DLLEXPORT
@@ -79,5 +81,16 @@ cs_make_random (int size, char* buffer)
 }
 
     
+/* Test of input/output vector */
+DLLEXPORT
+void
+half_double_vector (int size, double* vec)
+{
+  int i;
+  for (i = 0; i < size; i++)
+    vec[i] /= 2.;
+}
+
+    
 
     
diff --git a/tests/c-test-fns.cl b/tests/c-test-fns.cl
index 3bb4f61..45f144d 100644
--- a/tests/c-test-fns.cl
+++ b/tests/c-test-fns.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: c-test-fns.cl,v 1.1 2002/03/21 04:04:45 kevin Exp $
+;;;; $Id: c-test-fns.cl,v 1.2 2002/03/21 09:54:34 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -45,6 +45,40 @@
   (uffi:with-cstring (str-cstring str)
     (cs-count-upper str-cstring)))
 
+(uffi:def-function ("half_double_vector" half-double-vector)
+    ((size :int)
+     (vec (* :double)))
+  :returning :void)
+
+(uffi:def-constant +double-vec-length+ 10)
+(defun test-half-double-vector ()
+  (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+))
+	results)
+    (dotimes (i +double-vec-length+)
+      (setf (uffi:deref-array vec '(:array :double) i) 
+	    (coerce i 'double-float)))
+    (half-double-vector +double-vec-length+ vec)
+    (dotimes (i +double-vec-length+)
+      (push (uffi:deref-array vec '(:array :double) i) results))
+    (uffi:free-foreign-object vec)
+    (nreverse results)))
+
+(defun t2 ()
+  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+    (dotimes (i +double-vec-length+)
+      (setf (aref vec i) (coerce i 'double-float)))
+    (half-double-vector +double-vec-length+ vec)
+    vec))
+
+#+cmu
+(defun t3 ()
+  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+    (dotimes (i +double-vec-length+)
+      (setf (aref vec i) (coerce i 'double-float)))
+    (system:without-gcing
+     (half-double-vector +double-vec-length+ (system:vector-sap vec)))
+    vec))
+    
 #+test-uffi
 (format t "~&(string-to-upper \"this is a test\") => ~A" 
 	(string-to-upper "this is a test"))
@@ -61,6 +95,6 @@
 (format t "~&(string-count-upper nil) => ~A" 
 	(string-count-upper nil))
 
-
-
+#+test-uffi
+(format t "~&Half vector: ~S" (test-half-double-vector))