See TODO file -- actively maintained. Includes changes that you
might expect in the interface.
+
+21 Mar 2002
+ * Fixed problem with NULL foreign-strings with CMUCL
+ * Added c-test-fns to examples for allow more specific testing
+ of UFFI. Builds on UNIX and Win32 platforms.
+ * Added def-union function, added union.cl example
+ * Fixed error with ensure-char-[character|integer]
20 Mar 2002
* Updated strings.cl so that foreign-strings are always unsigned.
# Programer: Kevin M. Rosenberg, M.D.
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile,v 1.25 2002/03/19 16:42:58 kevin Exp $
+# CVS Id: $Id: Makefile,v 1.26 2002/03/21 07:56:45 kevin Exp $
#
# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
#
docs:
@(cd doc; make dist-doc)
-VERSION=0.2.10
+VERSION=0.2.11
DISTDIR=uffi-${VERSION}
DIST_TARBALL=${DISTDIR}.tar.gz
DIST_ZIP=${DISTDIR}.zip
- Cleanup the meaning of (def-array). Add size parameter
-- 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. I lean
-to having unsigned be the default type.
-
-- Add def-union routine
-
- Split implementation-dependent code into separate files in preparation
for MCL and CormanLisp ports.
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: array-2d.cl
-;;;; Purpose: UFFI Example file use 2-dimensional arrays
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Mar 2002
-;;;;
-;;;; $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
-;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(in-package :cl-user)
-
-(uffi:def-constant +column-length+ 10)
-
-(defun test-array-2d ()
- "Tests 2d array"
- (let ((a (uffi:allocate-foreign-object :long +column-length+)))
- (dotimes (i +column-length+)
- (setf (uffi:deref-array a '(:array :long) i) (* i i)))
- (dotimes (i +column-length+)
- (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
- (uffi:free-foreign-object a))
- (values))
-
-#+test-uffi
-(test-array-2d)
-
-
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: arrays.cl
+;;;; Purpose: UFFI Example file to test arrays
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: arrays.cl,v 1.1 2002/03/21 07:56:45 kevin Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-constant +column-length+ 10)
+(uffi:def-constant +row-length+ 10)
+
+(defun test-array-1d ()
+ "Tests vector"
+ (let ((a (uffi:allocate-foreign-object :long +column-length+)))
+ (dotimes (i +column-length+)
+ (setf (uffi:deref-array a '(:array :long) i) (* i i)))
+ (dotimes (i +column-length+)
+ (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
+ (uffi:free-foreign-object a))
+ (values))
+
+(defun test-array-2d ()
+ "Tests 2d array"
+ (let ((a (uffi:allocate-foreign-object (* :long) +row-length+)))
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (setf (uffi:deref-array a '(:array (* :long)) r)
+ (uffi:allocate-foreign-object :long +column-length+))
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (setf (uffi:deref-array col '(:array :long) c) (+ (* r +column-length+) c)))))
+
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (format t "~&Row ~D: " r)
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (let ((result (uffi:deref-array col '(:array :long) c)))
+ (format t "~d " result)))))
+
+ (uffi:free-foreign-object a))
+ (values))
+
+#+test-uffi
+(test-array-1d)
+
+#+test-uffi
+(test-array-2d)
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: union.cl
+;;;; Purpose: UFFI Example file to test unions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: union.cl,v 1.1 2002/03/21 07:56:45 kevin Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-union tunion1
+ (char :char)
+ (int :int)
+ (uint :unsigned-int)
+ (sf :float)
+ (df :double))
+
+(defun test-union-1 ()
+ (let ((u (uffi:allocate-foreign-object tunion1)))
+ (setf (uffi:get-slot-value u 'tunion1 'int)
+ (+ (char-code #\A)
+ (* 256 (char-code #\B))
+ (* 65536 (char-code #\C))
+ (* 16777216 255)))
+ (format t "~&Should be #\A: ~S"
+ (uffi:ensure-char-character
+ (uffi:get-slot-value u 'tunion1 'char)))
+ (format t "~&Should be negative number: ~D"
+ (uffi:get-slot-value u 'tunion1 'int))
+ (format t "~&Should be positive number: ~D"
+ (uffi:get-slot-value u 'tunion1 'uint))
+ (uffi:free-foreign-object u))
+ (values))
+
+#+uffi-test
+(test-union-1)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: aggregates.cl,v 1.6 2002/03/17 17:33:30 kevin Exp $
+;;;; $Id: aggregates.cl,v 1.7 2002/03/21 07:56:45 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(* ,(convert-from-uffi-type type :array)))
)
-(defun process-struct-args (name args)
+(defun process-struct-fields (name fields)
(let (processed)
- (dolist (arg args)
- (let ((field-name (car arg))
- (type (cadr arg)))
+ (dolist (field fields)
+ (let ((field-name (car field))
+ (type (cadr field)))
(push (append (list field-name)
(if (eq type :pointer-self)
#+cmu `((* (alien:struct ,name)))
(nreverse processed)))
-(defmacro def-struct (name &rest args)
+(defmacro def-struct (name &rest fields)
#+cmu
- `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-args name args)))
+ `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-fields name fields)))
#+allegro
- `(ff:def-foreign-type ,name (:struct ,@(process-struct-args name args)))
+ `(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields)))
#+lispworks
- `(fli:define-c-struct ,name ,@(process-struct-args name args))
+ `(fli:define-c-struct ,name ,@(process-struct-fields name fields))
)
#+allegro `(ff:fslot-value-typed ,type :c ,obj ,i)
)
-
-
+(defmacro def-union (name &rest fields)
+ #+allegro
+ `(ff:def-foreign-type ,name (:union ,@(process-struct-fields name fields)))
+ #+lispworks
+ `(fli:define-c-union ,name ,@(process-struct-fields name fields))
+ #+cmu
+ `(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields)))
+)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: objects.cl,v 1.9 2002/03/19 16:42:59 kevin Exp $
+;;;; $Id: objects.cl,v 1.10 2002/03/21 07:56:45 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
#+lispworks ;; with LW, deref is a character
(defmacro ensure-char-character (obj)
- "Ensures that the dereference of a :char is a character"
+ obj
)
#+(or allegro cmu)
(defmacro ensure-char-character (obj)
- "Ensures that the dereference of a :char is a character"
`(code-char ,obj)
)
#+lispworks
(defmacro ensure-char-integer (obj)
- "Ensures that the dereference of a :char is a character"
`(char-code ,obj))
#+(or allegro cmu)
(defmacro ensure-char-integer (obj)
+ obj
) ;; (* :char) dereference is already an integer
(defmacro pointer-address (obj)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: test-examples.cl,v 1.6 2002/03/21 04:05:15 kevin Exp $
+;;;; $Id: test-examples.cl,v 1.7 2002/03/21 07:56:45 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
*load-truename*))))
(load-test "c-test-fns")
- (load-test "array-2d")
+ (load-test "arrays")
+ (load-test "union")
(load-test "strtol")
(load-test "gettime")
(load-test "getenv")
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: array-2d.cl
-;;;; Purpose: UFFI Example file use 2-dimensional arrays
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Mar 2002
-;;;;
-;;;; $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
-;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(in-package :cl-user)
-
-(uffi:def-constant +column-length+ 10)
-
-(defun test-array-2d ()
- "Tests 2d array"
- (let ((a (uffi:allocate-foreign-object :long +column-length+)))
- (dotimes (i +column-length+)
- (setf (uffi:deref-array a '(:array :long) i) (* i i)))
- (dotimes (i +column-length+)
- (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
- (uffi:free-foreign-object a))
- (values))
-
-#+test-uffi
-(test-array-2d)
-
-
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: arrays.cl
+;;;; Purpose: UFFI Example file to test arrays
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: arrays.cl,v 1.1 2002/03/21 07:56:45 kevin Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-constant +column-length+ 10)
+(uffi:def-constant +row-length+ 10)
+
+(defun test-array-1d ()
+ "Tests vector"
+ (let ((a (uffi:allocate-foreign-object :long +column-length+)))
+ (dotimes (i +column-length+)
+ (setf (uffi:deref-array a '(:array :long) i) (* i i)))
+ (dotimes (i +column-length+)
+ (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
+ (uffi:free-foreign-object a))
+ (values))
+
+(defun test-array-2d ()
+ "Tests 2d array"
+ (let ((a (uffi:allocate-foreign-object (* :long) +row-length+)))
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (setf (uffi:deref-array a '(:array (* :long)) r)
+ (uffi:allocate-foreign-object :long +column-length+))
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (setf (uffi:deref-array col '(:array :long) c) (+ (* r +column-length+) c)))))
+
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (format t "~&Row ~D: " r)
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (let ((result (uffi:deref-array col '(:array :long) c)))
+ (format t "~d " result)))))
+
+ (uffi:free-foreign-object a))
+ (values))
+
+#+test-uffi
+(test-array-1d)
+
+#+test-uffi
+(test-array-2d)
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: union.cl
+;;;; Purpose: UFFI Example file to test unions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: union.cl,v 1.1 2002/03/21 07:56:45 kevin Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-union tunion1
+ (char :char)
+ (int :int)
+ (uint :unsigned-int)
+ (sf :float)
+ (df :double))
+
+(defun test-union-1 ()
+ (let ((u (uffi:allocate-foreign-object tunion1)))
+ (setf (uffi:get-slot-value u 'tunion1 'int)
+ (+ (char-code #\A)
+ (* 256 (char-code #\B))
+ (* 65536 (char-code #\C))
+ (* 16777216 255)))
+ (format t "~&Should be #\A: ~S"
+ (uffi:ensure-char-character
+ (uffi:get-slot-value u 'tunion1 'char)))
+ (format t "~&Should be negative number: ~D"
+ (uffi:get-slot-value u 'tunion1 'int))
+ (format t "~&Should be positive number: ~D"
+ (uffi:get-slot-value u 'tunion1 'uint))
+ (uffi:free-foreign-object u))
+ (values))
+
+#+uffi-test
+(test-union-1)
projects / uffi.git / commitdiff