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:
Matthew Flatt 2021-05-06 20:20:46 -06:00
parent b04b0fe3e1
commit b126dc3893
2 changed files with 20 additions and 3 deletions

View File

@ -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

View File

@ -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))