[Openmcl-cvs-notifications] r11197 - /trunk/source/library/parse-ffi.lisp

[gb at clozure.com]

Author: gb
Date: Wed Oct 22 01:21:39 2008
New Revision: 11197

Log:
Handle cast to pointer types.
(Hopefully) handle cases where a macro expands into the name of a
parameterized macro, e.g.

{{{
/* given */
#defun foo(x,y,z) (x+y+z)
#defun bar foo

bar(1,2,3) should expand to 6
}}}

Modified:
    trunk/source/library/parse-ffi.lisp

Modified: trunk/source/library/parse-ffi.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/library/parse-ffi.lisp (original)
+++ trunk/source/library/parse-ffi.lisp Wed Oct 22 01:21:39 2008
@@ -307,14 +307,20 @@
                   (c::- (- a b))
                   (c::\| (logior a b))
                   (c::\& (logand a b))
-                  (c::cast (if (foreign-typep b a)
+                  (c::cast (if (foreign-typep (setq b (eval-parsed-c-expre=
ssion b constant-alist)) a)
                              b
                              (if (and (typep a 'foreign-integer-type)
                                       (not (foreign-integer-type-signed a))
                                       (typep b 'integer)
                                       (not (> (integer-length b)
                                               (foreign-integer-type-bits a=
))))
-                               (logand b (1- (ash 1 (foreign-integer-type-=
bits a)))))))
+                               (logand b (1- (ash 1 (foreign-integer-type-=
bits a))))
+                               (if (and (typep a 'foreign-pointer-type)
+                                        (typep b 'integer)
+                                        (<=3D (integer-length b) 16))
+                                 (progn                                   =

+                                   (%int-to-ptr (logand b #xffffffff)))))))
+                               =

                                            =

                   (t =

 		   ;(break "binary op =3D ~s ~s ~s" operator a b)
@@ -330,10 +336,14 @@
       1
       (progn
         (unless (ffi-macro-tokens macro)
-          (multiple-value-bind (tokens error) (ignore-errors (string-to-to=
kens string))
-            (if error
-              (setf (ffi-macro-disposition macro) :bad-tokenize)
-              (setf (ffi-macro-tokens macro) tokens))))
+          (let* ((transitive (gethash (ffi-macro-expansion macro) macro-ta=
ble)))
+            (if transitive
+              (setf (ffi-macro-tokens macro) transitive
+                    (gethash (ffi-macro-name macro) macro-table) transitiv=
e)
+              (multiple-value-bind (tokens error) (ignore-errors (string-t=
o-tokens string))
+                (if error
+                  (setf (ffi-macro-disposition macro) :bad-tokenize)
+                  (setf (ffi-macro-tokens macro) tokens))))))
         (unless (ffi-macro-expression macro)
           (let* ((tokens (ffi-macro-tokens macro)))
             (when tokens