Changeset 9150 in project


Ignore:
Timestamp:
03/04/08 01:13:04 (11 years ago)
Author:
hans
Message:

directfb: "better" memory management using finalizers, but currently not working too well :(

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/2/directfb/trunk/directfb.scm

    r9148 r9150  
    3030(define-extension directfb)
    3131(declare
    32  (export dfb-init dfb-create
    33          dfb-release dfb-set-cooperative-level dfb-create-surface
    34          dfb-enum-display-layers dfb-get-display-layer
    35          dfb-get-input-device dfb-create-event-buffer
    36          dfb-create-input-event-buffer
    37          dfb-create-image-provider dfb-create-video-provider dfb-create-font
     32 (export dfb-init dfb-create dfb-create*
     33         dfb-set-cooperative-level dfb-create-surface dfb-create-surface*
     34         dfb-enum-display-layers dfb-get-display-layer dfb-get-display-layer*
     35         dfb-get-input-device dfb-get-input-device*
     36         dfb-create-event-buffer dfb-create-event-buffer*
     37         dfb-create-input-event-buffer dfb-create-input-event-buffer*
     38         dfb-create-image-provider dfb-create-image-provider*
     39         dfb-create-video-provider dfb-create-video-provider*
     40         dfb-create-font dfb-create-font*
    3841
    3942         dfbs-get-capabilities dfbs-get-position dfbs-get-size
     
    4346         dfbs-blit dfbs-stretch-blit dfbs-set-drawing-flags dfbs-fill-rectangle
    4447         dfbs-draw-rectangle dfbs-draw-line dfbs-set-font dfbs-get-font
    45          dfbs-draw-string dfbs-draw-glyph dfbs-set-encoding
    46          dfbs-get-sub-surface dfbs-disable-acceleration dfbs-release-source
    47          dfbs-set-render-options dfbs-release
     48         dfbs-get-font* dfbs-draw-string dfbs-draw-glyph dfbs-set-encoding
     49         dfbs-get-sub-surface dfbs-get-sub-surface* dfbs-disable-acceleration
     50         dfbs-release-source dfbs-set-render-options
    4851
    4952         dfbid-get-id dfbid-get-description dfbid-get-keymap-entry
    50          dfbid-create-event-buffer dfbid-attach-event-buffer
     53         dfbid-create-event-buffer dfbid-create-event-buffer*
     54         dfbid-attach-event-buffer
    5155         dfbid-detach-event-buffer dfbid-get-key-state dfbid-get-modifiers
    5256         dfbid-get-lock-state dfbid-get-buttons dfbid-get-button-state
    53          dfbid-get-axis dfbid-get-xy dfbid-release
     57         dfbid-get-axis dfbid-get-xy
    5458
    5559         dfbeb-reset dfbeb-wait-for-event dfbeb-wait-for-event-with-timeout
    5660         dfbeb-get-event dfbeb-peek-event dfbeb-has-event dfbeb-post-event
    57          dfbeb-wake-up dfbeb-create-file-descriptor dfbeb-release
     61         dfbeb-wake-up dfbeb-create-file-descriptor
    5862         dfbeb-wait/get-event
    5963
    60          dfbip-get-surface-description dfbip-render-to dfbip-release
     64         dfbip-get-surface-description dfbip-render-to
    6165
    6266         dfbvp-get-capabilities dfbvp-get-surface-description
     
    6872         dfbvp-set-stream-attributes dfbvp-set-audio-outputs
    6973         dfbvp-get-audio-outputs dfbvp-create-event-buffer
     74         dfbvp-create-event-buffer*
    7075         dfbvp-attach-event-buffer dfbvp-enable-events
    7176         dfbvp-disable-events dfbvp-detach-event-buffer
    72          dfbvp-release
    7377
    7478         dfbf-get-ascender dfbf-get-descender dfbf-get-height
    7579         dfbf-get-max-advance dfbf-get-kerning dfbf-get-string-width
    7680         dfbf-get-string-extents dfbf-get-glyph-extents dfbf-set-encoding
    77          dfbf-enum-encodings dfbf-find-encoding dfbf-release
     81         dfbf-enum-encodings dfbf-find-encoding
    7882         
    7983         print-dfb-struct)
     
    220224(eval-when (compile eval) (define dfb-directfb-interfaces '()))
    221225
    222 (define-macro (define-dfb-interface c-name scheme-name)
     226(define-macro (define-dfb-interface c-name scheme-name releaser-name)
    223227  (set! dfb-directfb-interfaces (cons (cons c-name scheme-name) dfb-directfb-interfaces))
    224   (let ((mksym (lambda (fmt . args) (string->symbol (apply sprintf fmt args)))))
    225     `(begin
    226        (define-record ,scheme-name pointer)
    227        (define-foreign-type ,scheme-name c-pointer
    228          ,(mksym "~a-pointer" scheme-name))
    229        (declare (export ,(mksym "~a?" scheme-name))))))
     228  (let ((mksym (lambda (fmt . args) (string->symbol (apply sprintf fmt args))))
     229        (g-inst (gensym 'inst)))
     230    (let ((ifc-pointer (mksym "~a-pointer" scheme-name))
     231          (ifc-pointer-set! (mksym "~a-pointer-set!" scheme-name))
     232          (ifc-parent (mksym "~a-parent" scheme-name))
     233          (ifc-parent-set! (mksym "~a-parent-set!" scheme-name))
     234          (ifc-prf (mksym "~a-parent-release-fn" scheme-name))
     235          (ifc-prf-set! (mksym "~a-parent-release-fn-set!" scheme-name))
     236          (ifc-addref (mksym "~a-add-ref!" scheme-name))
     237          (ifc-release (mksym "~a-release!" scheme-name)))
     238      `(begin
     239         (define-record ,scheme-name pointer parent parent-release-fn)
     240         (define-foreign-type ,scheme-name c-pointer ,ifc-pointer)
     241         (define (,ifc-addref ,g-inst)
     242           (print "add ref " ,g-inst)
     243           (flush-output)
     244           ($dfb$ ,c-name ,g-inst AddRef ()))
     245         (define (,ifc-release ,g-inst)
     246           (print "release ref " ,g-inst)
     247           (flush-output)
     248           ($dfb$ ,c-name ,g-inst Release ()))
     249         (define (,releaser-name ,g-inst)
     250           (when (,ifc-pointer ,g-inst)
     251             (,ifc-release ,g-inst)
     252             (,ifc-pointer-set! ,g-inst #f)
     253             (when (,ifc-parent ,g-inst)
     254               (when (,ifc-prf ,g-inst)
     255                 ((,ifc-prf ,g-inst) (,ifc-parent ,g-inst))
     256                 (,ifc-prf-set! ,g-inst #f))
     257               (,ifc-parent-set! ,g-inst #f))))
     258         (declare (export ,(mksym "~a?" scheme-name) ,releaser-name))))))
    230259
    231260(define-macro ($dfb$ type obj method args #!key (check-error #t) (safe #f))
     
    266295       (values ,@(map car letloc)))))
    267296
     297(define (wrap-finalizer fn fin)
     298  (lambda args
     299    (let ((result (apply fn args)))
     300      (and result
     301           (begin
     302             (set-finalizer! result fin)
     303             result)))))
     304
    268305
    269306;;; Interfaces
    270307
    271 (define-dfb-interface IDirectFB dfb-interface)
    272 (define-dfb-interface IDirectFBDisplayLayer dfbdl-interface)
    273 (define-dfb-interface IDirectFBSurface dfbs-interface)
    274 (define-dfb-interface IDirectFBInputDevice dfbid-interface)
    275 (define-dfb-interface IDirectFBEventBuffer dfbeb-interface)
    276 (define-dfb-interface IDirectFBImageProvider dfbip-interface)
    277 (define-dfb-interface IDirectFBVideoProvider dfbvp-interface)
    278 (define-dfb-interface IDirectFBFont dfbf-interface)
     308(define-dfb-interface IDirectFB dfb-interface dfb-release)
     309(define-dfb-interface IDirectFBDisplayLayer dfbdl-interface dfbdl-release)
     310(define-dfb-interface IDirectFBSurface dfbs-interface dfbs-release)
     311(define-dfb-interface IDirectFBInputDevice dfbid-interface dfbid-release)
     312(define-dfb-interface IDirectFBEventBuffer dfbeb-interface dfbeb-release)
     313(define-dfb-interface IDirectFBImageProvider dfbip-interface dfbip-release)
     314(define-dfb-interface IDirectFBVideoProvider dfbvp-interface dfbvp-release)
     315(define-dfb-interface IDirectFBFont dfbf-interface dfbf-release)
    279316
    280317
     
    284321  (dfb-check-error "DirectFBInit" ($ int DirectFBInit (c-pointer #f) (c-pointer #f))))
    285322
    286 (define (dfb-create)
     323(define (dfb-create*)
    287324  (let-location ((dfb c-pointer))
    288325    (dfb-check-error "DirectFBCreate" ($ int DirectFBCreate (c-pointer #$dfb)))
    289     (make-dfb-interface dfb)))
     326    (make-dfb-interface dfb #f #f)))
     327
     328(define dfb-create (wrap-finalizer dfb-create* dfb-release))
    290329
    291330
     
    409448;;; IDirectFB Interface
    410449
    411 (define (dfb-release dfb)
    412   (when (dfb-interface-pointer dfb)
    413     ($dfb$ IDirectFB dfb Release ())
    414     (dfb-interface-pointer-set! dfb #f)))
    415 
    416450(define (dfb-set-cooperative-level dfb level)
    417451  ($dfb$ IDirectFB dfb SetCooperativeLevel ((dfb-cooperative-level level))))
    418452
    419 (define (dfb-create-surface dfb . dsc)
     453(define (dfb-create-surface* dfb . dsc)
    420454  (let-location ((surf c-pointer))
    421455    (let ((dsc (if (null? (cdr dsc)) (car dsc) (apply make-dfbs-description dsc))))
    422456      ($dfb$ IDirectFB dfb CreateSurface ((dfbs-description dsc) (c-pointer #$surf))))
    423     (make-dfbs-interface surf)))
     457    (dfb-interface-add-ref! dfb)   
     458    (make-dfbs-interface surf dfb dfb-interface-release!)))
     459
     460(define dfb-create-surface (wrap-finalizer dfb-create-surface* dfbs-release))
    424461
    425462(define enumeration-result (make-parameter #f))
     
    456493    (reverse! (enumeration-result))))
    457494
    458 (define (dfb-get-display-layer dfb layer-id)
     495(define (dfb-get-display-layer* dfb layer-id)
    459496  (let-location ((dl c-pointer))
    460497    ($dfb$ IDirectFB dfb GetDisplayLayer ((dfbdl-id layer-id) (c-pointer #$dl)))
    461     (make-dfbdl-interface dl)))
    462 
    463 (define (dfb-get-input-device dfb device-id)
     498    (dfb-interface-add-ref! dfb)
     499    (make-dfbdl-interface dl dfb dfb-interface-release!)))
     500
     501(define dfb-get-display-layer
     502  (wrap-finalizer dfb-get-display-layer* dfbdl-release))
     503
     504(define (dfb-get-input-device* dfb device-id)
    464505  (let-location ((idev c-pointer))
    465506    ($dfb$ IDirectFB dfb GetInputDevice ((dfb-input-device-id device-id) (c-pointer #$idev)))
    466     (make-dfbid-interface idev)))
    467 
    468 (define (dfb-create-event-buffer dfb)
     507    (dfb-interface-add-ref! dfb)
     508    (make-dfbid-interface idev dfb dfb-interface-release!)))
     509
     510(define dfb-get-input-device
     511  (wrap-finalizer dfb-get-input-device* dfbid-release))
     512
     513(define (dfb-create-event-buffer* dfb)
    469514  (let-location ((eb c-pointer))
    470515    ($dfb$ IDirectFB dfb CreateEventBuffer ((c-pointer #$eb)))
    471     (make-dfbeb-interface eb)))
    472 
    473 (define (dfb-create-input-event-buffer dfb caps global)
     516    (dfb-interface-add-ref! dfb)
     517    (make-dfbeb-interface eb dfb dfb-interface-release!)))
     518
     519(define dfb-create-event-buffer
     520  (wrap-finalizer dfb-create-event-buffer* dfbeb-release))
     521
     522(define (dfb-create-input-event-buffer* dfb caps global)
    474523  (let-location ((eb c-pointer))
    475524    ($dfb$ IDirectFB dfb CreateInputEventBuffer
    476525           ((dfb-input-device-capabilities caps) (bool global) (c-pointer #$eb)))
    477     (make-dfbeb-interface eb)))
    478 
    479 (define (dfb-create-image-provider dfb filename)
     526    (dfb-interface-add-ref! dfb)
     527    (make-dfbeb-interface eb dfb dfb-interface-release!)))
     528
     529(define dfb-create-input-event-buffer
     530  (wrap-finalizer dfb-create-input-event-buffer* dfbeb-release))
     531
     532(define (dfb-create-image-provider* dfb filename)
    480533  (let-location ((iprov c-pointer))
    481534    ($dfb$ IDirectFB dfb CreateImageProvider ((nonnull-c-string filename) (c-pointer #$iprov)))
    482     (make-dfbip-interface iprov)))
    483 
    484 (define (dfb-create-video-provider dfb filename)
     535    (dfb-interface-add-ref! dfb)
     536    (make-dfbip-interface iprov dfb dfb-interface-release!)))
     537
     538(define dfb-create-image-provider
     539  (wrap-finalizer dfb-create-image-provider* dfbip-release))
     540
     541(define (dfb-create-video-provider* dfb filename)
    485542  (let-location ((vprov c-pointer))
    486543    ($dfb$ IDirectFB dfb CreateVideoProvider ((nonnull-c-string filename) (c-pointer #$vprov)))
    487     (make-dfbvp-interface vprov)))
    488 
    489 (define (dfb-create-font dfb filename desc)
     544    (dfb-interface-add-ref! dfb)
     545    (make-dfbvp-interface vprov dfb dfb-interface-release!)))
     546
     547(define dfb-create-video-provider
     548  (wrap-finalizer dfb-create-video-provider* dfbvp-release))
     549
     550(define (dfb-create-font* dfb filename desc)
    490551  (let-location ((font c-pointer))
    491552    ($dfb$ IDirectFB dfb CreateFont
    492553           ((nonnull-c-string filename) (dfb-font-description desc) (c-pointer #$font)))
    493     (make-dfbf-interface font)))
     554    (dfb-interface-add-ref! dfb)
     555    (make-dfbf-interface font dfb dfb-interface-release!)))
     556
     557(define dfb-create-font
     558  (wrap-finalizer dfb-create-font* dfbf-release))
    494559
    495560
     
    572637  ($dfb$ IDirectFBSurface surf SetFont ((dfbf-interface font))))
    573638
    574 (define (dfbs-get-font surf)
     639(define (dfbs-get-font* surf)
    575640  (let-location ((font c-pointer))
    576641    ($dfb$ IDirectFBSurface surf GetFont ((c-pointer #$font)))
    577     (make-dfbf-interface font)))
     642    (let ((dfb (dfbs-interface-parent surf)))
     643      (dfb-interface-add-ref! dfb)
     644      (make-dfbf-interface font dfb dfb-interface-release!))))
     645
     646(define dfbs-get-font
     647  (wrap-finalizer dfbs-get-font* dfbf-release))
    578648
    579649(define (dfbs-draw-string surf text x y flags)
     
    590660  ($dfb$ IDirectFBSurface surf SetEncoding ((dfb-text-encoding-id encoding))))
    591661
    592 (define (dfbs-get-sub-surface surf rect)
     662(define (dfbs-get-sub-surface* surf rect)
    593663  (let-location ((sub-surf c-pointer))
    594664    ($dfb$ IDirectFBSurface surf GetSubSurface
    595665           ((dfb-rectangle rect) (c-pointer #$sub-surf)))
    596     (make-dfbs-interface sub-surf)))
     666    ;; because in directfb a sub-surface keeps a reference to
     667    ;; its parent we can get away with keeping the main dfb reference
     668    ;; here which is good because dfbs-get-font* also assumes that
     669    ;; the parent of a surface is the main dfb object.
     670    (let ((dfb (dfbs-interface-parent surf)))
     671      (dfb-interface-add-ref! dfb)
     672      (make-dfbs-interface sub-surf dfb dfb-interface-release!))))
     673
     674(define dfbs-get-sub-surface
     675  (wrap-finalizer dfbs-get-sub-surface* dfbs-release))
    597676
    598677(define (dfbs-disable-acceleration surf mask)
     
    605684  ($dfb$ IDirectFBSurface surf SetRenderOptions ((dfbs-render-options options))))
    606685
    607 (define (dfbs-release surf)
    608   (when (dfbs-interface-pointer surf)
    609     ($dfb$ IDirectFBSurface surf Release ())
    610     (dfbs-interface-pointer-set! surf #f)))
    611 
    612686
    613687;;; IDirectFBInputDevice Interface
     
    622696  (error "implement me"))
    623697
    624 (define (dfbid-create-event-buffer idev)
     698(define (dfbid-create-event-buffer* idev)
    625699  (let-location ((eb c-pointer))
    626700    ($dfb$ IDirectFBInputDevice idev CreateEventBuffer ((c-pointer #$eb)))
    627     (make-dfbeb-interface eb)))
     701    (dfbid-interface-add-ref! idev)
     702    (make-dfbeb-interface eb idev dfbid-interface-release!)))
     703
     704(define dfbid-create-event-buffer
     705  (wrap-finalizer dfbid-create-event-buffer* dfbeb-release))
    628706
    629707(define (dfbid-attach-event-buffer idev eb)
     
    659737(define (dfbid-get-xy idev)
    660738  ($dfb$o IDirectFBInputDevice idev GetXY ((int $out$) (int $out$))))
    661 
    662 (define (dfbid-release idev)
    663   (when (dfbid-interface-pointer idev)
    664     ($dfb$ IDirectFBInputDevice idev Release ())
    665     (dfbid-interface-pointer-set! idev #f)))
    666739
    667740
     
    719792    fd))
    720793
    721 (define (dfbeb-release eb)
    722   (when (dfbeb-interface-pointer eb)
    723     ($dfb$ IDirectFBEventBuffer eb Release ())
    724     (dfbeb-interface-pointer-set! eb #f)))
    725 
    726794(define (dfbeb-wait/get-event eb)
    727795  (or (dfbeb-get-event eb)
     
    741809(define (dfbip-render-to ip surf rect)
    742810  ($dfb$ IDirectFBImageProvider ip RenderTo ((dfbs-interface surf) (dfb-rectangle rect))))
    743 
    744 (define (dfbip-release ip)
    745   (when (dfbip-interface-pointer ip)
    746     ($dfb$ IDirectFBImageProvider ip Release ())
    747     (dfbip-interface-pointer-set! ip #f)))
    748811
    749812
     
    843906  ($dfb$o IDirectFBVideoProvider vp GetAudioOutputs ((dfbvp-audio-units $out$))))
    844907
    845 (define (dfbvp-create-event-buffer vp)
     908(define (dfbvp-create-event-buffer* vp)
    846909  (let-location ((eb c-pointer))
    847910    ($dfb$ IDirectFBVideoProvider vp CreateEventBuffer ((c-pointer #$eb)))
    848     (make-dfbeb-interface eb)))
     911    (dfbvp-interface-add-ref! vp)
     912    (make-dfbeb-interface eb vp dfbvp-interface-release!)))
     913
     914(define dfbvp-create-event-buffer
     915  (wrap-finalizer dfbvp-create-event-buffer* dfbeb-release))
    849916
    850917(define (dfbvp-attach-event-buffer vp eb)
     
    859926(define (dfbvp-detach-event-buffer vp eb)
    860927  ($dfb$ IDirectFBVideoProvider vp DetachEventBuffer ((dfbeb-interface eb))))
    861 
    862 (define (dfbvp-release vp)
    863   (when (dfbvp-interface-pointer vp)
    864     ($dfb$ IDirectFBVideoProvider vp Release ())
    865     (dfbvp-interface-pointer-set! vp #f)))
    866928
    867929
     
    923985  ($dfb$o IDirectFBFont font FindEncoding
    924986          ((nonnull-c-string name) (dfb-text-encoding-id $out$))))
    925 
    926 (define (dfbf-release font)
    927   (when (dfbf-interface-pointer font)
    928     ($dfb$ IDirectFBFont font Release ())
    929     (dfbf-interface-pointer-set! font #f)))
Note: See TracChangeset for help on using the changeset viewer.