fix: skip native lock on fast path via double-checked binding init
ober
be69a90bb273b0e959c95afb1d1869561bb2e4b2
--- a/lib/jerboa-scintilla/ffi.sls +++ b/lib/jerboa-scintilla/ffi.sls @@ -24,7 +24,9 @@ ffi-tb-event-w ffi-tb-event-h ffi-tb-event-x ffi-tb-event-y ffi-tb-change-cell ffi-tb-set-clear-attributes ffi-tb-select-input-mode ffi-tb-select-output-mode - ffi-tb-print-string) + ffi-tb-print-string native-bindings-ready? + native-lock-acquisitions native-bindings-init-count + reset-native-bindings-state-for-test!) (import (except (chezscheme) make-hash-table hash-table? sort sort! printf fprintf format path-extension path-absolute? @@ -41,9 +43,14 @@ (def *native-loaded?* #f) (def *bindings-ready?* #f) (def *native-lock* (make-mutex)) + (def *native-lock-acquisitions* 0) + (def *bindings-init-count* 0) (def (call-with-native-lock proc) (dynamic-wind - (lambda () (mutex-acquire *native-lock*)) + (lambda () + (mutex-acquire *native-lock*) + (set! *native-lock-acquisitions* + (+ *native-lock-acquisitions* 1))) proc (lambda () (mutex-release *native-lock*)))) (def (try-load-one! path) @@ -143,6 +150,7 @@ (def c-tb-print-bytes #f) (def (ensure-bindings-unlocked!) (when (and (try-load-native!) (not *bindings-ready?*)) + (set! *bindings-init-count* (+ *bindings-init-count* 1)) (set! c-scintilla-new (c-lambda () unsigned-64 "jerboa_scintilla_new")) (set! c-scintilla-delete @@ -295,12 +303,22 @@ (set! *bindings-ready?* #t)) *bindings-ready?*) (def (ensure-bindings!) - (call-with-native-lock ensure-bindings-unlocked!)) + (or *bindings-ready?* + (call-with-native-lock ensure-bindings-unlocked!))) (def (need-native who) (unless (ensure-bindings!) (error who "unable to load jerboa_scintilla_shim native library")) #t) + (def (native-bindings-ready?) *bindings-ready?*) + (def (native-lock-acquisitions) *native-lock-acquisitions*) + (def (native-bindings-init-count) *bindings-init-count*) + (def (reset-native-bindings-state-for-test!) + (call-with-native-lock + (lambda () + (set! *bindings-ready?* #f) + (set! *native-lock-acquisitions* 0) + (set! *bindings-init-count* 0)))) (def max-u32 4294967295) (def max-native-text-bytes (* 64 1024 1024)) (def native-buffer-too-small -2) --- a/src/jerboa-scintilla/ffi.ss +++ b/src/jerboa-scintilla/ffi.ss @@ -66,7 +66,12 @@ ffi-tb-set-clear-attributes ffi-tb-select-input-mode ffi-tb-select-output-mode - ffi-tb-print-string) + ffi-tb-print-string + ;; Native binding state introspection (locking regression tests) + native-bindings-ready? + native-lock-acquisitions + native-bindings-init-count + reset-native-bindings-state-for-test!) (import (jerboa prelude) (only (jerboa ffi) c-lambda load-shared-object*) @@ -82,10 +87,14 @@ (def *native-loaded?* #f) (def *bindings-ready?* #f) (def *native-lock* (make-mutex)) + (def *native-lock-acquisitions* 0) + (def *bindings-init-count* 0) (def (call-with-native-lock proc) (dynamic-wind - (lambda () (mutex-acquire *native-lock*)) + (lambda () + (mutex-acquire *native-lock*) + (set! *native-lock-acquisitions* (+ *native-lock-acquisitions* 1))) proc (lambda () (mutex-release *native-lock*)))) @@ -187,6 +196,7 @@ (def (ensure-bindings-unlocked!) (when (and (try-load-native!) (not *bindings-ready?*)) + (set! *bindings-init-count* (+ *bindings-init-count* 1)) (set! c-scintilla-new (c-lambda () unsigned-64 "jerboa_scintilla_new")) (set! c-scintilla-delete @@ -303,13 +313,25 @@ *bindings-ready?*) (def (ensure-bindings!) - (call-with-native-lock ensure-bindings-unlocked!)) + (or *bindings-ready?* + (call-with-native-lock ensure-bindings-unlocked!))) (def (need-native who) (unless (ensure-bindings!) (error who "unable to load jerboa_scintilla_shim native library")) #t) + ;; Binding-state introspection used by the locking regression tests. + (def (native-bindings-ready?) *bindings-ready?*) + (def (native-lock-acquisitions) *native-lock-acquisitions*) + (def (native-bindings-init-count) *bindings-init-count*) + (def (reset-native-bindings-state-for-test!) + (call-with-native-lock + (lambda () + (set! *bindings-ready?* #f) + (set! *native-lock-acquisitions* 0) + (set! *bindings-init-count* 0)))) + (def max-u32 4294967295) (def max-native-text-bytes (* 64 1024 1024)) (def native-buffer-too-small -2) --- a/tests/run-tests.ss +++ b/tests/run-tests.ss @@ -3,6 +3,8 @@ ;;; Tests library loading and basic API surface. (import (jerboa prelude) + (only (chezscheme) fork-thread make-mutex mutex-acquire mutex-release + make-condition condition-signal condition-wait) (jerboa-scintilla constants) (jerboa-scintilla ffi) (jerboa-scintilla scintilla) @@ -231,6 +233,59 @@ (check-pred "editor-brace-match is procedure" editor-brace-match procedure?) ;; ==================================================================== +;; Native binding locking tests (P1 #36: double-checked locking) +;; ==================================================================== + +(format #t "~%=== Native Binding Locking ===~%") + +;; Start from a known state so these assertions are order-independent. +(reset-native-bindings-state-for-test!) +(check "reset clears ready flag" (native-bindings-ready?) #f) +(check "reset clears init count" (native-bindings-init-count) 0) + +;; Positive control: a basic ffi-scn accessor loads bindings and still works. +(check-pred "ffi-scn-code returns integer" (ffi-scn-code) integer?) +(check "bindings ready after first use" (native-bindings-ready?) #t) +(check "first use initializes exactly once" (native-bindings-init-count) 1) + +;; Fast path: once ready, repeated calls must NOT acquire the global lock. +(let ([baseline (native-lock-acquisitions)]) + (for ([i (in-range 1000)]) (ffi-scn-code)) + (check "fast path acquires no lock across 1000 calls" + (native-lock-acquisitions) baseline)) + +;; Concurrent first-use initializes bindings exactly once (no race). +(reset-native-bindings-state-for-test!) +(check "reset clears ready flag before race" (native-bindings-ready?) #f) +(let* ([n 8] + [mtx (make-mutex)] + [cv (make-condition)] + [done (box 0)] + [results (make-vector n)] + [threads (map (lambda (k) + (fork-thread + (lambda () + (let ([r (guard (e [else e]) (ffi-scn-code))]) + (vector-set! results k r) + (mutex-acquire mtx) + (set-box! done (+ (unbox done) 1)) + (condition-signal cv) + (mutex-release mtx))))) + (iota n))]) + (mutex-acquire mtx) + (let wait-loop () + (when (< (unbox done) n) + (condition-wait cv mtx) + (wait-loop))) + (mutex-release mtx) + (check "concurrent first-use initializes exactly once" + (native-bindings-init-count) 1) + (check "bindings ready after concurrent first-use" + (native-bindings-ready?) #t) + (check "all concurrent first-use calls succeeded" + (every integer? (vector->list results)) #t)) + +;; ==================================================================== ;; Summary ;; ====================================================================