Changeset 12591


Ignore:
Timestamp:
Aug 16, 2009, 9:26:07 PM (10 years ago)
Author:
gb
Message:

In DEFCALLBACK-BODY: don't use a temporary for the result (except
in the struct-return case, where it's hard to avoid.) If the callback
uses an ERROR-RETURN mechanism, do the foreign-result-return inside
the body of the handler (so that the foreign result doesn't have to
be boxed during unwinding.)

Both of these changes are intended to reduce incidental consing in
callbacks.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/macros.lisp

    r12575 r12591  
    26652665  (destructuring-bind (stack-ptr fp-args-ptr lets rlets inits dynamic-extent-decls other-decls body return-type struct-return-arg error-return error-delta) args
    26662666    (declare (ignorable dynamic-extent-decls))
    2667     (let* ((result (gensym))
    2668            (condition-name (if (atom error-return) 'error (car error-return)))
     2667    (let* ((condition-name (if (atom error-return) 'error (car error-return)))
    26692668           (error-return-function (if (atom error-return) error-return (cadr error-return)))
     2669           (result (if struct-return-arg (gensym)))
    26702670           (body
    26712671            `(rlet ,rlets
     
    26742674                ,@other-decls
    26752675                ,@inits
    2676                 (let ((,result (progn ,@body)))
    2677                   (declare (ignorable ,result)
    2678                            (dynamic-extent ,result))
    2679 
    2680                   ,(funcall (ftd-callback-return-value-function *target-ftd*)
    2681                             stack-ptr
    2682                             fp-args-ptr
    2683                             result
    2684                             return-type
    2685                             struct-return-arg)
    2686                   nil)))))
     2676                ,(if result
     2677                     `(let* ((,result ,@body))
     2678                       (declare (dynamic-extent ,result)
     2679                                (ignorable ,result))
     2680                       ,(funcall (ftd-callback-return-value-function *target-ftd*)
     2681                              stack-ptr
     2682                              fp-args-ptr
     2683                              result
     2684                              return-type
     2685                              struct-return-arg))
     2686                     (if (eq return-type *void-foreign-type*)
     2687                       `(progn ,@body)
     2688                       (funcall (ftd-callback-return-value-function *target-ftd*)
     2689                                stack-ptr
     2690                                fp-args-ptr
     2691                                `(progn ,@body)
     2692                                return-type
     2693                                struct-return-arg)))
     2694                nil))))
    26872695      (if error-return
    26882696        (let* ((cond (gensym))
     
    26912699          `(block ,block
    26922700            (let* ((,handler (lambda (,cond)
    2693                                            (,error-return-function ,cond ,stack-ptr (%inc-ptr ,stack-ptr ,error-delta))
    2694                                            (return-from ,block
    2695                                              nil))))
     2701                               (,error-return-function ,cond ,stack-ptr (%inc-ptr ,stack-ptr ,error-delta))
     2702                               (return-from ,block
     2703                                 nil))))
    26962704              (declare (dynamic-extent ,handler))
    2697             (handler-bind ((,condition-name ,handler))
    2698               (values ,body)))))
     2705              (handler-bind ((,condition-name ,handler))
     2706                (values ,body)))))
    26992707        body))))
    27002708
Note: See TracChangeset for help on using the changeset viewer.