diff options
| -rw-r--r-- | Lisp/data-types.lisp | 18 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 7 | ||||
| -rw-r--r-- | Lisp/memory-management.lisp | 7 |
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 |