Changeset 7818


Ignore:
Timestamp:
Dec 4, 2007, 10:07:58 PM (13 years ago)
Author:
rme
Message:

Incomplete, mostly worthless.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/lib/ffi-darwinx8632.lisp

    r7787 r7818  
    11(in-package "CCL")
    22
    3 ;;; On Darwin/IA-32, when a function returns a structure or union
    4 ;;; larger than 8 bytes, the caller passes a pointer to
    5 ;;; appropriate storage as the first argument to the function.
     3;;; When a function returns a structure or union larger than 8 bytes,
     4;;; the caller passes a pointer to appropriate storage as the first
     5;;; argument to the function.
    66(defun x86-darwin32::record-type-returns-structure-as-first-arg (rtype)
    77  (when (and rtype
     
    1313                    (parse-foreign-type rtype))))
    1414      (> (ensure-foreign-type-bits ftype) 64))))
     15
    1516
    1617;;; All arguments are passed on the stack, except for MMX and XMM
     
    6768          (argforms (foreign-type-to-representation-type result-type))
    6869          (let* ((call (funcall result-coerce result-type-spec `(,@callform ,@(argforms)))))
    69             (format t "~&call = ~s" call)
     70            ;;(format t "~&call = ~s" call)
    7071            call)))))
    7172
     
    8081;;; The byte offset of the foreign return address, relative to STACK-PTR
    8182
    82 (defun x86-darwin32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name)
     83(defun x86-darwin32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)
     84  (declare (ignore fp-args-ptr))
     85  (collect ((lets)
     86            (rlets)
     87            (inits)
     88            (dynamic-extent-names))
     89    (let* ((rtype (parse-foreign-type result-spec)))
     90      (when (typep rtype 'foreign-record-type)
     91        (if (x86-darwin32::record-type-returns-structure-as-first-arg rtype)
     92          (setq argvars (cons struct-result-name argvars)
     93                argspecs (cons :address argspecs)
     94                rtype *void-foreign-type*)
     95          (rlets (list struct-result-name (foreign-record-type-name rtype)))))
     96      (do* ((argvars argvars (cdr argvars))
     97            (argspecs argspecs (cdr argspecs))
     98            (delta 4 4)
     99            (offset 0 (+ offset delta)))
     100           ((null argvars)
     101            (values (rlets) (lets) (dynamic-extent-names) (inits) rtype nil 4)))))
     102       
    83103  (format t "~&in generate-callback-bindings")
    84104  )
    85105
    86106(defun x86-darwin32::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg)
     107  (declare (ignore fp-args-ptr))
    87108  (format t "~&in generate-callback-return-value")
    88   )
     109  (unless (eq return-type *void-foreign-type*)
     110    (if (typep return-type 'foreign-record-type)
     111      ;; Would have been mapped to :VOID unless record-type was <= 64 bits
     112      (format t "~&need to return structure ~s by value" return-type)
     113      (let* ((return-type-keyword (foreign-type-to-representation-type return-type)))
     114        `(setf (,
     115                (case return-type-keyword
     116                  (:address '%get-ptr)
     117                  (:signed-doubleword '%%get-signed-longlong)
     118                  (:unsigned-doubleword '%%get-unsigned-longlong)
     119                  (:double-float '%get-double-float)
     120                  (:single-float '%get-single-float)
     121                  (:unsigned-fullword '%get-unsigned-long)
     122                  (t '%get-signed-long)
     123                  ) ,stack-ptr 0) ,result)))))
     124
Note: See TracChangeset for help on using the changeset viewer.