git.fiddlerwoaroof.com
Browse code

fix: use objc_msgSend correctly

objc_msgSend is supposed to be cast to the appropriate function
pointer type, not just called like a normal function. Remove the FFI
wrappers around objc_msgSend and have the read-table generate
foreing-funcalls instead.

Edward Langley authored on 23/05/2023 05:52:42
Showing 2 changed files
objc-runtime.lisp
History View file @ 60bee14
... ... 
@@ -96,33 +96,15 @@
96 96 
     o-selector
97 97 
   (name :string))
98 98
99 
-(defcfun (objc-msg-send-int "objc_msgSend")
100 
-    :int
101 
-  (cls o-class)
102 
-  (sel o-selector)
103 
-  &rest)
104 
-
105 
-(defcfun (objc-msg-send-string "objc_msgSend")
106 
-    :string
107 
-  (cls o-class)
108 
-  (sel o-selector)
109 
-  &rest)
110 
-
111 
-(defcfun (objc-msg-send "objc_msgSend")
112 
-    :pointer
113 
-  (cls o-class)
114 
-  (sel o-selector)
115 
-  &rest)
116 
-
117 99 
 (defmacro safe-objc-msg-send (result-type thing selector &rest args)
118 100 
   (alexandria:once-only (thing selector)
119 101 
     `(if [,thing @(respondsToSelector:) :pointer ,selector]b
120 102 
          ,(ccase result-type
121 
-            (string `[,thing ,selector ,@args]s)
122 
-            (nsstring `[,thing ,selector ,@args]@)
123 
-            (num `[,thing ,selector ,@args]#)
124 
-            (bool `[,thing ,selector ,@args]b)
125 
-            (id `[,thing ,selector ,@args]))
103 
+            (:string `[,thing ,selector ,@args]s)
104 
+            (:nsstring `[,thing ,selector ,@args]@)
105 
+            (:pointer `[,thing ,selector ,@args])
106 
+            (:int `[,thing ,selector ,@args]#)
107 
+            (:bool `[,thing ,selector ,@args]b))
126 108 
          (error "invalid selector"))))
127 109
128 110 
 ;;; This is a macro, because objc-msg-send is a macro.... which makes "apply" impossible
readtable.lisp
History View file @ 60bee14
... ... 
@@ -21,25 +21,38 @@
21 21 
                               'string)))
22 22 
       `(,symbol-prefix ,class-name))))
23 23
24 
+(defmacro objc-send (obj message return &rest args)
25 
+  (let* ((return-t (case return
26 
+                     (:nsstring :pointer)
27 
+                     (t return)))
28 
+         (result `(cffi:foreign-funcall "objc_msgSend"
29 
+                                        :pointer ,obj
30 
+                                        :pointer ,message
31 
+                                        ,@args
32 
+                                        ,return-t)))
33 
+    (case return
34 
+      (:nsstring `(objc-send ,result
35 
+                             (ensure-selector "UTF8String")
36 
+                             :string))
37 
+      (t result))))
38 
+
24 39 
 (defun read-objc-form (s char)
25 40 
   (declare (ignore char))
26 
-  (flet ((get-call-form (safe-p result-type base-form)
27 
-           (if safe-p
28 
-               `(safe-objc-msg-send ,result-type)
29 
-               `(,base-form))))
30 
-    (let* ((info (read-delimited-list #\] s t))
31 
-           (safe-p (when (eql #\? (peek-char nil s nil #\p t))
32 
-                     (read-char s t nil t)))
33 
-           (msg-send (case (peek-char nil s nil #\p t)
34 
-                       (#\# (read-char s t nil t) (get-call-form safe-p 'num 'objc-msg-send-int))
35 
-                       (#\& (read-char s t nil t) (get-call-form safe-p 'id 'objc-msg-send))
36 
-                       (#\@ (read-char s t nil t) (get-call-form safe-p 'nsstring 'objc-msg-send-nsstring))
37 
-                       (#\b (read-char s t nil t) (get-call-form safe-p 'bool 'objc-msg-send-bool))
38 
-                       (#\s (read-char s t nil t) (get-call-form safe-p 'string 'objc-msg-send-string))
39 
-                       (t                         (get-call-form safe-p 'id 'objc-msg-send)))))
40 
-      (when info
41 
-        (destructuring-bind (obj message . args) info
42 
-          `(,@msg-send ,obj ,message ,@args))))))
41 
+  (let* ((info (read-delimited-list #\] s t))
42 
+         (safe-p (when (eql #\? (peek-char nil s nil #\p t))
43 
+                   (read-char s t nil t)))
44 
+         (return-t (case (peek-char nil s nil #\p t)
45 
+                     (#\# (read-char s t nil t) :int)
46 
+                     (#\& (read-char s t nil t) :pointer)
47 
+                     (#\@ (read-char s t nil t) :nsstring)
48 
+                     (#\b (read-char s t nil t) :bool)
49 
+                     (#\s (read-char s t nil t) :string)
50 
+                     (t                         :pointer))))
51 
+    (when info
52 
+      (destructuring-bind (obj message . args) info
53 
+        (if safe-p
54 
+            `(safe-objc-msg-send ,return-t ,obj ,message ,@args)
55 
+            `(objc-send ,obj ,message ,return-t ,@args))))))
43 56
44 57 
 (named-readtables:defreadtable :objc-readtable
45 58 
   (:merge :standard)