Changeset 10519 for trunk/source/library

Aug 22, 2008, 12:53:55 PM (11 years ago)

Recognize "transparent unions" (unions with a specified attribute);
we treat them as a separate kind of foreign-record-type, but it'd
also work to treat them as unions with a bit set somewhere.

A transparent union is just like a union in all contexts except
the case where it's passed by value to a foreign function; in that
case, things behave as if the union's first field was passed. (For
this to work, all fields must be the same size and be of types
that're passed by the same calling conventions.)

Linux uses transparent unions for a few types in socket-related
functions (so we'll have to support them when we switch l1-sockets
to use foreign-function calls instead of syscalls.) Other platforms
don't seem to use them in their standard headers (but we should
probably support the concept, just in case.)

Getting information about transparent unions into the interface
database requires changes to the ffi translator; the changes
here (mostly) deal with encoding that info to and decoding it
from the .cdb files.

1 edited


  • trunk/source/library/parse-ffi.lisp

    r10045 r10519  
    4444(defvar *ffi-unions*)
    4545(defvar *ffi-global-unions* nil)
     46(defvar *ffi-transparent-unions* nil)
     47(defvar *ffi-global-transparent-unions* nil)
    4648(defvar *ffi-structs*)
    4749(defvar *ffi-global-structs* nil)
    7375                            :name (unless (digit-char-p (schar string 0))
    7476                                    (escape-foreign-name string))))))
     78(defun find-or-create-ffi-transparent-union (string)
     79  (or (gethash string *ffi-transparent-unions*)
     80      (setf (gethash string *ffi-transparent-unions*)
     81            (make-ffi-transparent-union :string string
     82                                        :name (unless (digit-char-p (schar string 0))
     83                                                (escape-foreign-name string))))))
    7685(defun find-or-create-ffi-objc-class (string)
    358367    (:struct-ref (list :struct (find-or-create-ffi-struct (cadr spec))))
    359368    (:union-ref (list :union (find-or-create-ffi-union (cadr spec))))
     369    (:transparent-union-ref
     370     (list :transparent-union (find-or-create-ffi-transparent-union (cadr spec))))
    360371    (:enum-ref `(:primitive :signed))
    361372    (:function `(:primitive (* t)))
    425436      union)))
     438(defun process-ffi-transparent-union (form)
     439  (destructuring-bind (source-info string fields &optional alignform)
     440      (cdr form)
     441    (declare (ignore source-info))
     442    (let* ((union (find-or-create-ffi-transparent-union string)))
     443      (setf (ffi-transparent-union-ordinal union) (incf *ffi-ordinal*))
     444      (when alignform
     445        (setf (ffi-transparent-union-alt-alignment-bits union) (cadr alignform)))
     446      (unless (ffi-transparent-union-fields union)
     447        (setf (ffi-transparent-union-fields union)
     448              (process-ffi-fieldlist fields)))
     449      union)))
    427451(defun process-ffi-struct (form)
    428452  (destructuring-bind (source-info string fields &optional alignform)
    541565    (:struct (ensure-struct-defined (cadr spec)))
    542566    (:union (ensure-union-defined (cadr spec)))
     567    (:transparent-union (ensure-transparent-union-defined (cadr spec)))
    543568    (:pointer (ensure-referenced-type-defined (cadr spec)))
    544569    (:array (ensure-referenced-type-defined (caddr spec)))
    567592  (when *ffi-global-unions*
    568593    (setf (gethash (ffi-union-reference u) *ffi-global-unions*) u)))
     595(defun record-global-transparent-union (u)
     596  (when *ffi-global-transparent-unions*
     597    (setf (gethash (ffi-transparent-union-reference u) *ffi-global-transparent-unions*) u)))
    570599(defun define-union-from-ffi-info (u)
    576605        (ensure-fields-defined fields)))))
     607(defun define-transparent-union-from-ffi-info (u)
     608  (unless (ffi-transparent-union-defined u)
     609    (setf (ffi-transparent-union-defined u) t)
     610    (record-global-transparent-union u)
     611    (when (ffi-transparent-union-name u)
     612      (let* ((fields (ffi-transparent-union-fields u)))
     613        (ensure-fields-defined fields)))))
    578615(defun ensure-union-defined (u)
    579616  (let* ((name (ffi-union-name u)))
    581618      (define-union-from-ffi-info u)
    582619      (ensure-fields-defined (ffi-union-fields u)))))
     621(defun ensure-transparent-union-defined (u)
     622  (let* ((name (ffi-transparent-union-name u)))
     623    (if name
     624      (define-transparent-union-from-ffi-info u)
     625      (ensure-fields-defined (ffi-transparent-union-fields u)))))
    584627(defun record-global-struct (s)
    610653    (let* ((target (ffi-typedef-type def)))
    611654      (unless (and (consp target)
    612                    (member (car target) '(:struct :union :primitive)))
     655                   (member (car target) '(:struct :union :transparent-union :primitive)))
    613656        (ensure-referenced-type-defined target)))))
    630673(defun ffi-record-type-p (typeref)
    631674  (case (car typeref)
    632     ((:struct :union) t)
     675    ((:struct :union :transparent-union) t)
    633676    (:typedef (ffi-record-type-p (ffi-typedef-type (cadr typeref))))
    634677    (t nil)))
    659702  (let* ((*ffi-typedefs* (make-hash-table :test 'string= :hash-function 'sxhash))
    660703         (*ffi-unions* (make-hash-table :test 'string= :hash-function 'sxhash))
     704         (*ffi-transparent-unions* (make-hash-table :test 'string= :hash-function 'sxhash))
    661705         (*ffi-structs* (make-hash-table :test 'string= :hash-function 'sxhash))
    662706         (*ffi-objc-classes* (make-hash-table :test 'string= :hash-function 'sxhash))
    691735                (:enum-ident (push (process-ffi-enum-ident form) defined-constants))
    692736                (:enum (process-ffi-enum form))
    693                 (:union (push (process-ffi-union form) defined-types)))))
     737                (:union (push (process-ffi-union form) defined-types))
     738                (:transparent-union (push (process-ffi-transparent-union form) defined-types)))))
    694739          (multiple-value-bind (new-constants new-macros)
    695740              (process-defined-macros defined-macros (reverse defined-constants) argument-macros)
    706751                (ffi-struct (define-struct-from-ffi-info x))
    707752                (ffi-union (define-union-from-ffi-info x))
     753                (ffi-transparent-union (define-transparent-union-from-ffi-info x))
    708754                (ffi-typedef (define-typedef-from-ffi-info x))
    709755                (ffi-objc-class (define-objc-class-from-ffi-info x))))
    725771         (*ffi-global-typedefs* (make-hash-table :test 'string= :hash-function 'sxhash))
    726772         (*ffi-global-unions* (make-hash-table :test 'string= :hash-function 'sxhash))
     773         (*ffi-global-transparent-unions* (make-hash-table :test 'string= :hash-function 'sxhash))
    727774         (*ffi-global-structs* (make-hash-table :test 'string= :hash-function 'sxhash))
    728775         (*ffi-global-objc-classes* (make-hash-table :test 'string= :hash-function 'sxhash))
    757804                   (save-ffi-union records-cdbm def))
    758805               *ffi-global-unions*)
     806      (maphash #'(lambda (name def)
     807                   (declare (ignore name))
     808                   (save-ffi-transparent-union records-cdbm def))
     809               *ffi-global-transparent-unions*)
    759811      (maphash #'(lambda (name def)
    760812                   (declare (ignore name))
Note: See TracChangeset for help on using the changeset viewer.