Changeset 2526

Show
Ignore:
Timestamp:
02/18/08 09:38:51 (9 months ago)
Author:
hhubner
Message:

fix :pointer-self for unions

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp

    r2519 r2526  
    6868  ) 
    6969 
    70 (defun process-struct-fields (name fields &optional (variant nil)) 
     70(defun process-aggregate-fields (name fields &key (variant nil) (aggregate-type :struct)) 
    7171  (let (processed) 
    7272    (dolist (field fields) 
    …… 
    7474             (type (cadr field)) 
    7575             (def (append (list field-name) 
    76                           (if (eq type :pointer-self) 
    77                               #+(or cmu scl) `((* (alien:struct ,name))) 
    78                               #+sbcl `((* (sb-alien:struct ,name))) 
    79                               #+(or openmcl digitool) `((:* (:struct ,name))) 
    80                               #+lispworks `((:pointer ,name)) 
    81                               #-(or cmu sbcl scl openmcl digitool lispworks) `((* ,name)) 
    82                               `(,(convert-from-uffi-type type :struct)))))) 
     76                          (if (eq type :pointer-self) 
     77                            (ecase aggregate-type 
     78                              (:struct  
     79                               #+(or cmu scl) `((* (alien:struct ,name))) 
     80                               #+sbcl `((* (sb-alien:struct ,name))) 
     81                               #+(or openmcl digitool) `((:* (:struct ,name))) 
     82                               #+lispworks `((:pointer ,name)) 
     83                               #-(or cmu sbcl scl openmcl digitool lispworks) `((* ,name))) 
     84                              (:union 
     85                               #+(or cmu scl) `((* (alien:union ,name))) 
     86                               #+sbcl `((* (sb-alien:union ,name))) 
     87                               #+(or openmcl digitool) `((:* (:union ,name))) 
     88                               #+lispworks `((:pointer ,name)) 
     89                               #-(or cmu sbcl scl openmcl digitool lispworks) `((* ,name)))) 
     90                            `(,(convert-from-uffi-type type aggregate-type)))))) 
    8391        (if variant 
    8492            (push (list def) processed) 
    85          (push def processed)))) 
     93            (push def processed)))) 
    8694    (nreverse processed))) 
    8795         
    …… 
    8997(defmacro def-struct (name &rest fields) 
    9098  #+(or cmu scl) 
    91   `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-fields name fields))) 
    92   #+sbcl 
    93   `(sb-alien:define-alien-type ,name (sb-alien:struct ,name ,@(process-struct-fields name fields))) 
    94   #+allegro 
    95   `(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields))) 
    96   #+lispworks 
    97   `(fli:define-c-struct ,name ,@(process-struct-fields name fields)) 
    98   #+digitool 
    99   `(ccl:defrecord ,name ,@(process-struct-fields name fields)) 
     99  `(alien:def-alien-type ,name (alien:struct ,name ,@(process-aggregate-fields name fields))) 
     100  #+sbcl 
     101  `(sb-alien:define-alien-type ,name (sb-alien:struct ,name ,@(process-aggregate-fields name fields))) 
     102  #+allegro 
     103  `(ff:def-foreign-type ,name (:struct ,@(process-aggregate-fields name fields))) 
     104  #+lispworks 
     105  `(fli:define-c-struct ,name ,@(process-aggregate-fields name fields)) 
     106  #+digitool 
     107  `(ccl:defrecord ,name ,@(process-aggregate-fields name fields)) 
    100108  #+openmcl 
    101109  `(ccl::def-foreign-type 
    102110    nil  
    103     (:struct ,name ,@(process-struct-fields name fields))) 
     111    (:struct ,name ,@(process-aggregate-fields name fields))) 
    104112  ) 
    105113 
    …… 
    193201(defmacro def-union (name &rest fields) 
    194202  #+allegro 
    195   `(ff:def-foreign-type ,name (:union ,@(process-struct-fields name fields))) 
    196   #+lispworks 
    197   `(fli:define-c-union ,name ,@(process-struct-fields name fields)) 
    198   #+(or cmu scl) 
    199   `(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields))) 
    200   #+sbcl 
    201   `(sb-alien:define-alien-type ,name (sb-alien:union ,name ,@(process-struct-fields name fields))) 
    202   #+digitool 
    203   `(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t))) 
     203  `(ff:def-foreign-type ,name (:union ,@(process-aggregate-fields name fields 
     204                                                                  :aggregate-type :union))) 
     205  #+lispworks 
     206  `(fli:define-c-union ,name ,@(process-aggregate-fields name fields 
     207                                                         :aggregate-type :union)) 
     208  #+(or cmu scl) 
     209  `(alien:def-alien-type ,name (alien:union ,name ,@(process-aggregate-fields name fields 
     210                                                                              :aggregate-type :union))) 
     211  #+sbcl 
     212  `(sb-alien:define-alien-type ,name (sb-alien:union ,name ,@(process-aggregate-fields name fields 
     213                                                                                       :aggregate-type :union))) 
     214  #+digitool 
     215  `(ccl:defrecord ,name (:variant ,@(process-aggregate-fields name fields 
     216                                                              :variant t 
     217                                                              :aggregate-type :union))) 
    204218  #+openmcl 
    205219  `(ccl::def-foreign-type nil  
    206                           (:union ,name ,@(process-struct-fields name fields))) 
    207 ) 
     220    (:union ,name ,@(process-aggregate-fields name fields 
     221                                              :aggregate-type :union))) 
     222  ) 
    208223 
    209224