r10934: 2006-05-11 Kevin Rosenberg (kevin@rosenberg.net)
[uffi.git] / src / objects.lisp
index f777f3c242d6b6dd7ffbf381bdbe81a01b135745..42a5af355344ff179c385eb5fe40fb8ee0702ad7 100644 (file)
     #+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 ,doc)
+  #+openmcl `(ccl::defloadvar ,name ,value ,doc))