r1588: Added array allocation to allocate-foreign-objects

diff --git a/ChangeLog b/ChangeLog
index cc08f36686601ec08b7e5da24b15bcd4ff35eaaf..0a5a2576cfd457988eee5b5c33be47e63769bde9 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,21 @@
+SCHEDULED CHANGES
+       * Change dereferencing of pointers to :char and :unsigned-char types.
+       May need to have ensure-char as routine to correctly handle setf
+       expansions. CMUCL strtol is broken because of signedness.
+       Right now, LW prefers unsigned and CMUCL prefers signed 
+       string arrays.
+       * Need to clean signedness of allocate-foreign-string
+       
+19 Mar 2002
+       * Added size parameter to allocate-foreign-object. Creates an array
+       of dimensions size.
+       * Got array-2d example working with a 1-d array.
+       * Cleaned strtol example
+       
+18 Mar 2002
+       * Documentation fixes (Erik Winkels)
+       * Fixed missing '.' in CMUCL type declarations (Erik Winkels)
+       
 17 Mar 2002
        * Changed deref-pointer so it always returns a character when
        called with a :char or :unsigned-char type

diff --git a/Makefile b/Makefile
index cdfd876e2c9caeac5955c9ce84cf314cacdb3ad7..4a836ba0e6a0e6779a748acc7ecb08c23b6790e1 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -5,7 +5,7 @@
 #  Programer:    Kevin M. Rosenberg, M.D.
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.22 2002/03/18 17:57:39 kevin Exp $
+#  CVS Id:   $Id: Makefile,v 1.23 2002/03/18 22:47:57 kevin Exp $
 #
 # This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 #
@@ -31,7 +31,7 @@ realclean: clean
 docs:
        @(cd doc; make dist-doc)
 
-VERSION=0.2.9-pre2
+VERSION=0.2.9
 DISTDIR=uffi-${VERSION}
 DIST_TARBALL=${DISTDIR}.tar.gz
 DIST_ZIP=${DISTDIR}.zip

diff --git a/examples/array-2d.cl b/examples/array-2d.cl
index 9e344db55f2882182e20e89d0aea01b9a6c2cdd0..5a9522098a9cba540ede849e73214dd7dff81d5e 100644 (file)
--- a/examples/array-2d.cl
+++ b/examples/array-2d.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: array-2d.cl,v 1.1 2002/03/18 02:27:32 kevin Exp $
+;;;; $Id: array-2d.cl,v 1.2 2002/03/18 22:47:57 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -20,16 +20,15 @@
 
 (uffi:def-constant +column-length+ 10)
 
