diff options
-rw-r--r-- | Lisp/internal-utilities.lisp | 23 | ||||
-rw-r--r-- | Lisp/method-invocation.lisp | 39 | ||||
-rw-r--r-- | Objective-C/libobjcl.h | 10 | ||||
-rw-r--r-- | Objective-C/libobjcl.m | 4 |
4 files changed, 4 insertions, 72 deletions
diff --git a/Lisp/internal-utilities.lisp b/Lisp/internal-utilities.lisp index 13d4e47..cf1c562 100644 --- a/Lisp/internal-utilities.lisp +++ b/Lisp/internal-utilities.lisp @@ -16,29 +16,6 @@ ,@(car (last (cons arg args)))))))) -(defmacro with-foreign-conversion (bindings &body body) - `(with-obj-data-values - ,(mapcar #'(lambda (name-value-pair) - (destructuring-bind (name value) - name-value-pair - `(,name (lisp->obj-data ,value)))) - bindings) - ,@body)) - - -(defmacro with-obj-data-values (bindings &body body) - `(let ,(mapcar #'(lambda (name-value-pair) - (destructuring-bind (name value) - name-value-pair - `(,name ,value))) - bindings) - (unwind-protect - (progn ,@body) - ,@(mapcar #'(lambda (name-value-pair) - `(dealloc-obj-data ,(first name-value-pair))) - bindings)))) - - (defmacro with-foreign-string-pool ((register-fn-name) &body body) (let ((pool-var (gensym))) `(let ((,pool-var (list))) diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 5a7a719..6d0dc12 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -145,38 +145,6 @@ Returns: *result* --- the return value of the method invocation. args)))) -(defmacro unsafe-primitive-invoke (receiver method-name return-type &rest args) - (let ((real-return-type (if (member return-type '(id objc-class exception - selector)) - :pointer - return-type)) - (real-receiver (gensym)) - (real-selector (gensym)) - (selector (selector method-name))) - `(progn - (let ((,real-receiver ,receiver) - (,real-selector (selector ,method-name))) - (check-type ,real-receiver (or id objc-class exception) - "an Objective C instance (ID, OBJC-CLASS or EXCEPTION)") - (let ((method (get-method-implementation ,real-receiver ,real-selector)) - (objc-arglist (arglist->objc-arglist (list ,@args)))) - (unwind-protect - (let ((return-value - (apply-macro 'foreign-funcall-pointer method - () - (append (list :pointer (pointer-to ,real-receiver)) - (list :pointer (pointer-to ,real-selector)) - objc-arglist - (list ,real-return-type))))) - ,(if (member return-type '(id objc-class exception selector)) - `(let (,@(when (constructor-name-p (selector-name selector)) - `((*skip-retaining* t)))) - (make-instance return-type - :pointer return-value)) - `return-value)) - (dealloc-objc-arglist objc-arglist))))))) - - (defun primitive-invoke (receiver method-name return-type &rest args) "An invocation mechanism with ad-hoc argument conversion." (with-foreign-string-pool (register-temporary-string) @@ -470,13 +438,6 @@ Returns: *result* --- the return value of the method invocation. ;;; (@* "Helper functions") -(defun dealloc-objc-arglist (objc-arglist) - (do ((objc-arglist objc-arglist (cddr objc-arglist))) - ((null objc-arglist)) - ;; (first objc-arglist) is a CFFI type name. - (dealloc-obj-data (second objc-arglist)))) - - (defun constructor-name-p (method-name) (flet ((method-name-starts-with (prefix) (and (>= (length method-name) (length prefix)) diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h index fae8636..c84dbb9 100644 --- a/Objective-C/libobjcl.h +++ b/Objective-C/libobjcl.h @@ -17,12 +17,6 @@ objcl_initialise_runtime (void); void objcl_shutdown_runtime (void); -OBJCL_OBJ_DATA -objcl_invoke_method (OBJCL_OBJ_DATA receiver, - SEL method_selector, - int argc, - ...); - id objcl_invoke_with_types (int argc, char *return_typespec, @@ -71,7 +65,7 @@ objcl_get_nil (void); /* In principle, we do not know whether a BOOL fits into a long. In practise, it is very likely. */ long -objcl_get_yes (); +objcl_get_yes (void); long -objcl_get_no (); +objcl_get_no (void); diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index 11450f7..849eedf 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -230,7 +230,7 @@ objcl_get_nil (void) long -objcl_get_yes () +objcl_get_yes (void) { if (sizeof (YES) > sizeof (long)) fprintf (stderr, "WARNING: objcl_get_yes: YES might not fit into a long.\n"); @@ -239,7 +239,7 @@ objcl_get_yes () long -objcl_get_no () +objcl_get_no (void) { if (sizeof (NO) > sizeof (long)) fprintf (stderr, "WARNING: objcl_get_no: NO might not fit into a long.\n"); |