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

db/sqlite3: use {start,end}-atomic instead of call-as-atomic

Browse Source 
On my machine, this reduces the running time of the sqlite3
tests by about 1/4 (~3.2s to ~2.4s).

Other things I tried that didn't make as big a difference:
- coalesce A regions
- fast path for call-with-lock
This commit is contained in:
Ryan Culpepper 2015-03-26 23:25:12 -04:00
parent 2df51c4d19
commit e9f2c084eb
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
racket/collects/db/private/sqlite3/connection.rkt
View File

@ -51,11 +51,12 @@
;; Custodian shutdown can cause disconnect even in the middle of
;; operation (with lock held). So use (A _) around any FFI calls,
;; check still connected.
;; Optimization: use faster {start,end}-atomic instead of call-as-atomic;
;; but must not raise exn within (A _)!
(define-syntax-rule (A e ...)
(call-as-atomic
(lambda ()
(unless -db (error/disconnect-in-lock 'sqlite3))
e ...)))
(begin (start-atomic)
(unless -db (end-atomic) (error/disconnect-in-lock 'sqlite3))
(begin0 (let () e ...) (end-atomic))))
(define/private (get-db fsym)
(or -db (error/not-connected fsym)))
@ -211,18 +212,18 @@
(HANDLE fsym
;; Do not allow break/kill between prepare and
;; entry of stmt in table.
(A (let-values ([(prep-status stmt tail?)
(sqlite3_prepare_v2 db sql)])
(cond [(not (zero? prep-status))
(when stmt (sqlite3_finalize stmt))
(values prep-status #f)]
[tail?
(when stmt (sqlite3_finalize stmt))
(error* fsym "multiple statements given"
'("given" value) sql)]
[else
(when stmt (hash-set! stmt-table stmt #t))
(values prep-status stmt)]))))])
((A (let-values ([(prep-status stmt tail?)
(sqlite3_prepare_v2 db sql)])
(cond [(not (zero? prep-status))
(when stmt (sqlite3_finalize stmt))
(lambda () (values prep-status #f))]
[tail?
(when stmt (sqlite3_finalize stmt))
(lambda () ;; escape atomic mode (see A)
(error fsym "multiple statements given\n value: ~e" sql))]
[else
(when stmt (hash-set! stmt-table stmt #t))
(lambda () (values prep-status stmt))])))))])
(when DEBUG?
(dprintf " << prepared statement #x~x\n" (cast stmt _pointer _uintptr)))
(unless stmt (error* fsym "SQL syntax error" '("given" value) sql))