uffi/src libraries.lisp,1.9,1.10 objects.lisp,1.15,1.16 package.lisp,1.4,1.5

Update of /pubcvs/uffi/src
In directory boa.b9.com:/tmp/cvs-serv14284/src

Modified Files:
	libraries.lisp objects.lisp package.lisp 
Log Message:


Index: libraries.lisp
===================================================================
RCS file: /pubcvs/uffi/src/libraries.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** libraries.lisp	8 Jul 2003 12:37:21 -0000	1.9
--- libraries.lisp	14 Aug 2003 19:35:05 -0000	1.10
***************
*** 73,77 ****
  (defun load-foreign-library (filename &key module supporting-libraries
  					   force-load)
!   #+(or allegro lispworks mcl) (declare (ignore module supporting-libraries))
    #+(or cmu scl sbcl) (declare (ignore module))
    
--- 73,77 ----
  (defun load-foreign-library (filename &key module supporting-libraries
  					   force-load)
!   #+(or allegro mcl) (declare (ignore module supporting-libraries))
    #+(or cmu scl sbcl) (declare (ignore module))
    

Index: objects.lisp
===================================================================
RCS file: /pubcvs/uffi/src/objects.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** objects.lisp	8 Jul 2003 12:37:21 -0000	1.15
--- objects.lisp	14 Aug 2003 19:35:05 -0000	1.16
***************
*** 119,123 ****
  (defsetf deref-pointer deref-pointer-set)
  
! #+(or lispworks (and mcl (not openmcl))) ;; with LW, deref is a character
  (defmacro ensure-char-character (obj)
    obj)
--- 119,127 ----
  (defsetf deref-pointer deref-pointer-set)
  
! #+lispworks
! (defmacro ensure-char-character (obj)
!   `(if (characterp ,obj) ,obj (code-char ,obj)))
! 
! #+(and mcl (not openmcl)) 
  (defmacro ensure-char-character (obj)
    obj)
***************
*** 197,199 ****
--- 201,230 ----
    `(with-foreign-objects ((,var ,type)) 
       ,@body))
+ 
+ #+lispworks
+ (defmacro with-cast-pointer ((binding-name pointer type) &body body)
+   `(fli:with-coerced-pointer (,binding-name
+                           :type ',(convert-from-uffi-type (eval type) :type))
+       ,pointer
+     ,@body))
+ 
+ #+(or cmu scl sbcl)
+ (defmacro with-cast-pointer ((binding-name pointer type) &body body)
+   `(let ((,binding-name
+           (#+(or cmu scl) alien:cast
+            #+sbcl sb-alien:cast
+            ,pointer (* ,(convert-from-uffi-type (eval type) :type)))))
+     ,@body))
+ 
+ #+allegro
+ (defmacro with-cast-pointer ((binding-name pointer type) &body body)
+   (declare (ignore type))
+   `(let ((,binding-name ,pointer))
+     ,@body))
+ 
+ #-(or lispworks cmu scl sbcl allegro)
+ (defmacro with-cast-pointer ((binding-name pointer type) &body body)
+   (declare (ignore binding-name pointer type))
+   '(error "WITH-CAST-POINTER not (yet) implemented for ~A"
+           (lisp-implementation-type)))
  

Index: package.lisp
===================================================================
RCS file: /pubcvs/uffi/src/package.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** package.lisp	6 Jun 2003 21:59:18 -0000	1.4
--- package.lisp	14 Aug 2003 19:35:05 -0000	1.5
***************
*** 50,53 ****
--- 50,54 ----
     #:+null-cstring-pointer+
     #:char-array-to-pointer
+    #:with-cast-pointer
     
     ;; string functions