Changeset 10519 for trunk/source/library


Ignore:
Timestamp:
Aug 22, 2008, 12:53:55 PM (11 years ago)
Author:
gb
Message:

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.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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))))))
     77
     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))))))
    7584
    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)))
    426437
     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)))
     450
    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)))
     594
     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)))
    569598
    570599(defun define-union-from-ffi-info (u)
     
    576605        (ensure-fields-defined fields)))))
    577606
     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)))))
     614
    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)))))
     620
     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)))))
    583626
    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)))))
    614657
     
    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*)
     810                         
    759811      (maphash #'(lambda (name def)
    760812                   (declare (ignore name))
Note: See TracChangeset for help on using the changeset viewer.