summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--JOURNAL67
-rw-r--r--Lisp/internal-utilities.lisp4
-rw-r--r--Lisp/method-invocation.lisp2
-rw-r--r--Lisp/tests.lisp27
-rw-r--r--Lisp/type-handling.lisp43
-rw-r--r--Lisp/utilities.lisp9
6 files changed, 133 insertions, 19 deletions
diff --git a/JOURNAL b/JOURNAL
index 972a92a..a4741ee 100644
--- a/JOURNAL
+++ b/JOURNAL
@@ -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)