diff --git a/collects/ffi/winapi.rkt b/collects/ffi/winapi.rkt new file mode 100644 index 0000000000..c1d3de4076 --- /dev/null +++ b/collects/ffi/winapi.rkt @@ -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)) diff --git a/collects/file/resource.rkt b/collects/file/resource.rkt index bd047ac995..61db9bd759 100644 --- a/collects/file/resource.rkt +++ b/collects/file/resource.rkt @@ -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 diff --git a/collects/mred/private/wx/win32/types.rkt b/collects/mred/private/wx/win32/types.rkt index 288dfa4b31..d446fedc5f 100644 --- a/collects/mred/private/wx/win32/types.rkt +++ b/collects/mred/private/wx/win32/types.rkt @@ -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) diff --git a/collects/mzlib/os.rkt b/collects/mzlib/os.rkt index 0d76602cb2..98f0c9b61f 100644 --- a/collects/mzlib/os.rkt +++ b/collects/mzlib/os.rkt @@ -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) diff --git a/collects/racket/draw/private/libs.rkt b/collects/racket/draw/private/libs.rkt index 29adf9d469..967f20ebe3 100644 --- a/collects/racket/draw/private/libs.rkt +++ b/collects/racket/draw/private/libs.rkt @@ -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) diff --git a/collects/scribblings/foreign/derived.scrbl b/collects/scribblings/foreign/derived.scrbl index 2be9249f13..9f7d964e03 100644 --- a/collects/scribblings/foreign/derived.scrbl +++ b/collects/scribblings/foreign/derived.scrbl @@ -14,3 +14,4 @@ @include-section["try-atomic.scrbl"] @include-section["objc.scrbl"] @include-section["file.scrbl"] +@include-section["winapi.scrbl"] diff --git a/collects/scribblings/foreign/types.scrbl b/collects/scribblings/foreign/types.scrbl index c9a894d703..2d61451ccb 100644 --- a/collects/scribblings/foreign/types.scrbl +++ b/collects/scribblings/foreign/types.scrbl @@ -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 diff --git a/collects/scribblings/foreign/winapi.scrbl b/collects/scribblings/foreign/winapi.scrbl new file mode 100644 index 0000000000..b7948b7282 --- /dev/null +++ b/collects/scribblings/foreign/winapi.scrbl @@ -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.}