From 87c0ca84a81aa55c1f7b93a1bc9e54945b992a79 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 26 May 2017 17:49:16 -0600 Subject: [PATCH] add `ffi/unsafe/global` and switch `openssl` to use it Continues the move away from using the FFI to access unsafe Racket functionality. --- .../scribblings/foreign/derived.scrbl | 1 + .../scribblings/foreign/global.scrbl | 31 +++++++++++++++++++ .../scribblings/inside/custodians.scrbl | 13 ++++++-- pkgs/racket-doc/scribblings/inside/misc.scrbl | 8 +++-- racket/collects/ffi/unsafe/global.rkt | 8 +++++ racket/collects/openssl/mzssl.rkt | 11 +++---- 6 files changed, 60 insertions(+), 12 deletions(-) create mode 100644 pkgs/racket-doc/scribblings/foreign/global.scrbl create mode 100644 racket/collects/ffi/unsafe/global.rkt diff --git a/pkgs/racket-doc/scribblings/foreign/derived.scrbl b/pkgs/racket-doc/scribblings/foreign/derived.scrbl index df5ad68d8a..74557bbc84 100644 --- a/pkgs/racket-doc/scribblings/foreign/derived.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/derived.scrbl @@ -14,6 +14,7 @@ @include-section["custodian.scrbl"] @include-section["atomic.scrbl"] @include-section["try-atomic.scrbl"] +@include-section["global.scrbl"] @include-section["objc.scrbl"] @include-section["ns.scrbl"] @include-section["com.scrbl"] diff --git a/pkgs/racket-doc/scribblings/foreign/global.scrbl b/pkgs/racket-doc/scribblings/foreign/global.scrbl new file mode 100644 index 0000000000..8265a4c4f6 --- /dev/null +++ b/pkgs/racket-doc/scribblings/foreign/global.scrbl @@ -0,0 +1,31 @@ +#lang scribble/doc +@(require "utils.rkt" + (for-label ffi/unsafe/global)) + +@title{Process-Wide Registration} + +@defmodule[ffi/unsafe/global]{The +@racketmodname[ffi/unsafe/global] library provides a utility +registering information that spans all places in the Racket +process.} + +@history[#:added "6.9.0.5"] + +@defproc[(register-process-global [key bytes?] + [val cpointer?]) + cpointer?]{ + +Gets or sets a value in a process-global table (i.e., shared across +multiple places, if any). + +If @racket[val] is @racket[#f], the current mapping for @racket[key] +is reported. + +If @racket[val] is not @racket[#f], and no value has been installed +for @racket[key], then the value is installed and @racket[#f] is +returned. If a value has already been installed, then no new value is +installed and the old value is returned. The given @racket[val] must +not refer to garbage-collected memory. + +This function is intended for infrequent use with a small number of +keys.} \ No newline at end of file diff --git a/pkgs/racket-doc/scribblings/inside/custodians.scrbl b/pkgs/racket-doc/scribblings/inside/custodians.scrbl index d88637bac3..5305dc778a 100644 --- a/pkgs/racket-doc/scribblings/inside/custodians.scrbl +++ b/pkgs/racket-doc/scribblings/inside/custodians.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc -@(require "utils.rkt") +@(require "utils.rkt" + (for-label ffi/unsafe/custodian)) @title{Custodians} @@ -64,7 +65,10 @@ most one custodian. If @var{m} (or the current custodian if @var{m} is @cpp{NULL}) is shut down, then @var{f} is called immediately, and the result is -@cpp{NULL}.} +@cpp{NULL}. + +See also @racket[register-custodian-shutdown] from +@racketmodname[ffi/unsafe/custodian].} @function[(Scheme_Custodian_Reference* scheme_add_managed_close_on_exit [Scheme_Custodian* m] @@ -94,7 +98,10 @@ Checks whether @var{m} is already shut down, and raises an error if Removes @var{o} from the management of its custodian. The @var{mref} argument must be a value returned by @cpp{scheme_add_managed} or - @cpp{NULL}.} + @cpp{NULL}. + +See also @racket[unregister-custodian-shutdown] from +@racketmodname[ffi/unsafe/custodian].} @function[(void scheme_close_managed [Scheme_Custodian* m])]{ diff --git a/pkgs/racket-doc/scribblings/inside/misc.scrbl b/pkgs/racket-doc/scribblings/inside/misc.scrbl index 634a5dc4e1..dd5d73944c 100644 --- a/pkgs/racket-doc/scribblings/inside/misc.scrbl +++ b/pkgs/racket-doc/scribblings/inside/misc.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc -@(require "utils.rkt") +@(require "utils.rkt" + (for-label ffi/unsafe/global)) @title{Miscellaneous Utilities} @@ -392,7 +393,10 @@ value is returned. The given @var{val} must not refer to garbage-collected memory. This function is intended for infrequent use with a small number of -keys.} +keys. + +See also @racket[register-process-global] from +@racketmodname[ffi/unsafe/global].} @function[(void* scheme_jit_find_code_end [void* p])]{ diff --git a/racket/collects/ffi/unsafe/global.rkt b/racket/collects/ffi/unsafe/global.rkt new file mode 100644 index 0000000000..9aed16da52 --- /dev/null +++ b/racket/collects/ffi/unsafe/global.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require (only-in '#%unsafe + unsafe-register-process-global)) + +(provide register-process-global) + +(define (register-process-global bstr val) + (unsafe-register-process-global bstr val)) diff --git a/racket/collects/openssl/mzssl.rkt b/racket/collects/openssl/mzssl.rkt index f98344ad16..379fad7b98 100644 --- a/racket/collects/openssl/mzssl.rkt +++ b/racket/collects/openssl/mzssl.rkt @@ -28,6 +28,7 @@ TO DO: ffi/unsafe/define ffi/unsafe/atomic ffi/unsafe/alloc + ffi/unsafe/global ffi/file ffi/unsafe/custodian racket/list @@ -1687,10 +1688,6 @@ TO DO: (define ssl-available? (and libssl #t)) -(define scheme_register_process_global - (and ssl-available? - (get-ffi-obj 'scheme_register_process_global #f (_fun _string _pointer -> _pointer)))) - (when ssl-available? ;; Make sure only one place tries to initialize OpenSSL, ;; and wait in case some other place is currently initializing @@ -1698,18 +1695,18 @@ TO DO: (begin (start-atomic) (let* ([done (cast 1 _scheme _pointer)] - [v (scheme_register_process_global "OpenSSL-support-initializing" done)]) + [v (register-process-global #"OpenSSL-support-initializing" done)]) (if v ;; Some other place is initializing: (begin (end-atomic) (let loop () - (unless (scheme_register_process_global "OpenSSL-support-initialized" #f) + (unless (register-process-global #"OpenSSL-support-initialized" #f) (sleep 0.01) ;; busy wait! --- this should be rare (loop)))) ;; This place must initialize: (begin (SSL_library_init) (SSL_load_error_strings) - (scheme_register_process_global "OpenSSL-support-initialized" done) + (register-process-global #"OpenSSL-support-initialized" done) (end-atomic))))))