X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fobjects.lisp;h=0e327f0269d4d457da27b457de85fc3657caa5b5;hb=6b108d27ffc3f4e08f2529e71911ed02a5310a6d;hp=f777f3c242d6b6dd7ffbf381bdbe81a01b135745;hpb=6ab554f2441048c9c726104d4f3c6a6acccaf383;p=uffi.git diff --git a/src/objects.lisp b/src/objects.lisp index f777f3c..0e327f0 100644 --- a/src/objects.lisp +++ b/src/objects.lisp @@ -24,12 +24,12 @@ #+clisp (values (ffi:size-of type)) #+digitool (let ((mcl-type (ccl:find-mactype type nil t))) - (if mcl-type + (if mcl-type (ccl::mactype-record-size mcl-type) (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record #+openmcl (ccl::%foreign-type-or-record-size type :bytes) )) - + (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. The TYPE parameter is evaluated." @@ -130,7 +130,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." #+(or allegro cmu sbcl scl openmcl) `(code-char ,obj) ;; lispworks varies whether deref'ing array vs. slot access of a char #+lispworks `(if (characterp ,obj) ,obj (code-char ,obj))) - + (defmacro ensure-char-integer (obj) #+(or digitool) `(char-code ,obj) #+(or allegro cmu sbcl scl openmcl) obj @@ -152,7 +152,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." #+allegro obj #+(or openmcl digitool) - `(ccl:%ptr-to-int ,obj) + `(ccl:%ptr-to-int ,obj) ) ;; TYPE is evaluated. @@ -209,10 +209,10 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." (setf type (nth 1 type))) (push (list (first spec) (* count (size-of-foreign-type type))) params)) `(ccl:%stack-block ,params ,@body))) - + #+(or openmcl digitool) (defmacro with-foreign-object ((var type) &rest body) - `(with-foreign-objects ((,var ,type)) + `(with-foreign-objects ((,var ,type)) ,@body)) #+lispworks @@ -243,7 +243,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." (lisp-implementation-type))) #+(or allegro openmcl) -(defun convert-external-name (name) +(defun convert-external-name (name) "Add an underscore to NAME if necessary for the ABI." #+(or macosx darwinppc-target) (concatenate 'string "_" name) #-(or macosx darwinppc-target) name) @@ -278,3 +278,13 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." `(define-symbol-macro ,lisp-name '(error "DEF-FOREIGN-VAR not (yet) defined for ~A" (lisp-implementation-type))))) + + +;;; Define a special variable, like DEFVAR, that will be initialized +;;; to a pointer which may need to be reset when a saved image is +;;; loaded. This is needed for OpenMCL, which sets pointers to "dead +;;; macptrs" when a saved image is loaded. +;; This may possibly be needed for sbcl's SAVE-LISP-AND-DIE +(defmacro def-pointer-var (name value &optional doc) + #-openmcl `(defvar ,name ,value ,@(if doc (list doc))) + #+openmcl `(ccl::defloadvar ,name ,value ,doc))