diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-15 18:52:09 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-15 18:52:09 +0100 |
| commit | 447f9c1af0096f52555eb6d3d5ee758707f8cfd9 (patch) | |
| tree | 594d7e57a0b2e8a2f8457f9160a5d5c44dc667e2 | |
| parent | 0b12205917b829ac63a17c63ab07d79d69249324 (diff) | |
Add automatic finalisation to struct wrappers.
darcs-hash:1e1b7811aa26338c747a031d3cf810f621cf12d9
| -rw-r--r-- | Lisp/data-types.lisp | 18 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 15 |
2 files changed, 26 insertions, 7 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 1b2beb7..4360ca5 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -178,7 +178,7 @@ a suitable class method instead as you would in Objective-C. (define-condition exception (error) ((pointer :type c-pointer - :accessor pointer-to + :reader pointer-to :initarg :pointer)) (:report (lambda (condition stream) (format stream @@ -256,12 +256,16 @@ an __exception__, you can simply send it the `self' message. (defun make-struct-wrapper (pointer typespec managedp) - (make-instance (ecase (typespec-primary-type typespec) - (struct 'tagged-struct) - (union 'tagged-union)) - :typespec typespec - :pointer pointer - :lisp-managed managedp)) + (let ((new-wrapper (make-instance (ecase (typespec-primary-type typespec) + (struct 'tagged-struct) + (union 'tagged-union)) + :typespec typespec + :pointer pointer + :lisp-managed managedp))) + (when managedp + (trivial-garbage:finalize new-wrapper + #'(lambda () + (foreign-free pointer)))))) (defgeneric objcl-eql (obj1 obj2)) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 89930b8..7c5fd8c 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -301,6 +301,21 @@ conventional case for namespace identifiers in Objective-C." class-name-string)) :pointer class-ptr :wrapped-foreign-class class-name-string + ;; FIXME: It might be desirable to do + ;; set the list of direct superclasses + ;; to something like the following: + ;; + ;; (if (string= class-name-string "NSException") + ;; (list superclass (find-class 'serious-condition)) + ;; (list superclass)) + ;; + ;; This will fail, as subclassing + ;; CONDITION means not subclassing a + ;; STANDARD-CLASS. Also, care would + ;; have to be taken not to use + ;; MAKE-INSTANCE but MAKE-CONDITION + ;; for anything derived from + ;; NSException. :direct-superclasses (list superclass))))))) |