summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-11 17:34:57 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-11 17:34:57 +0100
commite75a694b028cd8f7e378929fe95dd6ca355b1051 (patch)
tree22f1c472216e1be744125674d3e687a6451f6801
parent38747051bbe8bf893363c99374118e237e252cb7 (diff)
Specialise MAKE-LOAD-FORM for pointer wrappers.
darcs-hash:4a9e629e6e9a9e20d21c80c541e70b4b6a810645
-rw-r--r--Lisp/data-types.lisp18
-rw-r--r--Lisp/libobjcl.lisp7
-rw-r--r--Lisp/memory-management.lisp7
3 files changed, 29 insertions, 3 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index e244e8d..36f0f2f 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -39,6 +39,17 @@
:initform (cffi:null-pointer)))))
+
+
+(defmethod make-load-form ((instance c-pointer-wrapper) &optional environment)
+ (declare (ignore environment))
+ ;; (TYPE-OF INSTANCE) works because MAKE-POINTER-WRAPPER accepts
+ ;; subclasses of ID as well as ID itself.
+ `(make-pointer-wrapper ',(type-of instance)
+ :pointer (make-pointer
+ ,(pointer-address (pointer-to instance)))))
+
+
;; The following may be needed by some implementations (namely Allegro
;; CL).
(eval-when (:compile-toplevel :load-toplevel :execute)
@@ -106,6 +117,13 @@ The following calls are all equivalent:
(apply #'invoke-by-name receiver selector args))))
+(defmethod make-load-form ((selector selector) &optional environment)
+ (declare (ignore environment))
+ `(make-pointer-wrapper 'selector
+ :pointer (make-pointer
+ ,(pointer-address (pointer-to selector)))))
+
+
(defclass id (c-pointer-wrapper)
()
(:documentation "The type of all Objective-C objects.
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 6b14115..fda484c 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -18,9 +18,10 @@
(in-package #:mulk.objective-cl)
-(dolist (subdir '("shared_obj/" "obj/"))
- (pushnew (merge-pathnames subdir objcl-asdf:*objc-obj-dir*)
- cffi:*foreign-library-directories*))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (dolist (subdir '("shared_obj/" "obj/"))
+ (pushnew (merge-pathnames subdir objcl-asdf:*objc-obj-dir*)
+ cffi:*foreign-library-directories*)))
(define-foreign-library libobjcl
(:unix (:or "libobjcl.so"
diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp
index 1d652ae..4829a1e 100644
--- a/Lisp/memory-management.lisp
+++ b/Lisp/memory-management.lisp
@@ -24,6 +24,13 @@
(defun make-pointer-wrapper (class &rest initargs &key pointer &allow-other-keys)
+ (when (or (null-pointer-p pointer)
+ (pointer-eq (objcl-get-nil) pointer))
+ (return-from make-pointer-wrapper
+ ;; We can't simply return +NIL+ here, because this function might
+ ;; be called at load-time (see the MAKE-LOAD-FORM methods in
+ ;; data-types.lisp).
+ (make-instance 'id :pointer (objcl-get-nil))))
(when (not (eq 'selector class))
(cond ((%objcl-object-is-meta-class pointer)
(return-from make-pointer-wrapper