;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: ffi.lisp,v 1.8 2004/12/16 23:02:10 espen Exp $
+;; $Id: ffi.lisp,v 1.12 2005/01/03 16:35:05 espen Exp $
(in-package "GLIB")
(not supplied-lambda-list)
(namep expr) (member style '(:in :in-out :return)))
(push expr lambda-list))
- (push
- (list (if (namep expr)
- (make-symbol (string expr))
- (gensym))
- expr (mklist type) style) args)))))
+ (push (list (cond
+ ((and (namep expr) (eq style :out)) expr)
+ ((namep expr) (make-symbol (string expr)))
+ ((gensym)))
+ expr (mklist type) style) args)))))
(%defbinding
c-name lisp-name (or supplied-lambda-list (nreverse lambda-list))
(def-type-method reader-function ())
(def-type-method destroy-function ())
+(def-type-method unbound-value ()
+ "First return value is true if the type has an unbound value, second return value is the actual unbound value")
+
;; Sizes of fundamental C types in bytes (8 bits)
(defconstant +size-of-short+ 2)
((* #.+bits-of-int+) +size-of-int+)
(#.+bits-of-long+ +size-of-long+))))
+(defmethod unbound-value ((type t) &rest args)
+ (declare (ignore type args))
+ nil)
+
(defmethod writer-function ((type (eql 'signed-byte)) &rest args)
(declare (ignore type))
(destructuring-bind (&optional (size '*)) args
(defmethod alien-type ((type (eql 'unsigned-byte)) &rest args)
(destructuring-bind (&optional (size '*)) args
(ecase size
- (#.+bits-of-byte+ '(unsigned-byte 8))
+ (#.+bits-of-byte+ '(unsigned #|-byte|# 8))
(#.+bits-of-short+ 'c-call:unsigned-short)
((* #.+bits-of-int+) 'c-call:unsigned-int)
(#.+bits-of-long+ 'c-call:unsigned-long))))
(defmethod size-of ((type (eql 'double-float)) &rest args)
(declare (ignore type args))
- +size-of-float+)
+ +size-of-double+)
(defmethod writer-function ((type (eql 'double-float)) &rest args)
(declare (ignore type args))
(deallocate-memory (sap-ref-sap location offset))
(setf (sap-ref-sap location offset) (make-pointer 0)))))
+(defmethod unbound-value ((type (eql 'string)) &rest args)
+ (declare (ignore type args))
+ (values t nil))
(defmethod alien-type ((type (eql 'pathname)) &rest args)
(declare (ignore type args))
(declare (ignore type args))
(destroy-function 'string))
+(defmethod unbound-value ((type (eql 'pathname)) &rest args)
+ (declare (ignore type args))
+ (unbound-value 'string))
+
(defmethod alien-type ((type (eql 'boolean)) &rest args)
(apply #'alien-type 'signed-byte args))