-(uffi:def-array long-array (:long 10))
-
 (defun test-array-2d ()
   "Tests 2d array"
-  (let ((a (uffi:allocate-foreign-object long-array)))
+  (let ((a (uffi:allocate-foreign-object :long +column-length+)))
     (dotimes (i +column-length+)
-      (setf (uffi:deref-array a :long i) (* i i)))
+      (setf (uffi:deref-array a '(:array :long) i) (* i i)))
     (dotimes (i +column-length+)
-      (format "~&~D => ~D" i (uffi:deref-array a 'long-array i)))
-    (uffi:free-foreign-object a)))
+      (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
+    (uffi:free-foreign-object a))
+  (values))
 
 #+test-uffi
 (test-array-2d)

diff --git a/examples/strtol.cl b/examples/strtol.cl
index 63aea44fb8546fa1a627f193fb44f78e62c78f37..8beeddf4c67819308787d9fcd329fe64621a5469 100644 (file)
--- a/examples/strtol.cl
+++ b/examples/strtol.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.cl,v 1.9 2002/03/17 17:33:30 kevin Exp $
+;;;; $Id: strtol.cl,v 1.10 2002/03/18 22:47:57 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -38,8 +38,7 @@ of first non-valid character"
   (let* ((str-native (uffi:convert-to-foreign-string str))
         (endptr (uffi:allocate-foreign-object char-ptr))
         (value (c-strtol str-native endptr base))
-        (endptr-value (uffi:deref-pointer endptr 'char-ptr))
-        next-char-value chars-parsed)
+        (endptr-value (uffi:deref-pointer endptr 'char-ptr)))
 
     (unwind-protect
         (if (uffi:null-pointer-p endptr-value)

diff --git a/src/objects.cl b/src/objects.cl
index 01884302c2679606db6e7af3a7592f0ef8459cce..f9651d468c53603e763012d736c524360e5838ad 100644 (file)
--- 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.7 2002/03/18 02:27:28 kevin Exp $
+;;;; $Id: objects.cl,v 1.8 2002/03/18 22:47:57 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -19,14 +19,26 @@
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
 (in-package :uffi)
 
-(defmacro allocate-foreign-object (type)
-  #+cmu
-  `(alien:make-alien ,(convert-from-uffi-type type :allocation))
-  #+lispworks
-  `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
-  #+allegro
-  `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
-  )
+(defmacro allocate-foreign-object (type &optional (size :unspecified))
+  "Allocates an instance of TYPE. If size is specified, then allocate
+an array of TYPE with size SIZE."
+  (if (eq size :unspecified)
+      (progn
+       #+cmu
+       `(alien:make-alien ,(convert-from-uffi-type type :allocation))
+       #+lispworks
+       `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
+       #+allegro
+       `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c))
+      (progn
+       #+cmu
+       `(alien:make-alien ,(convert-from-uffi-type type :allocation) ,size)
+       #+lispworks
+       `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
+       #+allegro
+       `(ff:allocate-fobject '(:array ,(convert-from-uffi-type type :allocate) ,(eval size)) :c)
+      )
+  ))
 
 (defmacro free-foreign-object (obj)
   #+cmu
@@ -54,18 +66,10 @@
 
 (defmacro deref-pointer (ptr type)
   "Returns a object pointed"
-  (let ((result (gensym)))
-    `(let ((,result
-           #+cmu  (alien:deref ,ptr)
-           #+lispworks (fli:dereference ,ptr)
-           #+allegro (ff:fslot-value-typed ,type :c ,ptr)
-           ))
-      (if (and
-          (or (eq ,type :char)
-              (eq ,type :unsigned-char))
-          (numberp ,result))
-         (code-char ,result)
-         ,result))))
+  #+cmu  `(alien:deref ,ptr)
+  #+lispworks `(fli:dereference ,ptr)
+  #+allegro `(ff:fslot-value-typed ,type :c ,ptr)
+)
 
 (defmacro pointer-address (obj)
   #+cmu
@@ -76,6 +80,7 @@
   obj
   )
 
+#|
 (defmacro allocate-byte-array (nsize)
   #+cmu
   `(alien:make-alien (alien:unsigned 8) ,nsize)
@@ -90,8 +95,4 @@
   #+lispworks `(fli:dereference ,array :index ,position)
   #+allegro `(ff:fslot-value-typed '(:array :byte) :c ,array ,position)
 )
-
-
-
-
-)
+|#

diff --git a/src/primitives.cl b/src/primitives.cl
index 40bc449888746c2d18ec384915f251c302c5b79c..c113bdfd6156d12aa3520226d2abf60a782a8266 100644 (file)
--- a/src/primitives.cl
+++ b/src/primitives.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: primitives.cl,v 1.9 2002/03/18 02:27:28 kevin Exp $
+;;;; $Id: primitives.cl,v 1.10 2002/03/18 22:47:57 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -37,11 +37,8 @@ supports takes advantage of this optimization."
   )
 
 (defmacro null-char-p (val)
-  `(if (or (eql ,val 0)
-          (eq ,val #\Null))
-      t
-    nil))
-
+  "Returns T if character is NULL"
+  `(zerop ,val))
       
 (defmacro def-foreign-type (name type)
   #+lispworks `(fli:define-c-typedef ,name ,(convert-from-uffi-type type :type))

diff --git a/src/strings.cl b/src/strings.cl
index 95fdadf3289e1f0d3e3b83433d34a842d663c4d8..a32edde37bac370c3915c467bcca5751c9107398 100644 (file)
--- 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.6 2002/03/17 17:33:30 kevin Exp $
+;;;; $Id: strings.cl,v 1.7 2002/03/18 22:47:57 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -118,7 +118,9 @@ that CMU automatically converts strings from c-calls."
   )
 
 
-(defmacro allocate-foreign-string (size &key (unsigned t))
+(defmacro allocate-foreign-string (size &key (unsigned 
+                                             #+cmu nil
+                                             #+lispworks t))
   #+cmu
   (let ((array-def (gensym)))
     `(let ((,array-def (list 'alien:array 'c-call:char ,size)))

diff --git a/tests/array-2d.cl b/tests/array-2d.cl
index 9e344db55f2882182e20e89d0aea01b9a6c2cdd0..5a9522098a9cba540ede849e73214dd7dff81d5e 100644 (file)
--- a/tests/array-2d.cl
+++ b/tests/array-2d.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: array-2d.cl,v 1.1 2002/03/18 02:27:32 kevin Exp $
+;;;; $Id: array-2d.cl,v 1.2 2002/03/18 22:47:57 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -20,16 +20,15 @@
 
 (uffi:def-constant +column-length+ 10)
 
-(uffi:def-array long-array (:long 10))
-
 (defun test-array-2d ()
   "Tests 2d array"
-  (let ((a (uffi:allocate-foreign-object long-array)))
+  (let ((a (uffi:allocate-foreign-object :long +column-length+)))
     (dotimes (i +column-length+)
-      (setf (uffi:deref-array a :long i) (* i i)))
+      (setf (uffi:deref-array a '(:array :long) i) (* i i)))
     (dotimes (i +column-length+)
-      (format "~&~D => ~D" i (uffi:deref-array a 'long-array i)))
-    (uffi:free-foreign-object a)))
+      (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
+    (uffi:free-foreign-object a))
+  (values))
 
 #+test-uffi
 (test-array-2d)

diff --git a/tests/strtol.cl b/tests/strtol.cl
index 63aea44fb8546fa1a627f193fb44f78e62c78f37..8beeddf4c67819308787d9fcd329fe64621a5469 100644 (file)
--- a/tests/strtol.cl
+++ b/tests/strtol.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.cl,v 1.9 2002/03/17 17:33:30 kevin Exp $
+;;;; $Id: strtol.cl,v 1.10 2002/03/18 22:47:57 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -38,8 +38,7 @@ of first non-valid character"
   (let* ((str-native (uffi:convert-to-foreign-string str))
         (endptr (uffi:allocate-foreign-object char-ptr))
         (value (c-strtol str-native endptr base))
-        (endptr-value (uffi:deref-pointer endptr 'char-ptr))
-        next-char-value chars-parsed)
+        (endptr-value (uffi:deref-pointer endptr 'char-ptr)))
 
     (unwind-protect
         (if (uffi:null-pointer-p endptr-value)