summaryrefslogtreecommitdiff
path: root/src/cuirass/utils.scm
diff options
context:
space:
mode:
authorClément Lassieur <clement@lassieur.org>2018-08-05 13:14:44 +0200
committerClément Lassieur <clement@lassieur.org>2018-08-16 19:19:23 +0200
commit4612a3a70f1e70afa4e0ce00e8cb1a7848dddf58 (patch)
tree3f4fde6d56a925ae6cdaea0d907b2ec73df7a038 /src/cuirass/utils.scm
parente66e545b69c3adfba6fd1adb0f018f85ceed495f (diff)
downloadcuirass-4612a3a70f1e70afa4e0ce00e8cb1a7848dddf58.tar
cuirass-4612a3a70f1e70afa4e0ce00e8cb1a7848dddf58.tar.gz
database: Serialize all database accesses in a thread.
Fixes <https://bugs.gnu.org/32234>. * bin/cuirass.in (main): Keep only one WITH-DATABASE call around all fibers. Remove all DB arguments. * src/cuirass/base.scm (evaluate, update-build-statuses!, spawn-builds, handle-build-event, build-packages): Remove all DB arguments. (clear-build-queue, cancel-old-builds): Wrap in WITH-DB-CRITICAL-SECTION, remove all DB arguments. (restart-builds): Remove the NON-BLOCKING call, remove all DB arguments. (process-specs): Remove all DB arguments, remove the WITH-DATABASE call. * src/cuirass/database.scm (%db-channel): New parameter. (with-db-critical-section): New macro. (db-add-input, db-add-specification, db-get-inputs, db-get-specifications, db-add-evaluation, db-add-build, db-update-build-status!, db-get-outputs, db-get-builds, db-get-build, db-get-pending-derivations, db-get-stamp, db-add-stamp, db-get-evaluations, db-get-evaluations-build-summary, db-get-evaluations-id-min, db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): Wrap in WITH-DB-CRITICAL-SECTION, remove all DB arguments. (with-database): Wrap BODY in PARAMETERIZE form that sets %DB-CHANNEL to the channel returned by MAKE-CRITICAL-SECTION. * src/cuirass/http.scm (handle-build-request, handle-builds-request): Remove all DB arguments. (url-handler): Remove all DB arguments, remove the DB-CHANNEL state, remove the WITH-CRITICAL-SECTION calls. (run-cuirass-server): Remove the DB arguments, remove the MAKE-CRITICAL-SECTION call. * src/cuirass/utils.scm (make-critical-section): Replace SPAWN-FIBER with CALL-WITH-NEW-THREAD. Wrap body in PARAMETERIZE form that clears CURRENT-FIBER. * tests/database.scm (with-temporary-database, "db-add-specification", "db-add-build", "db-update-build-status!", "db-get-builds", "db-get-pending-derivations"): Remove the DB arguments. ("db-init"): Set the %DB-CHANNEL parameter to the channel returned by MAKE-CRITICAL-SECTION, and return #t. ("database"): Set %DB-CHANNEL to #f during cleanup. * tests/http.scm ("db-init"): Set the %DB-CHANNEL parameter to the channel returned by MAKE-CRITICAL-SECTION, and return #t. ("cuirass-run", "fill-db"): Remove the DB arguments. ("http"): Set %DB-CHANNEL to #f during cleanup.
Diffstat (limited to 'src/cuirass/utils.scm')
-rw-r--r--src/cuirass/utils.scm23
1 files changed, 12 insertions, 11 deletions
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index 6083890..48e797c 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -103,17 +103,18 @@ then be passed to 'join-critical-section', which will ensure sequential
ordering. ARGS are the arguments of the critical section.
Critical sections are implemented by passing the procedure to execute to a
-dedicated fiber."
- (let ((channel (make-channel)))
- (spawn-fiber
- (lambda ()
- (parameterize ((%critical-section-args args))
- (let loop ()
- (match (get-message channel)
- (((? channel? reply) . (? procedure? proc))
- (put-message reply (apply proc args))))
- (loop)))))
- channel))
+dedicated thread."
+ (parameterize (((@@ (fibers internal) current-fiber) #f))
+ (let ((channel (make-channel)))
+ (call-with-new-thread
+ (lambda ()
+ (parameterize ((%critical-section-args args))
+ (let loop ()
+ (match (get-message channel)
+ (((? channel? reply) . (? procedure? proc))
+ (put-message reply (apply proc args))))
+ (loop)))))
+ channel)))
(define (call-with-critical-section channel proc)
"Send PROC to the critical section through CHANNEL. Return the result of