Commit96ad41adRecorded14 Jul 2026Repositorysigil-sqlite
Cooperative busy-retry: don't block the scheduler thread on a locked db
Message
In Sigil's single-threaded cooperative scheduler, SQLite's default busytimeout is a deadlock hazard: a contended sqlite3step blocks the one thread for the whole timeout, freezing every fiber -- including the one that holds the lock, which can then never run to commit. A fiber holding a WAL write transaction across a yield while another fiber's db op blocks on the lock deadlocks until busy_timeout expires (kiln sets 5000ms); repeated contention reads as a hang.
Reproduced in isolation: fiber A takes a WAL write lock and sleeps 0.3s while holding it; fiber B's INSERT blocks inside sqlite3step. A's commit is frozen from its intended ~300ms to ~5112ms -- B's blocking step held the thread for the full busytimeout, so A's sleep timer could never fire.
Fix: the native sqlite-exec / sqlite-step force busytimeout=0 (so a lock conflict returns SQLITEBUSY immediately, never blocking the thread) and surface it as the symbol 'busy. Public Scheme sqlite-exec / sqlite-step wrap the native ops with cooperative retry: on 'busy they sleep briefly -- which is async-aware and SUSPENDS the fiber, letting the lock holder run and commit -- then retry, bounded by a timeout budget so a genuine deadlock ERRORS loudly instead of hanging. Uncontended calls never see 'busy, so their behavior is exactly preserved.
With the fix the repro completes in ~240ms (A commits on time, B retries right after) instead of freezing ~5s. Adds test-sqlite-wal-cooperative.sgl (fails on the pre-fix runtime) and preserves the existing suite.
Changed
native/sqlite.c | 33 +++++++++++++++++++++++++++------
package.sgl | 2 +-
src/sigil/sqlite.sgl | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------
test/test-sqlite-wal-cooperative.sgl | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 162 insertions(+), 22 deletions(-)Diff
native/sqlite.cmodified
@@ -217,15 +217,25 @@ static Value native_sqlite_exec(SigilVM *vm, int argc, Value *args)
217
char *sql = extract_string(args[1]); 218
if (!sql) return SIGIL_FALSE; 219
+220
/* Force non-blocking: never let sqlite3_exec block the single cooperative+221
* scheduler thread waiting on a lock. A contended lock returns SQLITE_BUSY+222
* immediately, which we surface as the symbol 'busy so the Scheme wrapper+223
* can yield to the scheduler + retry cooperatively (letting the lock holder+224
* run and commit). This overrides any PRAGMA busy_timeout the caller set —+225
* that intent is honored by the wrapper's retry budget instead. */+226
sqlite3_busy_timeout(handle->db, 0);+227
228
char *errmsg = NULL; 229
int rc = sqlite3_exec(handle->db, sql, NULL, NULL, &errmsg); 230
free(sql);+231
if (errmsg) sqlite3_free(errmsg); 232
+233
if (rc == SQLITE_BUSY || rc == SQLITE_LOCKED) {+234
return sigil_intern_symbol(vm, "busy", 4);+235
} 236
if (rc != SQLITE_OK) {−225
if (errmsg) sqlite3_free(errmsg); 237
return SIGIL_FALSE; 238
}−228
239
return SIGIL_TRUE; 240
} 241
@@ -351,12 +361,19 @@ static Value native_sqlite_step(SigilVM *vm, int argc, Value *args)
361
return SIGIL_UNDEFINED; 362
} 363
+364
/* Force non-blocking (see native_sqlite_exec): a contended lock surfaces as+365
* 'busy for the Scheme wrapper to yield + retry, rather than blocking the+366
* scheduler thread inside sqlite3_step. */+367
sqlite3_busy_timeout(sqlite3_db_handle(handle->stmt), 0);+368
369
int rc = sqlite3_step(handle->stmt); 370
371
if (rc == SQLITE_ROW) { 372
return sigil_intern_symbol(vm, "row", 3); 373
} else if (rc == SQLITE_DONE) { 374
return sigil_intern_symbol(vm, "done", 4);+375
} else if (rc == SQLITE_BUSY || rc == SQLITE_LOCKED) {+376
return sigil_intern_symbol(vm, "busy", 4); 377
} else { 378
return SIGIL_FALSE; 379
}@@ -610,16 +627,20 @@ void sigil__init_sigil_sqlite_module(SigilVM *vm)
627
SIGIL_ARITY_EXACT(1), "Open database file"); 628
REGISTER_AND_EXPORT("sqlite-close", native_sqlite_close, 629
SIGIL_ARITY_EXACT(1), "Close database connection");−613
REGISTER_AND_EXPORT("sqlite-exec", native_sqlite_exec,−614
SIGIL_ARITY_EXACT(2), "Execute SQL without results");+630
/* Internal: returns 'busy on a contended lock (never blocks). The public+631
* sqlite-exec (Scheme, in sqlite.sgl) wraps this with cooperative retry. */+632
REGISTER_AND_EXPORT("%sqlite-exec-native", native_sqlite_exec,+633
SIGIL_ARITY_EXACT(2), "Execute SQL without results (non-blocking)"); 634
635
/* Prepared statements */ 636
REGISTER_AND_EXPORT("sqlite-prepare", native_sqlite_prepare, 637
SIGIL_ARITY_EXACT(2), "Prepare SQL statement"); 638
REGISTER_AND_EXPORT("sqlite-bind", native_sqlite_bind, 639
SIGIL_ARITY_EXACT(3), "Bind parameter value");−621
REGISTER_AND_EXPORT("sqlite-step", native_sqlite_step,−622
SIGIL_ARITY_EXACT(1), "Execute statement step");+640
/* Internal: returns 'busy on a contended lock (never blocks). The public+641
* sqlite-step (Scheme, in sqlite.sgl) wraps this with cooperative retry. */+642
REGISTER_AND_EXPORT("%sqlite-step-native", native_sqlite_step,+643
SIGIL_ARITY_EXACT(1), "Execute statement step (non-blocking)"); 644
REGISTER_AND_EXPORT("sqlite-reset", native_sqlite_reset, 645
SIGIL_ARITY_EXACT(1), "Reset statement to initial state"); 646
REGISTER_AND_EXPORT("sqlite-finalize", native_sqlite_finalize,package.sglmodified
@@ -5,7 +5,7 @@
5
6
(package 7
name: "sigil-sqlite"−8
version: "0.16.1"+8
version: "0.16.2" 9
sigil: "^0.17" 10
description: "SQLite database bindings for Sigil" 11
url: "https://codeberg.org/sigil/sigil-sqlite"src/sigil/sqlite.sglmodified
@@ -24,7 +24,8 @@
24
;;; (sqlite-run db sql . params) - Execute statement with params 25
26
(define-library (sigil sqlite)−27
(import (sigil core))+27
(import (sigil core)+28
(sigil time)) ;; current-second + async-aware sleep for cooperative busy-retry 29
30
(export 31
;; Type predicates@@ -104,17 +105,12 @@
105
(define-native (sqlite-close db) 106
(: sqlite-db? -> void?)) 107
−107
;;; Execute a SQL string directly.−108
;;;−109
;;; Suitable for DDL statements and simple queries that don't need−110
;;; parameter binding. Returns `#t` on success, `#f` on error.−111
;;;−112
;;; ```scheme−113
;;; (sqlite-exec db "CREATE TABLE users (id INTEGER PRIMARY KEY, name TEXT)")−114
;;; (sqlite-exec db "PRAGMA journal_mode=WAL")−115
;;; ```−116
(define-native (sqlite-exec db sql)−117
(: sqlite-db? string? -> boolean?))+108
;; Internal non-blocking exec (native): returns #t on success, #f on error,+109
;; or 'busy on a contended lock. It forces busy_timeout=0 so it never blocks+110
;; the scheduler thread. The PUBLIC sqlite-exec (below) wraps it with+111
;; cooperative retry.+112
(define-native (%sqlite-exec-native db sql)+113
(: sqlite-db? string? -> any?)) 114
115
;;; Prepare a SQL statement for execution. 116
;;;@@ -139,16 +135,69 @@
135
(define-native (sqlite-bind stmt idx val) 136
(: sqlite-stmt? integer? any? -> boolean?)) 137
+138
;; Internal non-blocking step (native): 'row, 'done, #f on error, or 'busy+139
;; on a contended lock (forces busy_timeout=0, never blocks the scheduler+140
;; thread). The PUBLIC sqlite-step (below) wraps it with cooperative retry.+141
(define-native (%sqlite-step-native stmt)+142
(: sqlite-stmt? -> any?))+143
+144
;; ========== Cooperative busy-retry ==========+145
;;+146
;; SQLite's default busy_timeout makes a contended sqlite3_step BLOCK the+147
;; calling thread. In Sigil's single-threaded cooperative scheduler that+148
;; freezes EVERY fiber — including the one holding the lock, which can then+149
;; never run to commit — a deadlock (t-2f… WAL park). So the native ops force+150
;; busy_timeout=0 and surface a lock conflict as 'busy, and here we retry+151
;; cooperatively: `sleep` is async-aware (it SUSPENDS the fiber, letting the+152
;; lock holder run and commit), so a short sleep + retry resolves the+153
;; contention without blocking the thread. A budget bounds the wait so a+154
;; genuine deadlock ERRORS loudly instead of hanging. Uncontended calls never+155
;; return 'busy, so their behavior is exactly preserved (no sleep, no retry).+156
+157
(define *sqlite-busy-budget-seconds* 5.0)+158
(define *sqlite-busy-retry-interval* 0.002)+159
+160
(define (retry-on-busy op-name thunk)+161
(let ((deadline (+ (current-second) *sqlite-busy-budget-seconds*)))+162
(let loop ()+163
(let ((result (thunk)))+164
(if (eq? result 'busy)+165
(if (> (current-second) deadline)+166
(error (string-append op-name+167
": database is locked (busy-retry budget exhausted)"))+168
(begin+169
(sleep *sqlite-busy-retry-interval*)+170
(loop)))+171
result)))))+172
+173
;;; Execute a SQL string directly.+174
;;;+175
;;; Suitable for DDL statements and simple queries that don't need+176
;;; parameter binding. Returns `#t` on success, `#f` on error. If the+177
;;; database is locked by a concurrent writer, retries cooperatively+178
;;; (yielding to the scheduler) up to a timeout budget, then errors.+179
;;;+180
;;; ```scheme+181
;;; (sqlite-exec db "CREATE TABLE users (id INTEGER PRIMARY KEY, name TEXT)")+182
;;; (sqlite-exec db "PRAGMA journal_mode=WAL")+183
;;; ```+184
(define (sqlite-exec db sql)+185
(: sqlite-db? string? -> boolean?)+186
(retry-on-busy "sqlite-exec" (lambda () (%sqlite-exec-native db sql))))+187
188
;;; Step through a prepared statement. 189
;;; 190
;;; Returns `'row` if a result row is available (use `sqlite-column`−145
;;; to read values), `'done` when finished, or `#f` on error.+191
;;; to read values), `'done` when finished, or `#f` on error. On lock+192
;;; contention, retries cooperatively (yielding to the scheduler) up to a+193
;;; timeout budget, then errors. 194
;;; 195
;;; ```scheme 196
;;; (sqlite-step stmt) ; => 'row, 'done, or #f 197
;;; ```−150
(define-native (sqlite-step stmt)−151
(: sqlite-stmt? -> any?))+198
(define (sqlite-step stmt)+199
(: sqlite-stmt? -> any?)+200
(retry-on-busy "sqlite-step" (lambda () (%sqlite-step-native stmt)))) 201
202
;;; Reset a prepared statement to its initial state. 203
;;;test/test-sqlite-wal-cooperative.sgladded
@@ -0,0 +1,70 @@
+1
;;; Regression test for cooperative WAL busy-retry.+2
;;;+3
;;; Before the fix, a contended sqlite3_step BLOCKED the single cooperative+4
;;; scheduler thread for the whole busy_timeout (kiln sets 5000ms). Fiber A+5
;;; could hold a WAL write lock, yield, and then be UNABLE to run to commit+6
;;; because fiber B's blocking step froze the thread — a deadlock. This test+7
;;; sets up exactly that shape and asserts both fibers finish quickly (well+8
;;; under the busy_timeout), proving the step no longer blocks the scheduler.+9
;;;+10
;;; On the pre-fix runtime A commits only after ~5000ms (the busy_timeout) and+11
;;; this test FAILS; on the fix A commits at ~its intended yield (~200ms) and B+12
;;; retries cooperatively right after.+13
+14
(import (sigil core)+15
(sigil async)+16
(sigil sqlite)+17
(sigil time)+18
(sigil string))+19
+20
(display "Testing SQLite WAL cooperative busy-retry (deadlock regression)...\n")+21
+22
(define dbfile "/tmp/sqlite-wal-coop-test.db")+23
(define A (sqlite-open dbfile))+24
(sqlite-exec A "PRAGMA journal_mode=WAL")+25
(sqlite-exec A "PRAGMA busy_timeout=5000")+26
(sqlite-exec A "DROP TABLE IF EXISTS t")+27
(sqlite-exec A "CREATE TABLE t (id INTEGER PRIMARY KEY, v TEXT)")+28
(define B (sqlite-open dbfile))+29
(sqlite-exec B "PRAGMA busy_timeout=5000")+30
+31
(define t0 (current-milliseconds))+32
(define (ms) (- (current-milliseconds) t0))+33
(define a-commit-ms 0)+34
(define b-ms 0)+35
+36
(with-async+37
;; A: take the WAL write lock, YIELD 0.2s while holding it, then commit.+38
(go (begin+39
(sqlite-exec A "BEGIN IMMEDIATE")+40
(sleep 0.2)+41
(sqlite-exec A "INSERT INTO t (v) VALUES ('a')")+42
(sqlite-exec A "COMMIT")+43
(set! a-commit-ms (ms))))+44
;; B: write into the contended db — must cooperatively retry, NOT freeze the+45
;; scheduler thread (which would prevent A from ever committing).+46
(go (begin+47
(sleep 0.05)+48
(sqlite-exec B "INSERT INTO t (v) VALUES ('b')")+49
(set! b-ms (ms)))))+50
+51
(sqlite-close A)+52
(sqlite-close B)+53
+54
;; On the fix both finish ~0.2s; on the bug A only commits after ~5s (busy_timeout).+55
(define wal-cooperative-pass?+56
(and (> a-commit-ms 0) (> b-ms 0)+57
(< a-commit-ms 2000) (< b-ms 2000)))+58
+59
(if wal-cooperative-pass?+60
(display (string-append "PASS: A committed @" (number->string a-commit-ms)+61
"ms, B @" (number->string b-ms)+62
"ms (cooperative retry — scheduler not frozen)\n"))+63
(display (string-append "FAIL: A @" (number->string a-commit-ms)+64
"ms, B @" (number->string b-ms)+65
"ms (>=2000ms => blocking sqlite3_step froze the scheduler)\n")))+66
+67
;; Final top-level value drives the harness exit code: 0 on pass, error on fail.+68
(if wal-cooperative-pass?+69
0+70
(error "WAL cooperative busy-retry regression"))