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

add ffi/winapi; use it in mzlib/os

Browse Source 
Closes PR 12007
This commit is contained in:
Matthew Flatt 2011-07-01 10:34:43 -06:00
parent 4f761ddb2f
commit 59731368fc
8 changed files with 50 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/ffi/winapi.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang racket/base
(provide win64? winapi)
(define win64?
(and (eq? 'windows (system-type))
(equal? "win32\\x86_64" (path->string (system-library-subpath #f)))))
(define winapi (if win64? 'default 'stdcall))

20
collects/file/resource.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require ffi/unsafe
ffi/unsafe/define)
ffi/unsafe/define
ffi/winapi)
(provide get-resource
write-resource)
@ -46,9 +47,6 @@
(define-ffi-definer define-kernel kernel-dll
#:default-make-fail make-not-available)
(define win64? (equal? "win32\\x86_64" (path->string (system-library-subpath #f))))
(define win_abi (if win64? #f 'stdcall))
(define _LONG _long)
(define _DWORD _int32)
(define _REGSAM _DWORD)
@ -59,11 +57,11 @@
(define ERROR_SUCCESS 0)
(define-advapi RegOpenKeyExW (_fun #:abi win_abi
(define-advapi RegOpenKeyExW (_fun #:abi winapi
_HKEY _string/utf-16 _DWORD _REGSAM (hkey : (_ptr o _HKEY))
-> (r : _LONG)
-> (and (= r ERROR_SUCCESS) hkey)))
(define-advapi RegCreateKeyExW (_fun #:abi win_abi
(define-advapi RegCreateKeyExW (_fun #:abi winapi
_HKEY _string/utf-16 (_DWORD = 0)
(_pointer = #f) ; class
_DWORD ; options
@ -74,7 +72,7 @@
-> (r : _LONG)
-> (and (= r ERROR_SUCCESS) hkey)))
(define-advapi RegQueryValueExW (_fun #:abi win_abi
(define-advapi RegQueryValueExW (_fun #:abi winapi
_HKEY _string/utf-16 (_pointer = #f)
(type : (_ptr o _DWORD))
_pointer (len : (_ptr io _DWORD))
@ -82,21 +80,21 @@
-> (if (= r ERROR_SUCCESS)
(values len type)
(values #f #f))))
(define-advapi RegSetValueExW (_fun #:abi win_abi
(define-advapi RegSetValueExW (_fun #:abi winapi
_HKEY _string/utf-16 (_pointer = #f)
_DWORD _pointer _DWORD
-> (r : _LONG)
-> (= r ERROR_SUCCESS)))
(define-advapi RegCloseKey (_fun #:abi win_abi _HKEY -> _LONG))
(define-advapi RegCloseKey (_fun #:abi winapi _HKEY -> _LONG))
(define-kernel WritePrivateProfileStringW (_fun #:abi win_abi
(define-kernel WritePrivateProfileStringW (_fun #:abi winapi
_string/utf-16 ; app
_string/utf-16 ; key
_string/utf-16 ; val
_string/utf-16 ; filename
-> _BOOL))
(define-kernel GetPrivateProfileStringW (_fun #:abi win_abi
(define-kernel GetPrivateProfileStringW (_fun #:abi winapi
_string/utf-16 ; app
_string/utf-16 ; key
_string/utf-16 ; default

8
collects/mred/private/wx/win32/types.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require ffi/unsafe)
(require ffi/unsafe
ffi/winapi)
(provide
(protect-out _wfun
@ -50,11 +51,8 @@
MAKELONG
MAKELPARAM))
(define win64? (equal? "win32\\x86_64" (path->string (system-library-subpath #f))))
(define win_abi (if win64? #f 'stdcall))
(define-syntax-rule (_wfun . a)
(_fun #:abi win_abi . a))
(_fun #:abi winapi . a))
(define _WORD _int16)
(define _DWORD _int32)

7
collects/mzlib/os.rkt
View File

@ -1,6 +1,9 @@
#lang mzscheme
(require mzlib/etc mzlib/foreign) (unsafe!)
(require mzlib/etc
ffi/unsafe
ffi/cvector
ffi/winapi)
(define kernel32
(delay (and (eq? 'windows (system-type)) (ffi-lib "kernel32"))))
@ -23,7 +26,7 @@
(define windows-getcomputername
(delay-ffi-obj "GetComputerNameExA" (force kernel32)
(_fun #:abi 'stdcall _int _bytes _cvector -> _int)))
(_fun #:abi winapi _int _bytes _cvector -> _int)))
(define (gethostname)
(case (system-type)

13
collects/racket/draw/private/libs.rkt
View File

@ -1,21 +1,14 @@
#lang scheme/base
(require ffi/unsafe
racket/runtime-path
(for-syntax racket/base))
ffi/winapi
(for-syntax racket/base
ffi/winapi))
(provide define-runtime-lib
win64?
(for-syntax win64?))
(define win64?
(and (eq? 'windows (system-type))
(equal? "win32\\x86_64"
(path->string (system-library-subpath #f)))))
(define-for-syntax win64?
(and (eq? 'windows (system-type))
(equal? "win32\\x86_64"
(path->string (system-library-subpath #f)))))
(define-syntax define-runtime-lib
;; the ids macosx unix windows don't appear to be bound here, but I added win32 and win64 anyways
(syntax-rules (macosx unix windows win32 win64 ffi-lib)

1
collects/scribblings/foreign/derived.scrbl
View File

@ -14,3 +14,4 @@
@include-section["try-atomic.scrbl"]
@include-section["objc.scrbl"]
@include-section["file.scrbl"]
@include-section["winapi.scrbl"]

4
collects/scribblings/foreign/types.scrbl
View File

@ -400,9 +400,9 @@ particular, its lexical context is properly preserved.
The optional @racket[abi] keyword argument determines the foreign ABI
that is used. Supplying @racket[#f] or @racket['default] indicates the
platform-dependent default. The other possible
values---@racket['stdcall]and @racket['sysv] (i.e., ``cdecl'')---are
values---@racket['stdcall] and @racket['sysv] (i.e., ``cdecl'')---are
currently supported only for 32-bit Windows; using them on other
platforms raises an exception.
platforms raises an exception. See also @racketmodname[ffi/winapi].
If @racket[atomic?] is true, then when a Racket procedure is given
this procedure type and called from foreign code, then the Racket

18
collects/scribblings/foreign/winapi.scrbl Normal file
View File

@ -0,0 +1,18 @@
#lang scribble/doc
@(require "utils.rkt" (for-label ffi/winapi))
@title[#:tag "winapi"]{Windows API Helpers}
@defmodule[ffi/winapi]
@defthing[win64? boolean?]{
Indicates whether the current platform is 64-bit Windows: @racket[#t]
if so, @racket[#f] otherwise.}
@defthing[winapi (or/c 'stdcall 'default)]{
Suitable for use as an ABI specification for a Windows API function:
@racket['stdcall] on 32-bit Windows, @racket['default] on 64-bit
Windows or any other platform.}