diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/data-types.lisp | 37 | ||||
| -rw-r--r-- | Lisp/defpackage.lisp | 8 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 7 | ||||
| -rw-r--r-- | Lisp/policy.lisp | 2 |
4 files changed, 36 insertions, 18 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 6726f70..91e10f3 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -232,23 +232,24 @@ an __exception__, you can simply send it the `self' message. :documentation "Whether we need to handle deallocation."))) -(defclass opaque-struct (foreign-value) - ((name :type (or null string) - :accessor struct-name - :initarg :name))) - -(defclass tagged-struct (foreign-value) - ((name :type (or null string) - :accessor struct-name - :initarg :name) - (typespec :accessor foreign-value-typespec - :initarg :typespec))) +;; FIXME: Document. +(defclass foreign-struct (foreign-value) + ((name :type (or null string) + :accessor struct-name + :initarg :name))) -(defclass opaque-union (opaque-struct) ()) +;; The following are for private use only. +(defclass opaque-struct (foreign-struct) ()) +(defclass tagged-struct (foreign-struct) ()) +(defclass opaque-union (opaque-struct) ()) (defclass tagged-union (tagged-struct) ()) -(defclass tagged-array (foreign-value) + +;; FIXME: Either document or throw away. (Does the C language actually +;; support returning arrays from functions? It certainly does not +;; support passing them as arguments.) +(defclass foreign-array (foreign-value) ((element-type :type symbol :accessor tagged-array-element-type :initarg :element-type) @@ -257,17 +258,25 @@ an __exception__, you can simply send it the `self' message. (typespec :accessor foreign-value-typespec))) +;; FIXME: Document. (defgeneric foreign-value-lisp-managed-p (foreign-value)) (defmethod foreign-value-lisp-managed-p ((foreign-value foreign-value)) (with-slots (lisp-managed-cell) foreign-value (aref lisp-managed-cell))) +;; FIXME: Document. (defgeneric (setf foreign-value-lisp-managed-p) (managedp foreign-value)) (defmethod (setf foreign-value-lisp-managed-p) (managedp (foreign-value foreign-value)) (with-slots (lisp-managed-cell) foreign-value - (setf (aref lisp-managed-cell) managedp))) + (setf (aref lisp-managed-cell) (if managedp t nil)))) + + +;; FIXME: Document. +(defgeneric foreign-value-pointer (foreign-value)) +(defmethod foreign-value-pointer ((foreign-value foreign-value)) + (pointer-to foreign-value)) (defun make-struct-wrapper (pointer typespec managedp) diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index 1854cfd..3c2444b 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -31,6 +31,8 @@ #:objc-class-name #:selector-name #:selector + #:define-returns-boolean-exception + #:undefine-returns-boolean-exception ;; Generic functions #:objc-eql @@ -52,13 +54,17 @@ #:id #:selector #:exception + #:foreign-value + #:foreign-struct + #:foreign-union ;; Conditions #:message-not-understood #:no-such-selector ;; Metaclasses - #:objective-c-class)) + #:objective-c-class + #:objective-c-metaclass)) (defpackage #:mulk.objective-cl-features diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 59b4ce4..750647f 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -455,15 +455,16 @@ easier to use with __apply__. :pointer (cffi:mem-ref objc-return-value-cell return-c-type)))) ((:char :unsigned-char) - ;; FIXME: This is non-trivial. See policy.lisp for + ;; FIXME? This is non-trivial. See policy.lisp for ;; details. (objc-char->lisp-value (cffi:mem-ref objc-return-value-cell return-c-type) receiver selector)) ((struct union array) - ;; The caller is responsible for FOREIGN-FREEing the - ;; return value. + ;; The caller is responsible for preventing the return + ;; value from being garbage-collected by setting + ;; FOREIGN-VALUE-LISP-MANAGED-P to false. (make-struct-wrapper objc-struct-return-value-cell return-type t)) diff --git a/Lisp/policy.lisp b/Lisp/policy.lisp index 41484fa..03b4e62 100644 --- a/Lisp/policy.lisp +++ b/Lisp/policy.lisp @@ -18,6 +18,7 @@ (in-package #:mulk.objective-cl) +;; FIXME: Document. (defun define-returns-boolean-exception (selector-designator) (let ((key (typecase selector-designator (string selector-designator) @@ -25,6 +26,7 @@ (setf (gethash key *boolean-return-exceptions*) t))) +;; FIXME: Document. (defun undefine-returns-boolean-exceptions (selector-designator) (let ((key (typecase selector-designator (string selector-designator) |