From mboxrd@z Thu Jan 1 00:00:00 1970 From: Christopher Baines Subject: [PATCH 2/4] Adjust make-worker-thread-channel to take an initializer. Date: Fri, 24 Jan 2020 19:44:04 +0000 Message-ID: <20200124194406.29638-2-mail@cbaines.net> References: <20200124194406.29638-1-mail@cbaines.net> Mime-Version: 1.0 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:470:142:3::10]:34480) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iv4sF-0001BS-Na for guix-devel@gnu.org; Fri, 24 Jan 2020 14:44:13 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iv4sE-0003i5-Av for guix-devel@gnu.org; Fri, 24 Jan 2020 14:44:11 -0500 Received: from mira.cbaines.net ([212.71.252.8]:57054) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iv4sE-0003fD-0x for guix-devel@gnu.org; Fri, 24 Jan 2020 14:44:10 -0500 Received: from localhost (unknown [46.237.162.0]) by mira.cbaines.net (Postfix) with ESMTPSA id 9EB2117B42 for ; Fri, 24 Jan 2020 19:44:08 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 84510610 for ; Fri, 24 Jan 2020 19:44:06 +0000 (UTC) In-Reply-To: <20200124194406.29638-1-mail@cbaines.net> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane-mx.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org While this is a generic method, and initializer function will give the flexibility required to create multiple worker threads for performing SQL= ite queries, each with it's own database connection (as a result of calling t= he initializer once for each thread). Without this change, they'd all have t= o use the same connection, which would not work. * src/cuirass/utils.scm (make-worker-thread-channel): Change procedure to= take an initializer, rather than arguments directly. * src/cuirass/database.scm (with-database): Adjust to call make-worker-thread-channel with an initializer. * tests/database.scm (db-init): Change to use make-worker-thread-channel initializer. * tests/http.scm (db-init): Change to use make-worker-thread-channel initializer. --- src/cuirass/database.scm | 25 +++++++------------------ src/cuirass/utils.scm | 19 ++++++++++--------- tests/database.scm | 4 +++- tests/http.scm | 4 +++- 4 files changed, 23 insertions(+), 29 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 3e93492..0f5e38f 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -435,24 +435,13 @@ WHERE id =3D " eval-id ";") (#:in_progress . #f))))) =20 (define-syntax-rule (with-database body ...) - "Run BODY with %DB-CHANNEL being dynamically bound to a channel implem= enting -a critical section that allows database operations to be serialized." - ;; XXX: We don't install an unwind handler to play well with delimited - ;; continuations and fibers. But as a consequence, we leak DB when BO= DY - ;; raises an exception. - (let ((db (db-open))) - (unwind-protect - ;; Process database queries sequentially in a thread. We need this - ;; because otherwise we would need to use the SQLite multithreading - ;; feature for which it is required to wait until the database is - ;; available, and the waiting would happen in non-cooperative and - ;; non-resumable code that blocks the fibers scheduler. Now the da= tabase - ;; access blocks on PUT-MESSAGE, which allows the scheduler to sche= dule - ;; another fiber. Also, creating one new handle for each request w= ould - ;; be costly and may defeat statement caching. - (parameterize ((%db-channel (make-worker-thread-channel db))) - body ...) - (db-close db)))) + "Run BODY with %DB-CHANNEL being dynamically bound to a channel provid= ing a +worker thread that allows database operations to run without intefering = with +fibers." + (parameterize ((%db-channel (make-worker-thread-channel + (lambda () + (list (db-open)))))) + body ...)) =20 (define* (read-quoted-string #:optional (port (current-input-port))) "Read all of the characters out of PORT and return them as a SQL quote= d diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index 514899e..dfed4a9 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -99,19 +99,20 @@ delimited continuations and fibers." (define %worker-thread-args (make-parameter #f)) =20 -(define (make-worker-thread-channel . args) +(define (make-worker-thread-channel initializer) "Return a channel used to offload work to a dedicated thread. ARGS ar= e the arguments of the worker thread procedure." (parameterize (((@@ (fibers internal) current-fiber) #f)) (let ((channel (make-channel))) - (call-with-new-thread - (lambda () - (parameterize ((%worker-thread-args args)) - (let loop () - (match (get-message channel) - (((? channel? reply) . (? procedure? proc)) - (put-message reply (apply proc args)))) - (loop))))) + (let ((args (initializer))) + (call-with-new-thread + (lambda () + (parameterize ((%worker-thread-args args)) + (let loop () + (match (get-message channel) + (((? channel? reply) . (? procedure? proc)) + (put-message reply (apply proc args)))) + (loop)))))) channel))) =20 (define (call-with-worker-thread channel proc) diff --git a/tests/database.scm b/tests/database.scm index 271f166..6098465 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -87,7 +87,9 @@ (test-assert "db-init" (begin (%db (db-init database-name)) - (%db-channel (make-worker-thread-channel (%db))) + (%db-channel (make-worker-thread-channel + (lambda () + (list (%db))))) #t)) =20 (test-assert "sqlite-exec" diff --git a/tests/http.scm b/tests/http.scm index 337a775..d20a3c3 100644 --- a/tests/http.scm +++ b/tests/http.scm @@ -108,7 +108,9 @@ (test-assert "db-init" (begin (%db (db-init database-name)) - (%db-channel (make-worker-thread-channel (%db))) + (%db-channel (make-worker-thread-channel + (lambda () + (list (%db))))) #t)) =20 (test-assert "cuirass-run" --=20 2.24.1