+11 Mar 2002
+
+ * Changed def-type to def-foreign-type
+
+ * Created new macro def-type to generate cl:deftype forms. Removed
+ uffi-declare and uffi-slot-type as they are no longer necessary.
+
10 Mar 2002
* Modified input parameters to load-foreign-library
# Programer: Kevin M. Rosenberg, M.D.
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile,v 1.10 2002/03/10 21:48:50 kevin Exp $
+# CVS Id: $Id: Makefile,v 1.11 2002/03/11 18:00:57 kevin Exp $
#
# Copyright (c) 2002 by Kevin M. Rosenberg
#
docs:
@(cd doc; make dist-doc)
-VERSION=0.2.2
+VERSION=0.2.3
DISTDIR=uffi-${VERSION}
DIST_TARBALL=${DISTDIR}.tar.gz
DIST_ZIP=${DISTDIR}.zip
SOURCE_FILES=src doc examples Makefile COPYING COPYRIGHT README \
- INSTALL uffi.lsm ChangeLog NEWS test-examples.cl
+ INSTALL uffi.lsm ChangeLog NEWS test-examples.cl set-logical.cl
dist: realclean docs
@rm -fr ${DISTDIR} ${DIST_TARBALL} ${DIST_ZIP}
Here is an example that should both methods being used for
maximum cross-implementation optimization:
<programlisting>
+(uffi:def-type the-struct-type-def the-struct-type)
(let ((a-foreign-struct (allocate-foreign-object 'the-struct-type)))
- (uffi-declare 'the-struct-type a-foreign-struct)
+ (declare 'the-struct-type-def a-foreign-struct)
(get-slot-value a-foreign-struct 'the-struct-type 'field-name))
</programlisting>
</para>
</para>
</sect2>
- <sect2 id="uffi-declare">
- <title>uffi-declare</title>
- <para>
- This is used wherever a <function>declare</function>
- expression can be placed. For example:
- </para>
- <para>
- <programlisting>
-(let ((my-structure (uffi:allocate-foreign-object 'a-struct)))
- (uffi:uffi-declare a-struct my-structure))
- </programlisting>
- </para>
- </sect2>
-
- <sect2 id="slot-type">
- <title>slot-type</title>
+ <sect2 id="def-type">
+ <title>def-type</title>
<para>
- This is used inside of <function>defclass</function> and
- <function>defstruct</function> expressions to set the type
- for a field. Because the type identifier is not evaluated in
- &cl;, the expression must be backquoted for effect. For
- example:
- </para>
+ This is used wherever a &cl; <function>deftype</function>
+ expression can be placed. Used to declare types to
+the compiler for optimization. Currently, on &cmucl; takes advantage
+of this. </para>
<para>
<programlisting>
-(eval
- `(defclass a-class ()
- ((char-ptr :type ,(uffi:slot-type (* :char))))))
+(uffi:def-type my-struct-def my-struct-foreign-type)
</programlisting>
</para>
</sect2>
;;;;
;;;; Copyright (c) 2002 Kevin M. Rosenberg
;;;;
-;;;; $Id: gettime.cl,v 1.4 2002/03/10 22:29:47 kevin Exp $
+;;;; $Id: gettime.cl,v 1.5 2002/03/11 18:00:57 kevin Exp $
;;;;
;;;; This file is part of UFFI.
;;;;
(in-package :cl-user)
-(uffi:def-type time-t :unsigned-long)
+(uffi:def-foreign-type time-t :unsigned-long)
(uffi:def-struct tm
(sec :int)
((time (* time-t)))
:returning (* tm))
+(uffi:def-type time-t :unsigned-long)
+(uffi:def-type tm-pointer (* tm))
+
(defun gettime ()
- "Returns the local time"
- (let* ((time (uffi:allocate-foreign-object time-t)))
-;; (uffi:uffi-declare time-t time)
- (c-time time)
- (let ((tm-ptr (c-localtime time)))
-;; (uffi:uffi-declare (* tm) tm-ptr)
- (let ((time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
- (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
- (uffi:get-slot-value tm-ptr 'tm 'mday)
- (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
- (uffi:get-slot-value tm-ptr 'tm 'hour)
- (uffi:get-slot-value tm-ptr 'tm 'min)
- (uffi:get-slot-value tm-ptr 'tm 'sec)
- )))
- (uffi:free-foreign-object time)
- time-string))
- ))
+ "Returns the local time"
+ (let* ((time (uffi:allocate-foreign-object time-t)))
+ (declare (type time-t time))
+ (c-time time)
+ (let ((tm-ptr (the tm-pointer (c-localtime time))))
+ (declare (type tm-pointer tm-ptr))
+ (let ((time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
+ (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
+ (uffi:get-slot-value tm-ptr 'tm 'mday)
+ (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
+ (uffi:get-slot-value tm-ptr 'tm 'hour)
+ (uffi:get-slot-value tm-ptr 'tm 'min)
+ (uffi:get-slot-value tm-ptr 'tm 'sec)
+ )))
+ (uffi:free-foreign-object time)
+ time-string))
+ ))
+
+
+
#+test-uffi
(format t "~&~A" (gettime))
;;;;
;;;; Copyright (c) 2002 Kevin M. Rosenberg
;;;;
-;;;; $Id: strtol.cl,v 1.6 2002/03/10 11:13:07 kevin Exp $
+;;;; $Id: strtol.cl,v 1.7 2002/03/11 18:00:57 kevin Exp $
;;;;
;;;; This file is part of UFFI.
;;;;
(in-package :cl-user)
-(uffi:def-type char-ptr (* :char))
+(uffi:def-foreign-type char-ptr (* :char))
;; This example does not use :cstring to pass the input string since
;; the routine needs to do pointer arithmetic to see how many characters
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: set-logical.cl
+;;;; Purpose: Sets a logical host for src/binaries based on a pathname.
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: set-logical.cl,v 1.1 2002/03/11 18:00:57 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+
+;;; Setup logical pathname translaton with separate binary directories
+;;; for each implementation
+
+;; push allegro case sensitivity on *features*
+#+allegro
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (if (or (eq excl:*current-case-mode* :case-sensitive-lower)
+ (eq excl:*current-case-mode* :case-sensitive-upper))
+ (pushnew :case-sensitive cl:*features*)
+ (pushnew :case-insensitive cl:*features*)))
+
+(defconstant +set-logical-compiler-name+
+ #+(and allegro ics case-sensitive) "acl-modern"
+ #+(and allegro (not ics) case-sensitive) "acl-modern8"
+ #+(and allegro ics (not case-sensitive)) "acl-ansi"
+ #+(and allegro (not ics) (not case-sensitive)) "acl-ansi8"
+ #+lispworks "lispworks"
+ #+clisp "clisp"
+ #+cmu "cmucl"
+ #+sbcl "sbcl"
+ #+corman "corman"
+ #+mcl "mcl"
+ #-(or allegro lispworks clisp cmu sbcl corman mcl) "unknown")
+
+(defun set-logical-host-for-pathname (host base-pathname)
+ (setf (logical-pathname-translations host)
+ `(("ROOT;" ,(make-pathname
+ :host (pathname-host base-pathname)
+ :device (pathname-device base-pathname)
+ :directory (pathname-directory base-pathname)))
+ ("**;bin;*.*.*" ,(merge-pathnames
+ (make-pathname
+ :name :wild
+ :type :wild
+ :directory
+ (append '(:relative :wild-inferiors
+ ".bin" #.+set-logical-compiler-name+)))
+ base-pathname))
+ ("**;*.*.*" ,(merge-pathnames
+ (make-pathname
+ :name :wild
+ :type :wild
+ :directory '(:relative :wild-inferiors))
+ base-pathname))))
+ )
;;;;
;;;; Copyright (c) 2002 Kevin M. Rosenberg
;;;;
-;;;; $Id: primitives.cl,v 1.2 2002/03/10 22:29:47 kevin Exp $
+;;;; $Id: primitives.cl,v 1.3 2002/03/11 18:00:57 kevin Exp $
;;;;
;;;; This file is part of the UFFI.
;;;;
(defconstant ,name ,value)
(export ',name)))
-(defmacro uffi-declare (type name)
- "Generates a declare statement for CL. Currently, only CMUCL
-supports this."
+(defmacro def-type (name type)
+ "Generates a (deftype) statement for CL. Currently, only CMUCL
+supports takes advantage of this optimization."
#+(or lispworks allegro)
- (declare (ignore type name))
+ `(deftype ,name () t)
#+cmu
- `(declare (type (alien:alien ,type)) ,name)
+ `(deftype ,name () '(alien:alien ,(convert-from-uffi-type type :declare)))
)
-(defmacro slot-type (type)
- #+(or lispworks allegro)
- (declare (ignore type))
- #+(or lispworks allegro)
- t
- #+cmu `'(alien:alien ,type))
-
(defmacro null-char-p (val)
`(if (or (eql ,val 0)
(eq ,val #\Null))
nil))
-(defmacro def-type (name type)
+(defmacro def-foreign-type (name type)
#+lispworks `(fli:define-c-typedef ,name ,(convert-from-uffi-type type :type))
#+allegro `(ff:def-foreign-type ,name ,(convert-from-uffi-type type :type))
#+cmu `(alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
(dolist (type +cmu-def-type-list+)
(setf (gethash (car type) +cmu-def-type-hash+) (cdr type)))
-(defun ph (&optional (os *standard-output*))
+(defmethod ph (&optional (os *standard-output*))
(maphash #'(lambda (k v) (format os "~&~S => ~S" k v)) +type-conversion-hash+))
(defun convert-from-uffi-type (type context)
;;;;
;;;; Copyright (c) 2002 Kevin M. Rosenberg
;;;;
-;;;; $Id: gettime.cl,v 1.4 2002/03/10 22:29:47 kevin Exp $
+;;;; $Id: gettime.cl,v 1.5 2002/03/11 18:00:57 kevin Exp $
;;;;
;;;; This file is part of UFFI.
;;;;
(in-package :cl-user)
-(uffi:def-type time-t :unsigned-long)
+(uffi:def-foreign-type time-t :unsigned-long)
(uffi:def-struct tm
(sec :int)
((time (* time-t)))
:returning (* tm))
+(uffi:def-type time-t :unsigned-long)
+(uffi:def-type tm-pointer (* tm))
+
(defun gettime ()
- "Returns the local time"
- (let* ((time (uffi:allocate-foreign-object time-t)))
-;; (uffi:uffi-declare time-t time)
- (c-time time)
- (let ((tm-ptr (c-localtime time)))
-;; (uffi:uffi-declare (* tm) tm-ptr)
- (let ((time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
- (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
- (uffi:get-slot-value tm-ptr 'tm 'mday)
- (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
- (uffi:get-slot-value tm-ptr 'tm 'hour)
- (uffi:get-slot-value tm-ptr 'tm 'min)
- (uffi:get-slot-value tm-ptr 'tm 'sec)
- )))
- (uffi:free-foreign-object time)
- time-string))
- ))
+ "Returns the local time"
+ (let* ((time (uffi:allocate-foreign-object time-t)))
+ (declare (type time-t time))
+ (c-time time)
+ (let ((tm-ptr (the tm-pointer (c-localtime time))))
+ (declare (type tm-pointer tm-ptr))
+ (let ((time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
+ (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
+ (uffi:get-slot-value tm-ptr 'tm 'mday)
+ (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
+ (uffi:get-slot-value tm-ptr 'tm 'hour)
+ (uffi:get-slot-value tm-ptr 'tm 'min)
+ (uffi:get-slot-value tm-ptr 'tm 'sec)
+ )))
+ (uffi:free-foreign-object time)
+ time-string))
+ ))
+
+
+
#+test-uffi
(format t "~&~A" (gettime))
;;;;
;;;; Copyright (c) 2002 Kevin M. Rosenberg
;;;;
-;;;; $Id: strtol.cl,v 1.6 2002/03/10 11:13:07 kevin Exp $
+;;;; $Id: strtol.cl,v 1.7 2002/03/11 18:00:57 kevin Exp $
;;;;
;;;; This file is part of UFFI.
;;;;
(in-package :cl-user)
-(uffi:def-type char-ptr (* :char))
+(uffi:def-foreign-type char-ptr (* :char))
;; This example does not use :cstring to pass the input string since
;; the routine needs to do pointer arithmetic to see how many characters
;;;;
;;;; Copyright (c) 2002 Kevin M. Rosenberg
;;;;
-;;;; $Id: uffi.system,v 1.3 2002/03/10 21:48:50 kevin Exp $
+;;;; $Id: uffi.system,v 1.4 2002/03/11 18:00:57 kevin Exp $
;;;;
;;;; This file is part of UFFI.
;;;;
(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :cl-user)
-;;; Setup logical pathname translaton with separate binary directories
-;;; for each implementation
-
-;; push allegro case sensitivity on *features*
-#+allegro
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (if (or (eq excl:*current-case-mode* :case-sensitive-lower)
- (eq excl:*current-case-mode* :case-sensitive-upper))
- (pushnew :case-sensitive cl:*features*)
- (pushnew :case-insensitive cl:*features*)))
-
-(defconstant +uffi-compiler-name+
- #+(and allegro ics case-sensitive) "acl-modern"
- #+(and allegro (not ics) case-sensitive) "acl-modern8"
- #+(and allegro ics (not case-sensitive)) "acl-ansi"
- #+(and allegro (not ics) (not case-sensitive)) "acl-ansi8"
- #+lispworks "lispworks"
- #+clisp "clisp"
- #+cmu "cmucl"
- #+sbcl "sbcl"
- #+corman "corman"
- #+mcl "mcl"
- #-(or allegro lispworks clisp cmu sbcl corman mcl) "unknown")
-
-(setf (logical-pathname-translations "UFFI")
- `(("**;bin;*.*.*" ,(merge-pathnames
- (make-pathname
- :name :wild
- :type :wild
- :directory
- (append '(:relative :wild-inferiors
- ".bin" #.+uffi-compiler-name+)))
- *load-truename*))
- ("**;*.*.*" ,(merge-pathnames
- (make-pathname
- :name :wild
- :type :wild
- :directory '(:relative :wild-inferiors))
- *load-truename*))))
+(load (make-pathname :name "set-logical" :type "cl"
+ :defaults *load-truename*))
+(set-logical-host-for-pathname "UFFI" *load-truename*)
;;; UFFI system definition
projects / uffi.git / commitdiff