cs and ffi/unsafe/com: repair com-invoke
for method without type
The argument type `(_ptr i _string/utf-16)` is not used on CS, because a pointer to non-atomic memory cannot usefully be passed to a foreign function from Racket CS. Closes #3820
This commit is contained in:
parent
b04b0fe3e1
commit
b126dc3893
|
@ -333,7 +333,7 @@
|
|||
[GetTypeInfo (_hmfun _UINT _LCID (p : (_ptr o _pointer))
|
||||
-> GetTypeInfo (cast p _pointer _ITypeInfo-pointer))
|
||||
#:release-with-function Release]
|
||||
[GetIDsOfNames (_hmfun _REFIID (_ptr i _string/utf-16)
|
||||
[GetIDsOfNames (_hmfun _REFIID _ptr-to-string/utf-16
|
||||
(_UINT = 1) _LCID
|
||||
(p : (_ptr o _DISPID))
|
||||
-> GetIDsOfNames
|
||||
|
|
|
@ -371,12 +371,29 @@
|
|||
2
|
||||
1))))
|
||||
|
||||
(define (string->pointer s)
|
||||
(define (string->pointer s [alloc SysAllocStringLen])
|
||||
(let ([v (malloc _gcpointer)])
|
||||
(ptr-set! v _string/utf-16 s)
|
||||
(let ([p (ptr-ref v _gcpointer)])
|
||||
(let ([len (utf-16-length s)])
|
||||
(SysAllocStringLen p len)))))
|
||||
(alloc p len)))))
|
||||
|
||||
;; Like (_ptr i _string/utf-16), but as a single atomic (and immobile
|
||||
;; and GCable) object, so it can be passed to a function in CS:
|
||||
(define _ptr-to-string/utf-16
|
||||
(make-ctype _gcpointer
|
||||
(lambda (s)
|
||||
(string->pointer
|
||||
s
|
||||
(lambda (p len)
|
||||
(define slen (+ len 2)) ; add terminator
|
||||
(define p2 (malloc 'atomic-interior
|
||||
(+ slen (ctype-sizeof _pointer))))
|
||||
(memcpy p2 (ctype-sizeof _pointer) p slen)
|
||||
(ptr-set! p2 _pointer 0 p)
|
||||
p2)))
|
||||
(lambda (p)
|
||||
(cast p _pointer _string/utf-16))))
|
||||
|
||||
(define _SAFEARRAY-pointer (_cpointer 'SAFEARRAY))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user