#+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."
#+(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
#+allegro
obj
#+(or openmcl digitool)
- `(ccl:%ptr-to-int ,obj)
+ `(ccl:%ptr-to-int ,obj)
)
;; TYPE 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
(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)
`(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))