[Openmcl-devel] Getting a double-float from ObjC

[Gary Byers]

The problem seems to be a buggy version of REQUIRES-STRET-P.  Randall
Beer fixed this a few months ago, but I'd neglected to merge the fix
into the main CVS tree.

It's there now.

On Sun, 13 Jun 2004, Sebastian Nozzi wrote:

>
> I seem to be doing just what you did and what you said, but it still
> complains (?!?!) that I have to use send/stret. I know I shouldn't, I
> just can't see what I'm doing wrong.
>
> Gary Byers wrote:
>
> > It's indeed exactly the same as calling a C function that returns a
> > DOUBLE-FLOAT,
>
> It should, yes.
>
> > ? (send
> >     (send (@class "NSDate") :date-with-time-interval-since-now 10000.0d0)
> >     'time-interval-since-reference-date)
> > 1.087937955145176D+8
>
> I copy-pasted the code above and still got the error.
>
> > SEND/STRET only really applies when the method in question is declared
> > to return a structure (e.g., an :<NSR>ect, an :<NSR>ange, ...)
>
-------------- next part --------------
Index: examples/bridge.lisp
===================================================================
RCS file: /usr/local/tmpcvs/ccl-0.14/ccl/examples/bridge.lisp,v
retrieving revision 1.3
diff -u -r1.3 bridge.lisp
--- examples/bridge.lisp	10 Feb 2004 21:27:25 -0000	1.3
+++ examples/bridge.lisp	13 Jun 2004 03:11:41 -0000
@@ -185,15 +185,28 @@
       m)))
 
 
+;;; For some reason, these types sometimes show up as :STRUCTs even though they
+;;; are not structure tags, but type names
+
+(defun fudge-objc-type (ftype)
+  (if (equal ftype '(:STRUCT :<NSD>ecimal))
+      :<NSD>ecimal
+    ftype))
+
+
 ;;; Returns T if the result spec requires a STRET for its return, NIL otherwise
 ;;; RSPEC may be either a number (in which case it is interpreted as a number
 ;;; of words) or a foreign type spec acceptable to PARSE-FOREIGN-TYPE. STRETS
 ;;; must be used when a structure larger than 4 bytes is returned
 
 (defun requires-stret-p (rspec)
+  (when (member rspec '(:DOUBLE-FLOAT :UNSIGNED-DOUBLEWORD :SIGNED-DOUBLEWORD) 
+		:test #'eq)
+    (return-from requires-stret-p nil))
+  (setq rspec (fudge-objc-type rspec))
   (if (numberp rspec) 
     (> rspec 1)
-    (> (ensure-foreign-type-bits (parse-foreign-type rspec)) 32)))
+    (> (ensure-foreign-type-bits (parse-foreign-type rspec)) 32))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;