diff --git a/collects/compiler/cm.rkt b/collects/compiler/cm.rkt
index 461e55b414..47613d4894 100644
--- a/collects/compiler/cm.rkt
+++ b/collects/compiler/cm.rkt
@@ -140,6 +140,10 @@
   (with-handlers ([exn:fail:filesystem? void])
     (trace-printf "deleting: ~a" path)
     (delete-file path)))
+(define (silent-try-delete-file path)
+  ;; Attempt to delete, but give up if it doesn't work:
+  (with-handlers ([exn:fail:filesystem? void])
+    (delete-file path)))
 
 (define (compilation-failure mode path zo-name date-path reason)
   (try-delete-file zo-name)
@@ -478,7 +482,7 @@
 (define (compile-root mode raw-path up-to-date read-src-syntax)
   (let ([actual-path (actual-source-path (simple-form-path raw-path))])
     (define (compile-it deps path zo-name src-sha1 update-cache-with-zo-time zo-exists?)
-      (when zo-exists? (delete-file zo-name))
+      (when zo-exists? (silent-try-delete-file zo-name))
       ((manager-compile-notify-handler) actual-path)
       (trace-printf "compiling: ~a" actual-path)
       (parameterize ([depth (+ (depth) 1)]
diff --git a/collects/compiler/compiler-unit.rkt b/collects/compiler/compiler-unit.rkt
index b179728c68..bfc689b391 100644
--- a/collects/compiler/compiler-unit.rkt
+++ b/collects/compiler/compiler-unit.rkt
@@ -229,5 +229,6 @@
                        #:skip-doc-sources? skip-docs?))
 
   (define compile-directory-zos compile-directory)
+  (define compile-directory-srcs get-compile-directory-srcs)
 
   )
diff --git a/collects/compiler/sig.rkt b/collects/compiler/sig.rkt
index 03b35835a7..a635eb1ab4 100644
--- a/collects/compiler/sig.rkt
+++ b/collects/compiler/sig.rkt
@@ -79,6 +79,7 @@
 
    compile-collection-zos
    compile-directory-zos
+   compile-directory-srcs
 
    current-compiler-dynamic-require-wrapper
    compile-notify-handler))
diff --git a/collects/setup/collects.rkt b/collects/setup/collects.rkt
new file mode 100644
index 0000000000..e000181383
--- /dev/null
+++ b/collects/setup/collects.rkt
@@ -0,0 +1,8 @@
+#lang racket  
+
+(provide (struct-out cc))
+
+(define-struct cc
+  (collection path name info root-dir info-path shadowing-policy)
+  #:inspector #f)
+
diff --git a/collects/setup/option-sig.rkt b/collects/setup/option-sig.rkt
index efa4c1eb89..cad8bedaa7 100644
--- a/collects/setup/option-sig.rkt
+++ b/collects/setup/option-sig.rkt
@@ -21,6 +21,8 @@
      call-install
      call-post-install
      pause-on-errors
+     parallel-build
+     parallel-workers
      force-unpacks
      doc-pdf-dest
      specific-collections
diff --git a/collects/setup/option-unit.rkt b/collects/setup/option-unit.rkt
index a8c08b2313..83da9676d1 100644
--- a/collects/setup/option-unit.rkt
+++ b/collects/setup/option-unit.rkt
@@ -1,5 +1,7 @@
 #lang scheme/base
-(require scheme/unit "option-sig.ss")
+(require scheme/unit
+         racket/future
+         "option-sig.ss")
 
 (provide setup:option@ set-flag-params)
 
@@ -25,6 +27,8 @@
 
   (define setup-program-name (make-parameter "setup-plt"))
 
+  (define-flag-param parallel-build #f)
+  (define-flag-param parallel-workers (processor-count))
   (define-flag-param verbose #f)
   (define-flag-param make-verbose #f)
   (define-flag-param compiler-verbose #f)
diff --git a/collects/setup/parallel-build-worker.rkt b/collects/setup/parallel-build-worker.rkt
new file mode 100644
index 0000000000..93328222e2
--- /dev/null
+++ b/collects/setup/parallel-build-worker.rkt
@@ -0,0 +1,33 @@
+#lang racket
+(require compiler/cm)
+(let ([cmc (make-caching-managed-compile-zo)]
+      [worker-id (read)])
+ (let loop ()
+   (match (read)
+     [(list 'DIE) void]
+     [(list name dir file)
+       (let ([dir (bytes->path dir)]
+             [file (bytes->path file)])
+        (let ([out-str-port (open-output-string)]
+              [err-str-port (open-output-string)])
+          (define (send/resp type)
+            (let ([msg (list type (get-output-string out-str-port) (get-output-string err-str-port))])
+              (write msg)))
+          (let ([cep (current-error-port)])
+            (define (pp x)
+              (fprintf cep "COMPILING ~a ~a ~a ~a~n" worker-id name file x))
+          (with-handlers ([exn:fail? (lambda (x)
+                           (send/resp (list 'ERROR (exn-message x))))])
+            (parameterize (
+                           [current-namespace (make-base-empty-namespace)]
+                           [current-directory dir]
+                           [current-load-relative-directory dir]
+                           [current-output-port out-str-port]
+                           [current-error-port err-str-port]
+                           ;[manager-compile-notify-handler pp]
+)
+
+              (cmc (build-path dir file)))
+            (send/resp 'DONE))))
+        (flush-output)
+        (loop))])))
diff --git a/collects/setup/parallel-build.rkt b/collects/setup/parallel-build.rkt
new file mode 100644
index 0000000000..2b20f6d501
--- /dev/null
+++ b/collects/setup/parallel-build.rkt
@@ -0,0 +1,370 @@
+#lang racket
+
+(require raco/command-name)
+(require racket/future)
+(require unstable/generics)
+(require setup/collects)
+
+(provide parallel-compile)
+
+(define-struct node (path children parents) #:mutable #:prefab)
+
+
+(define (get-dirs-files path) (partition (λ (x) (directory-exists? (build-path path x))) (directory-list path)))
+(define (get-dirs path)       (filter    (λ (x) (directory-exists? (build-path path x))) (directory-list path)))
+(define (get-files path)      (filter    (λ (x) (file-exists?      (build-path path x))) (directory-list path)))
+(define (sort-path x) (sort x (λ (a b) (string<? (path->string a) (path->string b)))))
+
+(define (find-dep-files path)
+  (define isdep? (regexp "\\.dep$"))
+  (let loop 
+    ([next (list path)] [matched null])
+    (match next
+      [(cons h t) 
+       (let*-values ([(c nc) (partition (λ (x) (string=? (path->string x) "compiled")) (get-dirs h))]
+                     [(mfiles) (if (pair? c)
+                                   (map (curry build-path h (car c)) 
+                                        (sort-path(filter (λ (x) (regexp-match isdep? (path->string x))) 
+                                                          (get-files (build-path h (car c))))))
+                                   null)])
+         (loop (append t (map (curry build-path h) (sort-path nc)))
+               (append matched mfiles)))] 
+      
+      [else matched])))
+
+(define (build-dag collects-path)
+  (define dag (make-hash))
+  (define (get-dag-node dag path) (hash-ref! dag path (λ () (make-node (string->bytes/locale path) null null))))
+  (define (dep-path->collect-path path)
+    (match (regexp-match "/collects/(.*)/compiled(.*)_(.*)\\.dep$" (path->string path))
+    [(list a b c d) (string-append b c "." d)]
+    [else (raise "BAD MATCH")]))
+  (define (get-deps path)
+    (foldl (λ (x init) 
+             (match x
+               [(list-rest 'collects rest) (cons (path->string (apply build-path (map bytes->string/locale rest))) init)]
+               [else init])) 
+           null
+           (with-input-from-file path read)))
+  (for ([file (find-dep-files collects-path)])
+    (let ([deps (get-deps file)]
+          [path (dep-path->collect-path file)])
+      (let ([node (get-dag-node dag path)])
+        (for ([dep deps])
+          (let ([dep-node (get-dag-node dag dep)])
+            (set-node-children! node (cons dep-node (node-children node)))
+            (set-node-parents! dep-node (cons node (node-parents dep-node))))))))
+  dag)
+
+(define (children-names n)
+  (map node-path (node-children n)))
+
+(define (find-initials dag) 
+  (for/fold ([ready null]) ([n (in-hash-values dag)])
+          (match n 
+            [(struct node (path '() ps)) (cons n ready)]
+            [else ready])))
+
+(define (compile-done dag node)
+    (hash-remove! dag (node-path node))
+    (let loop ([ready null]
+               [todo  (node-parents node)])
+      (match todo
+        [(list) ready]
+        [(cons depnode t)
+         (set-node-children! depnode (filter (λ (x) (not (equal? node x))) (node-children depnode)))
+         
+         (loop 
+          (if (null? (node-children depnode))
+              (cons depnode ready)
+              ready)
+          t)])))
+
+(define (sort-profit x)
+  (define (count-depend-only-on me)
+    (for/fold ([cnt 0]) ([p (node-parents me)])               
+      (if (> 2 (length (node-children p)))
+          (+ cnt 1)
+          cnt)))  
+  (sort x (λ (x y) (> (count-depend-only-on x) (count-depend-only-on y)))))
+
+(define (node-path-str x) (bytes->string/locale (node-path x)))
+
+(define-generics (jobqueue prop:jobqueue jobqueue?)
+  (work-done jobqueue queue work workerid msg)
+  (get-job jobqueue queue workerid)
+  (has-jobs? jobqueue queue)
+  (jobs-cnt jobqueue queue)
+  (job-desc jobqueue wokr)
+  (initial-queue jobqueue))
+
+(define-struct dag-queue (dag collects-dir) #:transparent
+  #:property prop:jobqueue
+  (define-methods jobqueue
+    (define (initial-queue jobqueue)
+      (sort-profit (find-initials (dag-queue-dag jobqueue))))
+    (define (work-done jobqueue queue work workerid msg)
+       (sort-profit (append queue (compile-done (dag-queue-dag jobqueue) work))))
+    (define (get-job jobqueue queue workerid)
+      (match queue
+        [(cons node rest) 
+          (values 
+            rest
+            node
+            (path->string (build-path (dag-queue-collects-dir jobqueue) (node-path-str node))))]))
+    (define (has-jobs? jobqueue queue)
+      (not (null? queue)))
+    (define (job-desc jobqueue work)
+      (node-path work))
+    (define (jobs-cnt jobqueue queue)
+      (length queue))))
+
+(define (splat txt fn)
+  (call-with-output-file fn #:exists 'replace
+      (lambda (out)
+        (fprintf out "~a" txt))))
+
+#|
+(define (places-comp jobqueue nprocs stopat)
+  (define place-worker-filename "pct1.rkt")
+  (define place-worker-src
+#<<END
+ (module pct1 racket
+   (provide place-main)
+   
+   (define (place-main ch)     
+     (let ([mc ((dynamic-require 'compiler/cm 'make-caching-managed-compile-zo))])
+       (let loop ()
+         (match (place-channel-recv ch)
+           ["DIE" void]
+           [file
+            (with-handlers ([exn:fail? (lambda (x) (printf "PLACE WORKER ERROR ~a~n" x) (place-channel-send ch "ERROR"))])
+              (parameterize ([current-namespace (make-base-empty-namespace)]) 
+                (let-values ([(r t1 t2 t3) (time-apply mc (list file))])
+                  (place-channel-send ch (list "DONE" t1 t2 t3)))))
+            (loop)]))))
+ )
+END
+
+  (define ps (for/list ([i (in-range nprocs)]) (place place-worker-filename 'place-main)))
+  (define (jobs? queue)
+    (has-jobs? jobqueue queue))
+  (define (empty? queue)
+    (not (has-jobs? jobqueue queue)))
+  
+  (splat place-worker-src place-worker-filename)
+  (letrec ([loop (match-lambda* 
+                   [(list queue waiters inflight (? (lambda (x) (= x stopat))))   (printf "DONE WITH LIMIT~n")]
+                   [(list (? jobs? queue-state) (cons worker wt) inflight count) 
+                              (let-values ([(queue-state job cmd-list) (get-job jobqueue queue-state 0)])
+                                (place-channel-send worker cmd-list)
+                                (loop queue-state wt (cons (list worker job) inflight) count))]
+                   [(list (? empty?) waiters (list) count) (void)]
+                   [(list queue waiters inflight count)
+                     (let ([report-done (λ (x p node msg)
+                             (list 
+                                 (work-done jobqueue queue node 0 msg)
+                                 (cons p waiters)
+                                 (remove x inflight)
+                                 (+ count 1)))])
+                       (apply loop (apply sync (map (λ (x) (match x
+                                               [(list p node) 
+                                                (handle-evt p (λ (e)
+                                                              ;(printf "RECV ~a~n")
+                                                              (match (place-channel-recv p)
+                                                                ["ERROR" (printf "ERROR ~a ~a ~a ~a ~a~n" count (length waiters) (length inflight) (jobs-cnt jobqueue) (node-path node))]
+                                                                [(list D t1 t2 t3) 
+                                                                    (when (= 0 (modulo count 100))  (printf "DONE ~a ~a ~a ~a ~a ~a ~a ~a~n" count (length waiters) (length inflight) (jobs-cnt jobqueue) (node-path node) t1 t2 t3))])
+                                                              (report-done x p node "")))]))
+                                    
+                                    inflight))))])])
+    (loop (initial-queue jobqueue) ps null 0))
+  
+  (for ([p ps]) (place-channel-send p "DIE"))
+  (for ([p ps]) (place-wait p)))
+|#
+
+(define (process-comp jobqueue nprocs stopat)
+  (define process-worker-filename
+    (path->string (build-path (collection-path "setup") "parallel-build-worker.rkt")))
+
+  (define executable (find-system-path 'exec-file))
+  (define (send/msg x ch)
+    (write x ch)
+    (flush-output ch))
+  (define (spawn i)
+    (let-values ([(s o in e) (subprocess #f #f (current-error-port) (path->string executable) process-worker-filename)])
+      (send/msg i in)
+      (list i s o in e)))
+  (define (kill-worker i nw o in)
+     (eprintf "KILLING WORKER ~a ~a ~n" i nw)
+     (close-input-port o)
+     (close-output-port in))
+  (define workers (for/list ([i (in-range nprocs)]) (spawn i)))
+  (define (jobs? queue)
+    (has-jobs? jobqueue queue))
+  (define (empty? queue)
+    (not (has-jobs? jobqueue queue)))
+ 
+  (letrec ([loop (match-lambda*
+                   ;; QUEUE IDLE INFLIGHT COUNT
+                   ;; Reached stopat count STOP
+                   [(list queue idle inflight (? (lambda (x) (= x stopat))))  (printf "DONE AT LIMIT~n")]
+                   ;; Send work to idle worker
+                   [(list (? jobs? queue) (cons worker idle) inflight count)
+                      (let-values ([(queue-state job cmd-list) (get-job jobqueue queue (first worker))])
+                        (let retry-loop ([worker worker]) 
+                          (match worker
+                            [(list i s o in e)
+                              (with-handlers* ([exn:fail? (lambda (nw) 
+                                                   (kill-worker i nw i o)
+                                                   (retry-loop (spawn i)))])
+                                (send/msg cmd-list in))])
+                          (loop queue-state idle (cons (list job worker) inflight) count)))]
+                   ;; Queue empty and all workers idle, we are all done
+                   [(list (? empty?) idle (list) count) (void)]
+                   ;; Wait for reply from worker
+                   [(list queue idle inflight count)
+                     (apply sync (map (λ (node-worker) (match node-worker
+                                               [(list node worker)
+                                                (match worker
+                                                  [(list i s o in e)
+                                                   (handle-evt o (λ (e)
+                                                                 (let ([msg 
+                                                                        (with-handlers* ([exn:fail? (lambda (nw) 
+                                                                                                      (printf "READ ERROR - reading worker: ~a ~n" nw)    
+                                                                                                      (kill-worker i nw i o)
+                                                                                                      (loop queue
+                                                                                                            (cons (spawn i) idle)
+                                                                                                            (remove node-worker inflight)
+                                                                                                            count))])
+                                                                          (read o))])
+                                                                   ;(list count i (length idle) (length inflight) (length queue))
+                                                                   (loop (work-done jobqueue queue node i msg)
+                                                                         (cons worker idle)
+                                                                         (remove node-worker inflight) 
+                                                                         (+ count 1)))))])]))
+                                      
+                                      inflight))])])
+    (loop (initial-queue jobqueue) workers null 0))
+  
+  (for ([p workers]) (send/msg (list 'DIE) (fourth p)))
+  (for ([p workers]) (subprocess-wait (second p))))
+
+
+(define-struct collects-queue (cclst hash collects-dir printer) #:transparent
+  #:mutable
+  #:property prop:jobqueue
+  (define-methods jobqueue
+    (define (initial-queue jobqueue) null)
+    (define (work-done jobqueue queue work workerid msg)
+      (match (list work msg)
+        [(list (list cc file) (list result-type out err))
+          (let ([cc-name (cc-name cc)])
+          (match result-type
+            [(list 'ERROR msg)
+              ((collects-queue-printer jobqueue) (current-error-port) "ERROR" "~a ~a: ~a" cc-name file msg)]
+            ['DONE (void)])
+          (when (or (not (zero? (string-length out))) (not (zero? (string-length err))))
+            ((collects-queue-printer jobqueue) (current-error-port) "build-output" "~a ~a" cc-name file)
+            (eprintf "STDOUT:~n~a=====~n" out)
+            (eprintf "STDERR:~n~a=====~n" err)))]))
+    ;; assigns a collection to each worker to be compiled
+    ;; when it runs out of collections, steals work from other workers collections
+    (define (get-job jobqueue queue workerid)
+      (define (hash/first-pair hash)
+         (match (hash-iterate-first hash)
+           [#f #f]
+           [x (cons (hash-iterate-key hash x) (hash-iterate-value hash x))]))
+      (define (hash-ref!/true hash key thunk)
+        (hash-ref hash key (lambda ()
+                              (match (thunk)
+                                [#f #f]
+                                [x (hash-set! hash key x) x]))))
+      (define (take-cc)
+        (match (collects-queue-cclst jobqueue)
+          [(list) #f]
+          [(cons h t)
+            (set-collects-queue-cclst! jobqueue t)
+            (list h)]))
+      (let ([w-hash (collects-queue-hash jobqueue)])
+        (define (build-job cc file)
+          (define (->bytes x)
+            (cond [(path? x) (path->bytes x)]
+                  [(string? x) (string->bytes/locale x)]))
+          (let* ([cc-name (cc-name cc)]
+                 [cc-path (cc-path cc)]
+                 [full-path (path->string (build-path cc-path file))])
+            ;(printf "JOB ~a ~a ~a ~a~n" workerid cc-name cc-path file)
+            (values null (list cc file) (list cc-name (->bytes cc-path) (->bytes file)))))
+        (let retry ()
+          (define (find-job-in-cc cc id)
+            (match cc
+              [(list)
+                (hash-remove! w-hash id) (retry)]
+              [(list (list cc (list) (list)))       ;empty collect
+                (hash-remove! w-hash id) (retry)]
+              [(cons (list cc (list) (list)) tail)  ;empty parent collect
+                (hash-set! w-hash id tail) (retry)]
+              [(cons (list cc (list) subs) tail)    ;empty srcs list
+                (hash-set! w-hash id (append subs tail)) (retry)]
+              [(cons (list cc (list file) subs) tail)
+                (hash-set! w-hash id (append subs tail))
+                  ((collects-queue-printer jobqueue) (current-output-port) "made" "~a" (cc-name cc))
+                  (build-job cc file)]
+              [(cons (list cc (cons file ft) subs) tail)
+                (hash-set! w-hash id (cons (list cc ft subs) tail))
+                (build-job cc file)]))
+          (match (hash-ref!/true w-hash workerid take-cc)
+            [#f 
+                (match (hash/first-pair w-hash)
+                  [(cons id cc) (find-job-in-cc cc id)])]
+            [cc (find-job-in-cc cc workerid)]))))
+    (define (has-jobs? jobqueue queue)
+      (define (hasjob?  cct)
+        (let loop ([cct cct])
+          (ormap (lambda (x) (or ((length (second x)) . > . 0) (loop (third x)))) cct)))
+
+      (let ([jc  (jobs-cnt jobqueue queue)]
+            [hj  (or (hasjob? (collects-queue-cclst jobqueue))
+         (for/or ([cct (in-hash-values (collects-queue-hash jobqueue))])
+            (hasjob? cct)))])
+        ;(printf "JOBCNT ~a ~a ~a ~a~n" hj jc (length (collects-queue-cclst jobqueue)) (hash-count (collects-queue-hash jobqueue)))
+        hj))
+    (define (job-desc jobqueue work)
+      work)
+    (define (jobs-cnt jobqueue queue)
+      (define (count-cct cct)
+        (let loop ([cct cct])
+          (apply + (map (lambda (x) (+ (length (second x)) (loop (third x)))) cct))))
+
+      (+ (count-cct (collects-queue-cclst jobqueue))
+         (for/fold ([cnt 0]) ([cct (in-hash-values (collects-queue-hash jobqueue))])
+            (+ cnt (count-cct cct)))))))
+
+(define (parallel-compile worker-count setup-fprintf collects)
+  (let ([cd (find-system-path 'collects-dir)]) 
+    (setup-fprintf (current-output-port) #f "--- parallel build using ~a processor cores ---" worker-count)
+    (process-comp (make-collects-queue collects (make-hash) cd setup-fprintf) worker-count 999999999)))
+
+
+(define (build-dag->file collects-dir dest-filename)
+  (with-output-to-file dest-filename #:exists 'replace (λ () (write (build-dag collects-dir)))))
+(define (file->dag dag-path)
+  (hash-copy (with-input-from-file dag-path (λ () (read)))))
+
+(define (build-dag-queue dagfile collects-dir) 
+  (let ([dag (file->dag dagfile)])
+    (make-dag-queue dag collects-dir)))
+  
+(define (absolute-collects-path)
+  (simplify-path (find-executable-path (find-system-path 'exec-file) (find-system-path 'collects-dir))))
+
+(match (current-command-name)
+  ;; called from raco
+  ["build-dag" (let ([cd (absolute-collects-path)])
+    (build-dag->file cd (build-path cd "setup/dag")))]
+  ["parallel-build" (let ([cd (absolute-collects-path)]) 
+    (printf "Using ~a processor cores~n" (processor-count))
+    (process-comp (build-dag-queue (build-path cd "setup/dag")) cd (processor-count) 999999999))]
+  [#f (void)])
diff --git a/collects/setup/setup-cmdline.rkt b/collects/setup/setup-cmdline.rkt
index 7ef0d9e660..dc7fbe8028 100644
--- a/collects/setup/setup-cmdline.rkt
+++ b/collects/setup/setup-cmdline.rkt
@@ -39,7 +39,12 @@
                    (call-install #f)
                    (make-launchers #f)
                    (make-info-domain #f)
+                   (parallel-build #f)
                    (make-docs #f)))]
+     [("-u" "--parallel-build") "Use parallel build"
+      (add-flags '((parallel-build #t)))]
+     [("-j" "--workers") workers "Use <#> parallel-workers"
+      (add-flags `((parallel-workers ,(string->number workers))))]
      [("-n" "--no-zo") "Do not produce .zo files"
       (add-flags '((make-zo #f)))]
      [("-x" "--no-launcher") "Do not produce launcher programs"
diff --git a/collects/setup/setup-unit.rkt b/collects/setup/setup-unit.rkt
index 5ebfbf41b5..350986f3fd 100644
--- a/collects/setup/setup-unit.rkt
+++ b/collects/setup/setup-unit.rkt
@@ -18,14 +18,16 @@
          "option-sig.rkt"
          compiler/sig
          launcher/launcher-sig
+         dynext/dynext-sig
 
          "unpack.rkt"
          "getinfo.rkt"
          "dirs.rkt"
          "main-collects.rkt"
          "private/path-utils.rkt"
-         "private/omitted-paths.rkt")
-
+         "private/omitted-paths.rkt"
+         "parallel-build.rkt"
+         "collects.rkt")
 (define-namespace-anchor anchor)
 
 ;; read info files using whatever namespace, .zo-use, and compilation
@@ -48,6 +50,7 @@
 (define-unit setup@
   (import setup-option^
           compiler^
+          dynext:file^
           (prefix compiler:option: compiler:option^)
           launcher^)
   (export)
@@ -146,10 +149,6 @@
   ;;              Find Collections                 ;;
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-  (define-struct cc
-    (collection path name info root-dir info-path shadowing-policy)
-    #:inspector #f)
-
   (define (make-cc* collection path root-dir info-path shadowing-policy)
     (define info
       (or (with-handlers ([exn:fail? (warning-handler #f)]) (getinfo path))
@@ -271,13 +270,57 @@
             (let loop ([l collections-to-compile])
               (append-map (lambda (cc) (cons cc (loop (get-subs cc)))) l))))
 
+  (define (collection-tree-map collections-to-compile 
+              #:skip-path [orig-skip-path (and (avoid-main-installation) (find-collects-dir))])
+    (define skip-path (and orig-skip-path (path->bytes 
+                                           (simplify-path (if (string? orig-skip-path)
+                                                              (string->path orig-skip-path)
+                                                              orig-skip-path)
+                                                          #f))))
+    (define (skip-path? path)
+      (and skip-path
+           (let ([b (path->bytes (simplify-path path #f))]
+                 [len (bytes-length skip-path)])
+             (and ((bytes-length b) . > . len)
+                  (bytes=? (subbytes b 0 len) skip-path)))
+           path))
+      
+    (define (build-collection-tree cc)
+      (define (make-child-cc parent-cc name) 
+        (collection->cc (append (cc-collection parent-cc) (list name))))
+      (let* ([info (cc-info cc)]
+             [ccp (cc-path cc)]
+             ;; note: omit can be 'all, if this happens then this
+             ;; collection should not have been included, but we might
+             ;; jump in if a command-line argument specified a
+             ;; coll/subcoll
+             [omit (omitted-paths ccp getinfo)])
+          (let-values ([(dirs files)
+             (if (eq? 'all omit)
+                 (values null null)
+                 (partition (lambda (x) (directory-exists? (build-path ccp x)))
+                   (filter (lambda (p) 
+                             (not (or (member p omit)
+                                      (skip-path? p))))
+                           (directory-list ccp))))])
+            (let ([children-ccs (map build-collection-tree (filter-map (lambda (x) (make-child-cc cc x)) dirs))]
+                      
+                  [srcs (append
+                           (filter extract-base-filename/ss files)
+                           (if (make-docs)
+                               (map car (call-info info 'scribblings (lambda () null) (lambda (x) #f)))
+                               null))])
+              (list cc srcs children-ccs)))))
+    (map build-collection-tree collections-to-compile))
+      
+
+    
   (define (plt-collection-closure collections-to-compile)
-    (collection-closure
-     collections-to-compile
-     (lambda (cc subs)
-       (map (lambda (sub)
-              (collection->cc (append (cc-collection cc) (list sub))))
-            subs))))
+    (define (make-children-ccs cc children)
+      (map (lambda (child)
+           (collection->cc (append (cc-collection cc) (list child))))
+           children))
+    (collection-closure collections-to-compile make-children-ccs))
 
   (define (check-again-all given-ccs)
     (define (cc->name cc)
@@ -320,34 +363,42 @@
   (define (sort-collections ccs)
     (sort ccs string<? #:key cc-name))
 
+  (define (sort-collections-tree ccs)
+    (sort ccs string<? #:key (lambda (x) (cc-name (first x)))))
+
+  (define top-level-plt-collects
+    (if no-specific-collections?
+      all-collections
+      (check-again-all
+       (filter-map
+        (lambda (c)
+          (collection->cc (append-map (lambda (s)
+                                        (map string->path
+                                             (regexp-split #rx"/" s)))
+                                      c)))
+        x-specific-collections))))
+
+  (define planet-collects
+    (if (make-planet)
+      (filter-map (lambda (spec) (apply planet->cc spec))
+                  (if no-specific-collections?
+                    (get-all-planet-packages)
+                    (filter-map planet-spec->planet-list
+                                x-specific-planet-dirs)))
+      null))
+  
+  (define planet-dirs-to-compile
+    (sort-collections
+      (collection-closure
+        planet-collects
+        (lambda (cc subs)
+          (map (lambda (p) (planet-cc->sub-cc cc (list (path->bytes p)))) subs)))))
+
   (define ccs-to-compile 
-    (let ([planet-dirs-to-compile
-            (sort-collections
-              (collection-closure
-                (if (make-planet)
-                  (filter-map (lambda (spec) (apply planet->cc spec))
-                              (if no-specific-collections?
-                                (get-all-planet-packages)
-                                (filter-map planet-spec->planet-list
-                                            x-specific-planet-dirs)))
-                  null)
-                (lambda (cc subs)
-                  (map (lambda (p) (planet-cc->sub-cc cc (list (path->bytes p))))
-                       subs))))]
-          [collections-to-compile
-            (sort-collections
-             (plt-collection-closure
-              (if no-specific-collections?
-                all-collections
-                (check-again-all
-                 (filter-map
-                  (lambda (c)
-                    (collection->cc (append-map (lambda (s)
-                                                  (map string->path
-                                                       (regexp-split #rx"/" s)))
-                                                c)))
-                  x-specific-collections)))))])
-    (append collections-to-compile planet-dirs-to-compile)))
+    (append
+      (sort-collections (plt-collection-closure top-level-plt-collects))
+      planet-dirs-to-compile))
+
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;                  Clean                        ;;
@@ -546,17 +597,6 @@
                 (setup-fprintf (current-error-port) #f " deleting ~a" (build-path c p))
                 (delete-file (build-path c p)))))))))
 
-  (define (compile-cc cc)
-    (define compile-skip-directory
-      (and (avoid-main-installation)
-           (find-collects-dir)))
-    (let ([dir (cc-path cc)]
-          [info (cc-info cc)])
-      (clean-cc dir info)
-      (compile-directory-zos dir info 
-                             #:skip-path compile-skip-directory 
-                             #:skip-doc-sources? (not (make-docs)))))
-
   (define-syntax-rule (with-specified-mode body ...)
     (let ([thunk (lambda () body ...)])
       (if (not (compile-mode))
@@ -585,28 +625,55 @@
                               (thunk)))])
             (thunk))))))
 
+  (define (compile-cc cc gcs)
+    (parameterize ([current-namespace (make-base-empty-namespace)])
+      (begin-record-error cc "making"
+        (setup-printf "making" "~a" (cc-name cc))
+        (control-io
+          (lambda (p where) 
+            (set! gcs 2) 
+            (setup-fprintf p #f " in ~a" (path->name (path->complete-path where (cc-path cc)))))
+          (let ([dir (cc-path cc)]
+                [info (cc-info cc)])
+            (clean-cc dir info)
+            (compile-directory-zos dir info 
+                                   #:skip-path (and (avoid-main-installation) (find-collects-dir))
+                                   #:skip-doc-sources? (not (make-docs)))))))
+    (match gcs
+      [0 0]
+      [else 
+        (collect-garbage)
+        (sub1 gcs)]))
+
   ;; To avoid polluting the compilation with modules that are already loaded,
   ;; create a fresh namespace before calling this function.
   ;; To avoid keeping modules in memory across collections, pass
   ;; `make-base-namespace' as `get-namespace', otherwise use
   ;; `current-namespace' for `get-namespace'.
+  (define (iterate-cct thunk cct)
+    (let loop ([cct cct])
+      (map (lambda (x) (thunk (first x)) (loop (third x))) cct)))
+
   (define (make-zo-step)
+    (define (move-drscheme-to-end cct)
+      (call-with-values (lambda () (partition (lambda (x) (not (string=? (cc-name (car x)) "drscheme"))) cct)) append))
     (setup-printf #f "--- compiling collections ---")
-    (with-specified-mode
-      (let ([gcs 0])
-        (for ([cc ccs-to-compile])
-          (parameterize ([current-namespace (make-base-empty-namespace)])
-            (begin-record-error cc "making"
-              (setup-printf "making" "~a" (cc-name cc))
-              (control-io
-                (lambda (p where) 
-                  (set! gcs 2) 
-                  (setup-fprintf p #f " in ~a" (path->name (path->complete-path where (cc-path cc)))))
-                (compile-cc cc))))
-          (unless (zero? gcs)
-            (set! gcs (sub1 gcs))
-            (collect-garbage))))))
-    
+    (match (parallel-build)
+      [#t
+        (compile-cc (ormap (lambda (x) (if (string=? (cc-name x) "racket") x #f)) ccs-to-compile) 0)
+        (with-specified-mode
+          (let ([cct (move-drscheme-to-end (sort-collections-tree (collection-tree-map top-level-plt-collects)))])
+            (iterate-cct (lambda (cc)
+              (let ([dir (cc-path cc)]
+                    [info (cc-info cc)])
+                  (clean-cc dir info))) cct)
+            (parallel-compile (parallel-workers) setup-fprintf cct))
+          (for/fold ([gcs 0]) ([cc planet-dirs-to-compile])
+            (compile-cc cc gcs)))]
+      [#f
+        (with-specified-mode
+          (for/fold ([gcs 0]) ([cc ccs-to-compile])
+            (compile-cc cc gcs)))]))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;               Info-Domain Cache               ;;