From 2c3f47ee3a621f20d24ae5c78b1abc0eb00ba445 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 29 Jan 2013 23:34:50 +0100 Subject: store: Make the `add-to-store' cache per-connection. * guix/store.scm ()[ats-cache]: New field. (open-connection): Update accordingly. (add-to-store/cached): Use (nix-server-add-to-store-cache SERVER) instead of a weak hash table. --- guix/store.scm | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index 79e651f01b..aa762b667c 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -292,11 +292,17 @@ ;; remote-store.cc (define-record-type - (%make-nix-server socket major minor) + (%make-nix-server socket major minor + ats-cache) nix-server? (socket nix-server-socket) (major nix-server-major-version) - (minor nix-server-minor-version)) + (minor nix-server-minor-version) + + ;; Caches. We keep them per-connection, because store paths build + ;; during the session are temporary GC roots kept for the duration of + ;; the session. + (ats-cache nix-server-add-to-store-cache)) (define-condition-type &nix-error &error nix-error?) @@ -333,7 +339,8 @@ operate, should the disk become full. Return a server object." (write-int (if reserve-space? 1 0) s)) (let ((s (%make-nix-server s (protocol-major v) - (protocol-minor v)))) + (protocol-minor v) + (make-hash-table)))) (let loop ((done? (process-stderr s))) (or done? (process-stderr s))) s)))))))) @@ -468,13 +475,13 @@ FIXED? is for backward compatibility with old Nix versions and must be #t." ;; A memoizing version of `add-to-store'. This is important because ;; `add-to-store' leads to huge data transfers to the server, and ;; because it's often called many times with the very same argument. - (let ((add-to-store add-to-store) - (cache (make-weak-value-hash-table 500))) + (let ((add-to-store add-to-store)) (lambda (server basename fixed? recursive? hash-algo file-name) "Add the contents of FILE-NAME under BASENAME to the store. Note that FIXED? is for backward compatibility with old Nix versions and must be #t." - (let* ((st (stat file-name #f)) - (args `(,basename ,recursive? ,hash-algo ,st))) + (let* ((st (stat file-name #f)) + (args `(,basename ,recursive? ,hash-algo ,st)) + (cache (nix-server-add-to-store-cache server))) (or (and st (hash-ref cache args)) (let ((path (add-to-store server basename fixed? recursive? hash-algo file-name))) -- cgit v1.2.3