suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ffi/com: fix GC issue related to COM events

Browse Source
This commit is contained in:
Matthew Flatt 2012-04-04 06:59:55 -06:00
parent 8934b64beb
commit 522a92970e
1 changed files with 18 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/ffi/unsafe/com.rkt
View File

@ -479,6 +479,7 @@
[connection-point #:mutable] [connection-point #:mutable]
[connection-cookie #:mutable] [connection-cookie #:mutable]
[sink #:mutable] [sink #:mutable]
[sink-table-links #:mutable]
[types #:mutable] [types #:mutable]
[mref #:mutable]) [mref #:mutable])
#:property prop:equal+hash (list #:property prop:equal+hash (list
@ -590,6 +591,7 @@
#f #f
#f #f
#f #f
#f
(make-hash) (make-hash)
#f)) #f))
@ -1809,13 +1811,21 @@
(define (sink-make-scode v) (define (sink-make-scode v)
(malloc-immobile-cell v)) (malloc-immobile-cell v))
(define myssink-table (define myssink-table (cast (malloc _MYSSINK_TABLE 'atomic-interior)
(make-MYSSINK_TABLE sink-release-handler _pointer
sink-release-arg (_gcable _MYSSINK_TABLE-pointer)))
sink-apply (define sink-table-links
sink-variant-to-scheme ;; used to ensure that everything is retained long enough:
sink-unmarshal-scheme (list myssink-table
sink-make-scode)) sink-release-handler
sink-release-arg
sink-apply
sink-variant-to-scheme
sink-unmarshal-scheme
sink-make-scode))
(memcpy myssink-table
(apply make-MYSSINK_TABLE (cdr sink-table-links))
(ctype-sizeof _MYSSINK_TABLE))
(define (connect-com-object-to-event-sink obj) (define (connect-com-object-to-event-sink obj)
(or (com-object-connection-point obj) (or (com-object-connection-point obj)
@ -1847,6 +1857,7 @@
(set-com-object-connection-point! obj connection-point) (set-com-object-connection-point! obj connection-point)
(set-com-object-connection-cookie! obj cookie) (set-com-object-connection-cookie! obj cookie)
(set-com-object-sink! obj sink) (set-com-object-sink! obj sink)
(set-com-object-sink-table-links! obj sink-table-links)
(Release connection-point-container) (Release connection-point-container)
connection-point))) connection-point)))