diff --git a/collects/setup/doc-db.rkt b/collects/setup/doc-db.rkt
index ddff3622e0..22f3d94d74 100644
--- a/collects/setup/doc-db.rkt
+++ b/collects/setup/doc-db.rkt
@@ -35,6 +35,7 @@
      'prepare-tables
      db
      #f
+     +inf.0
      (lambda ()
        (prepare-tables db))))
   db)
@@ -60,6 +61,7 @@
 
 (define (call-with-database who db-file proc 
                             #:fail [fail #f]
+                            #:delay-limit [pause-limit +inf.0]
                             #:setup [setup void]
                             #:teardown [teardown void])
   (let loop ([pause (doc-db-init-pause)])
@@ -73,12 +75,19 @@
          who
          db
          (if (connection? db-file)
-             (lambda () (esc fail))
-             (lambda ()
-               (esc (lambda () 
-                      (disconnect db)
-                      (when fail (fail))
-                      (loop (doc-db-pause who pause))))))
+             (and fail
+                  (lambda (should-retry?)
+                    (if should-retry?
+                        (esc (lambda () (fail #t)))
+                        (fail #f))))
+             (lambda (should-retry?)
+               (if should-retry?
+                   (esc (lambda () 
+                          (disconnect db)
+                          (when fail (fail))
+                          (loop (doc-db-pause who pause))))
+                   (disconnect db))))
+         pause-limit
          (lambda ()
            (define results (call-with-values (lambda () (proc db)) list))
            (lambda () (apply values results))))
@@ -88,11 +97,13 @@
 
 (define (doc-db-key->path db-file key
                           #:fail [fail #f]
+                          #:delay-limit [pause-limit +inf.0]
                           #:main-doc-relative-ok? [main-doc-relative-ok? #f])
   (call-with-database
    'doc-db-key->path
    db-file
    #:fail fail
+   #:delay-limit pause-limit
    (lambda (db)
      (define row (query-maybe-row db select-pathid-vq
                                   (~s key)))
@@ -447,51 +458,51 @@
        (regexp-match #rx"the database file is locked$"
                      (exn-message v))))
 
-;; Call in a transation and handle Sqlite-level lock failures.  By
-;; default, failure uses rollbacks, but `fast-abort' can be provided
-;; for a faster abort by dropping the connection. Don't try to use a
-;; connection provided here in any other way on an abort.
-(define (call-with-transaction/retry who db fast-abort thunk)
-  (let ([old-break-paramz (current-break-parameterization)]
-        [can-break? (break-enabled)])
-    (let loop ([pause (doc-db-init-pause)])
-      (define (call-with-lock-handler handler thunk)
+;; By default, failure uses rollbacks, but `fast-abort' can be
+;; provided for a faster abort by dropping the connection. Don't try
+;; to use a connection provided here in any other way on an abort. The
+;; argument to `fast-abort' is `should-retry?': on #t, perhaps escape
+;; to retry, but on #f, just clean up without escaping.
+(define (call-with-transaction/retry who db fast-abort pause-limit thunk)
+  (let loop ([pause (doc-db-init-pause)])
+    (define (call-with-lock-handler handler thunk)
+      (with-handlers* ([exn:fail:database-locked?
+                        (lambda (exn) (handler pause))])
+        (thunk)))
+    ((let/ec esc
+       (define success? #f)
+       (dynamic-wind
+        (lambda ()
+          (call-with-lock-handler
+           (lambda (pause) (esc (lambda ()
+                                  (if (and fast-abort
+                                           (pause . > . pause-limit))
+                                      (fast-abort #t)
+                                      (loop (doc-db-pause `(start ,who) pause))))))
+           (lambda () (start-transaction db))))
+        (lambda ()
+          (call-with-lock-handler
+           (lambda (pause) (esc (lambda ()
+                                  (rollback db fast-abort #t 1)
+                                  (loop (doc-db-pause `(rollback ,who) pause)))))
+           (lambda ()
+             (define l (call-with-values thunk list))
+             (commit-transaction db)
+             (set! success? #t)
+             (lambda () (apply values l)))))
+        (lambda ()
+          (unless success?
+            (rollback db fast-abort #f 1))))))))
+
+(define (rollback db fast-abort should-retry? count)
+  (if fast-abort
+      (fast-abort should-retry?)
+      (when (in-transaction? db)
         (with-handlers* ([exn:fail:database-locked?
                           (lambda (exn)
-                            ;; Try again:
-                            (loop (doc-db-pause who pause)))])
-          (thunk)))
-      ((let/ec esc
-         (define success? #f)
-         (dynamic-wind
-          (lambda ()
-            (call-with-lock-handler
-             (lambda (pause) (esc (lambda ()
-                                    (loop (doc-db-pause `(start ,who) pause)))))
-             (lambda () (start-transaction db))))
-          (lambda ()
-            (call-with-lock-handler
-             (lambda (pause) (esc (lambda ()
-                                    (rollback db fast-abort 1)
-                                    (loop (doc-db-pause `(rollback ,who) pause)))))
-             (lambda ()
-               (define l (call-with-values thunk list))
-               (commit-transaction db)
-               (set! success? #t)
-               (lambda () (apply values l)))))
-          (lambda ()
-            (unless success?
-              (rollback db fast-abort 1)))))))))
-
-(define (rollback db fast-abort count)
-  (when (in-transaction? db)
-    (when fast-abort
-      (fast-abort))
-    (with-handlers* ([exn:fail:database-locked?
-                      (lambda (exn)
-                        (when (zero? (modulo count 100))
-                          (when (= count 10000) (error "fail"))
-                          (log-doc-db-info "database locked on rollback for ~a; tried ~a times so far"
-                                           count))
-                        (rollback db #f (add1 count)))])
-      (rollback-transaction db))))
+                            (when (zero? (modulo count 100))
+                              (when (= count 10000) (error "fail"))
+                              (log-doc-db-info "database locked on rollback; tried ~a times so far"
+                                               count))
+                            (rollback db #f should-retry? (add1 count)))])
+          (rollback-transaction db)))))
diff --git a/collects/setup/scribble.rkt b/collects/setup/scribble.rkt
index fc6d7f9439..8b4d1178ba 100644
--- a/collects/setup/scribble.rkt
+++ b/collects/setup/scribble.rkt
@@ -70,6 +70,40 @@
   (setup-printf "error running" (module-path-prefix->string (doc-src-spec doc)))
   (eprintf errstr))
 
+;; We use a lock to control writing to the database, because
+;; the database or binding doesn't seem to deal well with concurrent
+;; writers within a process.
+(define no-lock void)
+(define (lock-via-channel lock-ch)
+  (let ([saved-ch #f])
+    (lambda (mode)
+      (case mode
+        [(lock)
+         (define ch (sync lock-ch))
+         (place-channel-put ch 'lock)
+         (set! saved-ch ch)]
+        [(unlock)
+         (place-channel-put saved-ch 'done)
+         (set! saved-ch #f)]))))
+(define lock-ch #f)
+(define lock-ch-in #f)
+(define (init-lock-ch!)
+  (unless lock-ch
+    (set!-values (lock-ch lock-ch-in) (place-channel))
+    (thread (lambda ()
+              (define-values (ch ch-in) (place-channel))
+              (let loop ()
+                (place-channel-put lock-ch-in ch)
+                (place-channel-get ch-in)
+                (place-channel-get ch-in)
+                (loop))))))
+(define (call-with-lock lock thunk)
+  (lock 'lock)
+  (dynamic-wind
+   void
+   thunk
+   (lambda () (lock 'unlock))))
+
 (define (setup-scribblings
          worker-count       ; number of cores to use to create documentation
          program-name       ; name of program that calls setup-scribblings
@@ -162,7 +196,8 @@
               ;; non-parallel version:
               (map (get-doc-info only-dirs latex-dest auto-main? auto-user? 
                                  with-record-error setup-printf #f
-                                 #f force-out-of-date?)
+                                 #f force-out-of-date?
+                                 no-lock)
                    docs)
               ;; maybe parallel...
               (or
@@ -170,7 +205,8 @@
                                                with-record-error setup-printf #f 
                                                ;; only-fast:
                                                #t
-                                               force-out-of-date?)
+                                               force-out-of-date?
+                                               no-lock)
                                  docs)])
                  ;; check fast result
                  (and (andmap values infos)
@@ -179,8 +215,9 @@
                (parallel-do 
                 (min worker-count (length docs))
                 (lambda (workerid)
+                  (init-lock-ch!)
                   (list workerid program-name (verbose) only-dirs latex-dest auto-main? auto-user?
-                        force-out-of-date?))
+                        force-out-of-date? lock-ch))
                 (list-queue
                  docs
                  (lambda (x workerid) (s-exp->fasl (serialize x)))
@@ -191,9 +228,9 @@
                  (lambda (work errmsg outstr errstr) 
                    (parallel-do-error-handler setup-printf work errmsg outstr errstr)))
                 (define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest 
-                                                    auto-main? auto-user? force-out-of-date?)
+                                                    auto-main? auto-user? force-out-of-date? lock-ch)
                   (define ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user? 
-                                               force-out-of-date?
+                                               force-out-of-date? lock
                                                send/report) 
                            doc)
                     (define (setup-printf subpart formatstr . rest)
@@ -211,14 +248,14 @@
                     (s-exp->fasl (serialize 
                                   ((get-doc-info only-dirs latex-dest auto-main? auto-user?  
                                                  with-record-error setup-printf workerid
-                                                 #f force-out-of-date?)
+                                                 #f force-out-of-date? lock)
                                    (deserialize (fasl->s-exp doc))))))
                   
                   (verbose verbosev)
                   (match-message-loop
                    [doc (send/success 
                          ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user? 
-                                              force-out-of-date?
+                                              force-out-of-date? (lock-via-channel lock-ch)
                                               send/report) 
                           doc))]))))))))
 
@@ -392,7 +429,7 @@
                                         (and (info-need-run? i)
                                              (begin
                                                (when (info-need-in-write? i) 
-                                                 (write-in/info latex-dest i)
+                                                 (write-in/info latex-dest i no-lock)
                                                  (set-info-need-in-write?! i #f))
                                                (set-info-deps! i (filter info? (info-deps i)))
                                                (set-info-need-run?! i #f)
@@ -421,12 +458,13 @@
           (if ((min worker-count (length need-rerun)) . < . 2)
               (map (lambda (i) 
                      (say-rendering i #f)
-                     (update-info i (build-again! latex-dest i with-record-error))) 
+                     (update-info i (build-again! latex-dest i with-record-error no-lock))) 
                    need-rerun)
               (parallel-do 
                (min worker-count (length need-rerun))
                (lambda (workerid)
-                 (list workerid (verbose) latex-dest))
+                 (init-lock-ch!)
+                 (list workerid (verbose) latex-dest lock-ch))
                (list-queue
                 need-rerun
                 (lambda (i workerid) 
@@ -438,7 +476,7 @@
                   (update-info i (deserialize (fasl->s-exp r))))
                 (lambda (i errmsg outstr errstr) 
                   (parallel-do-error-handler setup-printf (info-doc i) errmsg outstr errstr)))
-               (define-worker (build-again!-worker2 workerid verbosev latex-dest)
+               (define-worker (build-again!-worker2 workerid verbosev latex-dest lock-ch)
                  (define (with-record-error cc go fail-k)
                    (with-handlers ([exn:fail?
                                     (lambda (x)
@@ -451,7 +489,8 @@
                    (send/success 
                     (s-exp->fasl (serialize (build-again! latex-dest
                                                           (deserialize (fasl->s-exp info))
-                                                          with-record-error))))])))))
+                                                          with-record-error
+                                                          (lock-via-channel lock-ch)))))])))))
         ;; If we only build 1, then it reaches it own fixpoint
         ;; even if the info doesn't seem to converge immediately.
         ;; This is a useful shortcut when re-building a single
@@ -464,7 +503,7 @@
   (when infos
     (make-loop #t 0)
     ;; cache info to disk
-    (for ([i infos] #:when (info-need-in-write? i)) (write-in/info latex-dest i))))
+    (for ([i infos] #:when (info-need-in-write? i)) (write-in/info latex-dest i no-lock))))
 
 (define (make-renderer latex-dest doc)
   (if latex-dest
@@ -614,7 +653,7 @@
 
 (define ((get-doc-info only-dirs latex-dest auto-main? auto-user?
                        with-record-error setup-printf workerid 
-                       only-fast? force-out-of-date?)
+                       only-fast? force-out-of-date? lock)
          doc)
   (let* ([info-out-files (for/list ([i (add1 (doc-out-count doc))])
                            (sxref-path latex-dest doc (format "out~a.sxref" i)))]
@@ -710,7 +749,7 @@
                                       (delete-file info-in-file)
                                       ((get-doc-info only-dirs latex-dest auto-main?
                                                      auto-user? with-record-error
-                                                     setup-printf workerid #f #f)
+                                                     setup-printf workerid #f #f lock)
                                        doc))])
            (let ([v-in  (load-sxref info-in-file)])
              (unless (equal? (car v-in) (list vers (doc-flags doc)))
@@ -784,10 +823,10 @@
                                      #f
                                      #f)])
                      (when need-out-write?
-                       (render-time "xref-out" (write-out/info latex-dest info scis defss db-file))
+                       (render-time "xref-out" (write-out/info latex-dest info scis defss db-file lock))
                        (set-info-need-out-write?! info #f))
                      (when (info-need-in-write? info)
-                       (render-time "xref-in" (write-in/info latex-dest info))
+                       (render-time "xref-in" (write-in/info latex-dest info lock))
                        (set-info-need-in-write?! info #f))
 
                      (when (or (stamp-time . < . aux-time)
@@ -871,7 +910,7 @@
                  searches
                  scis))])]))
 
-(define (build-again! latex-dest info with-record-error)
+(define (build-again! latex-dest info with-record-error lock)
   (define (cleanup-dest-dir doc)
     (unless latex-dest
       (let ([dir (doc-dest-dir doc)])
@@ -933,9 +972,9 @@
                    (doc-src-file doc)))
 
          (when in-delta?
-           (render-time "xref-in" (write-in latex-dest vers doc undef ff-deps-rel searches db-file)))
+           (render-time "xref-in" (write-in latex-dest vers doc undef ff-deps-rel searches db-file lock)))
          (when out-delta?
-           (render-time "xref-out" (write-out latex-dest vers doc scis defss db-file)))
+           (render-time "xref-out" (write-out latex-dest vers doc scis defss db-file lock)))
 
          (cleanup-dest-dir doc)
          (render-time
@@ -993,31 +1032,37 @@
                                            data)) 
                       out))))))
 
-(define (write-out latex-dest vers doc scis providess db-file)
+(define (write-out latex-dest vers doc scis providess db-file lock)
   (for ([i (add1 (doc-out-count doc))]
         [sci scis]
         [provides providess])
-  (write- latex-dest vers doc (format "out~a.sxref" i)
-          (list (list sci))
-          (lambda (filename)
-            (doc-db-clear-provides db-file filename)
-            (doc-db-add-provides db-file provides filename)))))
+    (write- latex-dest vers doc (format "out~a.sxref" i)
+            (list (list sci))
+            (lambda (filename)
+              (call-with-lock
+               lock
+               (lambda ()
+                 (doc-db-clear-provides db-file filename)
+                 (doc-db-add-provides db-file provides filename)))))))
 
-(define (write-out/info latex-dest info scis providess db-file)
-  (write-out latex-dest (info-vers info) (info-doc info) scis providess db-file))
+(define (write-out/info latex-dest info scis providess db-file lock)
+  (write-out latex-dest (info-vers info) (info-doc info) scis providess db-file lock))
 
-(define (write-in latex-dest vers doc undef rels searches db-file)
+(define (write-in latex-dest vers doc undef rels searches db-file lock)
   (write- latex-dest vers doc "in.sxref" 
           (list (list rels)
                 (list (serialize (list undef
                                        searches))))
           (lambda (filename)
-            (doc-db-clear-dependencies db-file filename)
-            (doc-db-clear-searches db-file filename)
-            (doc-db-add-dependencies db-file undef filename)
-            (doc-db-add-searches db-file searches filename))))
+            (call-with-lock
+             lock
+             (lambda ()
+               (doc-db-clear-dependencies db-file filename)
+               (doc-db-clear-searches db-file filename)
+               (doc-db-add-dependencies db-file undef filename)
+               (doc-db-add-searches db-file searches filename))))))
 
-(define (write-in/info latex-dest info)
+(define (write-in/info latex-dest info lock)
   (when (eq? 'delayed (info-undef info))
     (read-delayed-in! info latex-dest))
   (write-in latex-dest
@@ -1026,7 +1071,8 @@
             (info-undef info)
             (info-deps->rel-doc-src-file info)
             (info-searches info)
-            (find-db-file (info-doc info) latex-dest)))
+            (find-db-file (info-doc info) latex-dest)
+            lock))
 
 (define (rel->path r)
   (if (bytes? r)
diff --git a/collects/setup/xref.rkt b/collects/setup/xref.rkt
index f85f8e80c0..28e242e0f3 100644
--- a/collects/setup/xref.rkt
+++ b/collects/setup/xref.rkt
@@ -75,47 +75,63 @@
                              ;; cache for a connection:
                              (box #f))))
   (define done-ht (make-hash)) ; tracks already-loaded documents
+  (define forced-all? #f)
+  (define (force-all)
+    ;; force all documents
+    (define thunks (get-reader-thunks no-user? done-ht))
+    (set! forced-all? #t)
+    (lambda () 
+      ;; return a procedure so we can produce a list of results:
+      (lambda () 
+        (for/list ([thunk (in-list thunks)])
+          (thunk)))))
+  (define pause-limit 1.0)
   (lambda (key)
     (cond
+     [forced-all? #f]
      [key
       (define (try p)
         (let loop ([pause (doc-db-init-pause)])
-          (and p
-               (let* ([maybe-db (unbox (cdr p))]
-                      [db 
-                       ;; Use a cached connection, or...
-                       (or (and (box-cas! (cdr p) maybe-db #f)
-                                maybe-db)
-                           ;; ... create a new one
-                           (and (file-exists? (car p))
-                                (doc-db-file->connection (car p))))])
-                 (and 
-                  db
-                  ((let/ec esc
-                     ;; The db query:
-                     (define result
-                       (doc-db-key->path db key
-                                         #:fail (lambda ()
-                                                  ;; Rollback within a connection can be slow,
-                                                  ;; so abandon the connection and try again:
-                                                  (doc-db-disconnect db)
-                                                  (esc (lambda () 
-                                                         (loop (doc-db-pause 'xref-lookup pause)))))))
-                     ;; cache the connection, if none is already cached:
-                     (or (box-cas! (cdr p) #f db)
-                         (doc-db-disconnect db))
-                     (lambda () result))))))))
+          (cond
+           [(pause . >= . pause-limit)
+            ;; Too much database contention? Give up on the database.
+            #t]
+           [else
+            (and p
+                 (let* ([maybe-db (unbox (cdr p))]
+                        [db 
+                         ;; Use a cached connection, or...
+                         (or (and (box-cas! (cdr p) maybe-db #f)
+                                  maybe-db)
+                             ;; ... create a new one
+                             (and (file-exists? (car p))
+                                  (doc-db-file->connection (car p))))])
+                   (and 
+                    db
+                    ((let/ec esc
+                       ;; The db query:
+                       (define result
+                         (doc-db-key->path db key
+                                           #:delay-limit pause-limit
+                                           #:fail (lambda (should-retry?)
+                                                    ;; Rollback within a connection can be slow,
+                                                    ;; so abandon the connection and try again:
+                                                    (doc-db-disconnect db)
+                                                    (when should-retry?
+                                                      (esc (lambda () 
+                                                             (loop (doc-db-pause 'xref-lookup pause))))))))
+                       ;; cache the connection, if none is already cached:
+                       (or (box-cas! (cdr p) #f db)
+                           (doc-db-disconnect db))
+                       (lambda () result))))))])))
       (define dest (or (try main-db) (try user-db)))
       (and dest
-           ((dest->source done-ht) dest))]
+           (if (eq? dest #t)
+               (force-all)
+               ((dest->source done-ht) dest)))]
      [else
-      ;; force all documents
-      (define thunks (get-reader-thunks no-user? done-ht))
-      (lambda () 
-        ;; return a procedure so we can produce a list of results:
-        (lambda () 
-          (for/list ([thunk (in-list thunks)])
-            (thunk))))])))
+      (unless forced-all?
+        (force-all))])))
 
 (define (get-reader-thunks no-user? done-ht)
   (map (dest->source done-ht)