diff options
| -rw-r--r-- | JOURNAL | 67 | ||||
| -rw-r--r-- | Lisp/internal-utilities.lisp | 4 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 2 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 27 | ||||
| -rw-r--r-- | Lisp/type-handling.lisp | 43 | ||||
| -rw-r--r-- | Lisp/utilities.lisp | 9 |
6 files changed, 133 insertions, 19 deletions
@@ -1,5 +1,72 @@ -*- mode: muse -*- +* 2007-10-04, 16:52:32 CEST + +** `char' Does Not Indicate a Char, Continued + +There's a good chance that I've figured out what to do about the +char/int mess. As it turns out, it isn't even limited to chars, as +shorts are affected, too. According to the code I took from PyObjC, +specifically the typespec conversion functions in libffi_support.m, both +GNUstep and NeXT/PowerPC treat chars and shorts as ints. The only +platform that isn't brain-damaged in this way seems to be NeXT/x86. Or +maybe it's even more brain-damaged, as it treats shorts and chars +normally when they are used as arguments, but as ints when they're used +as return values! At least GNUstep and NeXT/PowerPC are brain-damaged +in a *consistent* manner. + +I figure the reason I never saw this problem in GNUstep is probably +endianness. The little-endian x86 lets you treat pointers to ints as +pointers to chars without breaking anything, but that doesn't work in +big-endian machines. + + +* 2007-10-04, 13:02:31 CEST + +** `char' Does Not Indicate a Char + +In principle, the typespec "c" is supposed indicate a char. Now look at +the following SLIME session transcript (SBCL/PowerPC on Mac OS X): + +OBJECTIVE-CL> (defparameter *tmp* + (invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string "Mulk.")) +*TMP* +OBJECTIVE-CL> (defparameter *tmp2* + (invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string "Mulk.")) +*TMP2* +OBJECTIVE-CL> (second ;return type specifier + (multiple-value-list + (retrieve-method-signature-info (find-objc-class 'ns-string) + (selector :is-equal)))) +"c" +OBJECTIVE-CL> (invoke *tmp* :is-equal *tmp2*) +0 +OBJECTIVE-CL> (primitive-invoke *tmp* :is-equal :char *tmp2*) +0 +OBJECTIVE-CL> (primitive-invoke *tmp* :is-equal :int *tmp2*) +1 +OBJECTIVE-CL> (primitive-invoke *tmp* :is-equal :long *tmp2*) +1 +OBJECTIVE-CL> (primitive-invoke *tmp* :is-equal :long-long *tmp2*) +4294967296 + +Now, I see why the last value is bogus (I'd be surprised if it weren't, +actually), but why the heck is the correct value (1, because, you see, +the strings *are* equal and +YES+ is 1 on my machine) returned only for +the wrong return type? The return type is specified as `c', but it's +actually an int! What's going on here? And rather more importantly: +What can I do about this? I don't feel exactly comfortable about +cheating and treating `c' as specifying an int on all systems based on +the NeXT runtime without having any indication about what else there is +in the NeXT runtime that has to be special-cased. I haven't seen this +weird behaviour documented anywhere. Even this specific case is +non-trivial, for I don't know whether this applies to all chars, or only +to chars that are booleans, or only to chars that are returned, or even +only to chars that are returned *and* are actually booleans. + + * 2007-09-26, 00:13:11 CEST ** Licensing diff --git a/Lisp/internal-utilities.lisp b/Lisp/internal-utilities.lisp index 1a117f8..6578971 100644 --- a/Lisp/internal-utilities.lisp +++ b/Lisp/internal-utilities.lisp @@ -23,6 +23,10 @@ `(progn ,@body)) +(defun featurep (symbol) + (member symbol *features*)) + + (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 6169a59..8f80621 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -298,7 +298,7 @@ easier to use with __apply__. (method-return-typestring (primitive-invoke signature 'method-return-type :string)) - (method-return-type (parse-typespec method-return-typestring)) + (method-return-type (parse-typespec method-return-typestring t)) (method-arg-typestrings (loop for x from 0 below argc collect (primitive-invoke signature diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index b8ac773..c3e6e5a 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -96,7 +96,8 @@ "Klum."))) ((ensure-same +yes+ (primitive-invoke (find-objc-class 'ns-string) - :is-subclass-of-class :char + :is-subclass-of-class + (first (parse-typespec "c" t)) (find-objc-class 'ns-object)))) ;; performSelector:withObject: cannot be used with non-id return ;; types. @@ -169,13 +170,9 @@ '(pointer () (array () 100 (struct () "?" (:int ()) (:int ())))))) - ((ensure-same (parse-typespec "{?=BcCsSiIlLqQfd@#:*?}") + ((ensure-same (parse-typespec "{?=BiIlLqQfd@#:*?}") '(struct () "?" (:boolean ()) - (:char ()) - (:unsigned-char ()) - (:short ()) - (:unsigned-short ()) (:int ()) (:unsigned-int ()) (:long ()) @@ -187,6 +184,24 @@ (id ()) (objc-class ()) (selector ()) (:string ()) (:unknown ())))) + ((ensure (let ((funky-spec (parse-typespec "{?=cC}"))) + (member funky-spec + '((struct () "?" + (:char ()) + (:unsigned-char ())) + (struct () "?" + (:int ()) + (:unsigned-int ()))) + :test #'equalp)))) + ((ensure (let ((funky-spec (parse-typespec "{?=sS}"))) + (member funky-spec + '((struct () "?" + (:short ()) + (:unsigned-short ())) + (struct () "?" + (:int ()) + (:unsigned-int ()))) + :test #'equalp)))) ((ensure-same (parse-typespec "{Mulk=*{Untermulk={Unteruntermulk=}}i}") '(struct () "Mulk" (:string ()) diff --git a/Lisp/type-handling.lisp b/Lisp/type-handling.lisp index 152a016..abee5ae 100644 --- a/Lisp/type-handling.lisp +++ b/Lisp/type-handling.lisp @@ -18,7 +18,7 @@ (in-package #:mulk.objective-cl) -(defun parse-typespec (typestring &optional (start 0)) +(defun parse-typespec (typestring &optional return-type-p (start 0)) "Parse a typestring like \"@0:4{_NSRange=II}8\" into something like (ID ()). \"rn{_NSRange=II}8\" is parsed into (STRUCT (CONST IN) @@ -79,6 +79,7 @@ Returns: (VALUES typespec byte-position string-position)" new-string-pos) (parse-typespec typestring + nil string-position) (declare (ignore byte-position)) (setq string-position new-string-pos) @@ -88,7 +89,9 @@ Returns: (VALUES typespec byte-position string-position)" (#\^ (list 'pointer qualifiers (multiple-value-bind (typespec byte-pos new-str-pos) - (parse-typespec typestring (1+ string-position)) + (parse-typespec typestring + nil + (1+ string-position)) (declare (ignore byte-pos)) (prog1 typespec (setq string-position new-str-pos))))) @@ -101,7 +104,7 @@ Returns: (VALUES typespec byte-position string-position)" (prog1 count (setq string-position new-str-pos))) (multiple-value-bind (typespec byte-pos new-str-pos) - (parse-typespec typestring string-position) + (parse-typespec typestring nil string-position) (declare (ignore byte-pos)) ;; Skip end marker (right bracket). (prog1 typespec @@ -110,7 +113,7 @@ Returns: (VALUES typespec byte-position string-position)" (list 'complex qualifiers (multiple-value-bind (typespec byte-pos new-str-pos) - (parse-typespec typestring (1+ string-position)) + (parse-typespec typestring nil (1+ string-position)) (declare (ignore byte-pos)) (prog1 typespec (setq string-position new-str-pos))))) @@ -126,7 +129,7 @@ Returns: (VALUES typespec byte-position string-position)" (multiple-value-setq (bit-field-typespec byte-position string-position) - (parse-typespec typestring string-position)) + (parse-typespec typestring nil string-position)) (multiple-value-setq (bit-field-length string-position) (parse-integer typestring :start string-position @@ -138,11 +141,31 @@ Returns: (VALUES typespec byte-position string-position)" bit-field-typespec))) (otherwise (prog1 (list (case init-char - (#\B :boolean) - (#\c :char) - (#\C :unsigned-char) - (#\s :short) - (#\S :unsigned-short) + (#\B :boolean) ;XXX :int? + (#\c (if (or return-type-p + (eq +runtime-type+ :gnu) + (and (eq +runtime-type+ :next) + (featurep 'cffi-features:ppc32))) + :int + :char)) + (#\C (if (or return-type-p + (eq +runtime-type+ :gnu) + (and (eq +runtime-type+ :next) + (featurep 'cffi-features:ppc32))) + :unsigned-int + :unsigned-char)) + (#\s (if (or return-type-p + (eq +runtime-type+ :gnu) + (and (eq +runtime-type+ :next) + (featurep 'cffi-features:ppc32))) + :int + :short)) + (#\S (if (or return-type-p + (eq +runtime-type+ :gnu) + (and (eq +runtime-type+ :next) + (featurep 'cffi-features:ppc32))) + :unsigned-int + :unsigned-short)) (#\i :int) (#\I :unsigned-int) (#\l :long) diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp index 5ead57a..a1b3c4e 100644 --- a/Lisp/utilities.lisp +++ b/Lisp/utilities.lisp @@ -152,12 +152,17 @@ invocations will return numbers.) (defun id-equal (x y) + ;; Note that we have to use INVOKE rather than PRIMITIVE-INVOKE here, + ;; because we don't know wheter BOOL == char. We don't even know + ;; whether the typespec "c" indicates a char or an int, for that + ;; matter (it only does so on NeXT/x86, but neither on GNUstep nor on + ;; NeXT/ppc32). (or (id-eql x y) (truep (if (typep x '(or id objc-class exception)) - (primitive-invoke x :is-equal :char y) + (invoke x :is-equal y) (progn (assert (typep y '(or id objc-class exception))) - (primitive-invoke y :is-equal :char x)))))) + (invoke y :is-equal x)))))) (defun objc-typep (x class-designator) |