diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index e18528a..83a43a0 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -966,7 +966,7 @@ (chunk! missing-file-names 1000))))) (define* (insert-missing-derivations postgresql-connection-pool - utility-thread-channel + call-with-utility-thread derivation-ids-hash-table unfiltered-derivations #:key (log-tag "unspecified")) @@ -1081,10 +1081,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" id) #t) (_ #f))) - ;; Use the utility-thread-channel to control concurrency here, - ;; to avoid using too much memory - (call-with-worker-thread - utility-thread-channel + ;; Use a utility thread to control concurrency here, to + ;; avoid using too much memory + (call-with-utility-thread (lambda () (let ((nar-bytevector (call-with-values @@ -1163,7 +1162,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (lambda (chunk) (insert-missing-derivations postgresql-connection-pool - utility-thread-channel + call-with-utility-thread derivation-ids-hash-table chunk #:log-tag log-tag)) @@ -1183,7 +1182,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" derivations)))))) (define* (derivation-file-names->derivation-ids postgresql-connection-pool - utility-thread-channel + call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table derivation-file-names @@ -1228,7 +1227,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" i log-tag) (insert-missing-derivations postgresql-connection-pool - utility-thread-channel + call-with-utility-thread derivation-ids-hash-table missing-derivations-chunk #:log-tag log-tag))) @@ -1747,7 +1746,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" commit guix-source store-item guix-derivation - utility-thread-channel + call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table #:key skip-system-tests? @@ -1923,8 +1922,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" name network-dependent ;; Uses of sort may cause problems - (call-with-worker-thread - utility-thread-channel + (call-with-utility-thread (lambda () (lint-checker-description-data->lint-checker-description-set-id conn @@ -2087,7 +2085,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" system target) (derivation-file-names->derivation-ids postgresql-connection-pool - utility-thread-channel + call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table derivations-vector @@ -2170,7 +2168,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (derivation-ids (derivation-file-names->derivation-ids postgresql-connection-pool - utility-thread-channel + call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table (list->vector @@ -2200,7 +2198,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (prevent-inlining-for-tests extract-information-from) -(define (load-channel-instances utility-thread-channel +(define (load-channel-instances call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table git-repository-id commit @@ -2250,7 +2248,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (derivation-ids (derivation-file-names->derivation-ids postgresql-connection-pool - utility-thread-channel + call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table (list->vector (map cdr derivations-by-system))))) @@ -2271,18 +2269,25 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (define* (load-new-guix-revision conn git-repository-id commit #:key skip-system-tests? parallelism extra-inferior-environment-variables) - (define utility-thread-channel - ;; There might be high demand for this, so order the requests - (spawn-queueing-fiber - (call-with-default-io-waiters - (lambda () - (make-worker-thread-channel - (const '()) - #:parallelism parallelism))))) + (define call-with-utility-thread + (let* ((worker-thread-set + (call-with-default-io-waiters + (lambda () + (make-worker-thread-set + (const '()) + #:parallelism parallelism)))) + (queued-channel + ;; There might be high demand for this, so order the requests + (spawn-queueing-fiber + (worker-thread-set-channel worker-thread-set)))) + (lambda (thunk) + (call-with-worker-thread + worker-thread-set + thunk + #:channel queued-channel)))) (define (read-derivations filenames) - (call-with-worker-thread - utility-thread-channel + (call-with-utility-thread (lambda () (map (lambda (filename) (if (file-exists? filename) @@ -2331,7 +2336,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (let ((guix-source channel-derivations-by-system (fibers-force channel-derivations-by-system-promise))) - (load-channel-instances utility-thread-channel + (load-channel-instances call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table git-repository-id commit @@ -2358,7 +2363,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" guix-revision-id-promise commit guix-source store-item guix-derivation - utility-thread-channel + call-with-utility-thread read-derivations/fiberized derivation-ids-hash-table #:skip-system-tests? diff --git a/guix-dev.scm b/guix-dev.scm index eec15ec..138b18c 100644 --- a/guix-dev.scm +++ b/guix-dev.scm @@ -42,7 +42,7 @@ (srfi srfi-1)) (define guile-knots - (let ((commit "0fab93e9ff5b16813ae1356c13d3c974d7277d81") + (let ((commit "6119ece5cba6cbdc638ccfb19aba52ea246dfe50") (revision "1")) (package (name "guile-knots") @@ -54,7 +54,7 @@ (commit commit))) (sha256 (base32 - "1x0wirq0db2704784ig00kz5kh8j6szp2gwm67wn714m1jbhz9ky")) + "1dn9mrla0inhmfcyl725jh6dfwrg6xd56jp7c3n3plmjz3knyfmj")) (file-name (string-append name "-" version "-checkout")))) (build-system gnu-build-system) (native-inputs @@ -62,6 +62,7 @@ autoconf automake guile-3.0 + guile-lib guile-fibers)) (inputs (list guile-3.0))