diff options
| -rw-r--r-- | Lisp/constant-data.lisp | 1 | ||||
| -rw-r--r-- | Lisp/init.lisp | 9 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 3 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 36 | ||||
| -rw-r--r-- | Lisp/utilities.lisp | 6 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 8 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 18 | ||||
| -rw-r--r-- | objective-cl.asd | 3 |
8 files changed, 56 insertions, 28 deletions
diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp index f936908..7922c4f 100644 --- a/Lisp/constant-data.lisp +++ b/Lisp/constant-data.lisp @@ -17,6 +17,7 @@ (defconstant +pessimistic-allocation-size+ (cffi:foreign-type-size +pessimistic-allocation-type+)) + ;;;; (@* "The constant data") ;;; Copied from objc-api.h ;;; Probably ought to be generated by C code at initialisation time. diff --git a/Lisp/init.lisp b/Lisp/init.lisp index 84ae511..72d616f 100644 --- a/Lisp/init.lisp +++ b/Lisp/init.lisp @@ -1,3 +1,12 @@ (in-package #:mulk.objective-cl) (initialise-runtime) + +(eval-when (:load-toplevel) + (unless (boundp '+nil+) + (defconstant +nil+ + (make-instance 'id :pointer (objcl-get-nil)))) + (unless (boundp '+yes+) + (defconstant +yes+ (objcl-get-yes))) + (unless (boundp '+no+) + (defconstant +no+ (objcl-get-no)))) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 9849392..85dfc45 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -72,7 +72,8 @@ (obj :pointer)) (defcfun objcl-get-nil :pointer) - +(defcfun objcl-get-yes :long) +(defcfun objcl-get-no :long) (defun initialise-runtime () "Initialise the Objective C runtime. diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 9f9e056..dbf6f33 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -1,12 +1,6 @@ (in-package #:mulk.objective-cl) -(eval-when (:execute) - (unless (boundp '+nil+) - (defconstant +nil+ - (make-instance 'id :pointer (objcl-get-nil))))) - - ;;; (@* "Method invocation") (defun invoke (receiver message-start &rest message-components) "Send a message to an Objective C instance. @@ -539,7 +533,7 @@ Returns: *result* --- the return value of the method invocation. (defcoercion id ((x id)) x) -(defcoercion id ((x class)) +(defcoercion id ((x objc-class)) x) (defcoercion id ((x exception)) @@ -551,15 +545,13 @@ Returns: *result* --- the return value of the method invocation. 'id x)) -(defcoercion id ((x double-float)) - (primitive-invoke (find-objc-class 'ns-number) - :number-with-double - 'id - x)) - -(defcoercion id ((x single-float)) +(defcoercion id ((x float)) (primitive-invoke (find-objc-class 'ns-number) - :number-with-float + (etypecase x + (long-float :number-with-double) + (double-float :number-with-double) + (short-float :number-with-float) + (single-float :number-with-float)) 'id x)) @@ -589,7 +581,7 @@ Returns: *result* --- the return value of the method invocation. (defcoercion class ((x exception)) (object-get-class x)) -(defcoercion class ((x class)) +(defcoercion class ((x objc-class)) x) (defcoercion class ((x string)) @@ -649,15 +641,13 @@ Returns: *result* --- the return value of the method invocation. (float x)) +;; Note that this refers to the Objective-C BOOL type, not the Lisp +;; BOOLEAN type. (defcoercion bool ((x null)) - x) + +no+) -(defcoercion bool ((x symbol)) - (assert (eq 't x)) - x) - -(defcoercion bool ((x integer)) - x) +(defcoercion bool (x) + +yes+) (defcoercion string ((x string)) diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp index b44c05d..a5c1723 100644 --- a/Lisp/utilities.lisp +++ b/Lisp/utilities.lisp @@ -8,7 +8,7 @@ (defun truep (b) (or (eq b t) (and (numberp b) - (not (zerop b))))) + (not (eql b +no+))))) (defun id-eql (x y) @@ -17,10 +17,10 @@ (defun id-equal (x y) (truep (if (typep x '(or id objc-class exception)) - (primitive-invoke x :is-equal :boolean y) + (primitive-invoke x :is-equal :char y) (progn (assert (typep y '(or id objc-class exception))) - (primitive-invoke y :is-equal :boolean x))))) + (primitive-invoke y :is-equal :char x))))) (defun objc-typep (x class-designator) diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h index a912748..8b37609 100644 --- a/Objective-C/libobjcl.h +++ b/Objective-C/libobjcl.h @@ -94,3 +94,11 @@ objcl_object_get_meta_class (id obj); id 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 (); + +long +objcl_get_no (); diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index eaffb8c..15855ed 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -457,3 +457,21 @@ objcl_get_nil (void) { return nil; } + + +long +objcl_get_yes () +{ + if (sizeof (YES) > sizeof (long)) + fprintf (stderr, "WARNING: objcl_get_yes: YES might not fit into a long.\n"); + return YES; +} + + +long +objcl_get_no () +{ + if (sizeof (NO) > sizeof (long)) + fprintf (stderr, "WARNING: objcl_get_no: NO might not fit into a long.\n"); + return NO; +} diff --git a/objective-cl.asd b/objective-cl.asd index c936614..25de346 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -25,7 +25,8 @@ "data-types" "libobjcl" "internal-utilities" - "parameters")) + "parameters" + "init")) (:file "memory-management" :depends-on ("defpackage" "init" "weak-hash-tables" |