diff --git a/asdf.lisp b/asdf.lisp
index 0061610c0b8d60e35007f7dbf912c4ed1033eae8..c43d4c1c8a636f028713495b799b9ca127509d4f 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -61,8 +61,8 @@
   (labels ((rename-away (package)
              (loop :with name = (package-name package)
                :for i :from 1 :for n = (format nil "~A.~D" name i)
-               :unless (find-package n) :do (rename-package package name)))
-           (ensure-exists (name nicknames)
+               :unless (find-package n) :do (rename-package package n)))
+           (ensure-exists (name nicknames use)
              (let* ((previous
                      (remove-duplicates
                       (remove-if
@@ -72,10 +72,12 @@
                (cond
                  (previous
                   (map () #'rename-away (cdr previous))
-                  (rename-package (car previous) name nicknames)
-                  (car previous))
+                  (let ((p (car previous)))
+                    (rename-package p name nicknames)
+                    (ensure-use p use)
+                    p))
                  (t
-                  (make-package name :nicknames nicknames)))))
+                  (make-package name :nicknames nicknames :use use)))))
            (remove-symbol (symbol package)
              (let ((sym (find-symbol (string symbol) package)))
                (when sym
@@ -83,8 +85,10 @@
                  (unintern sym package))))
            (ensure-unintern (package symbols)
              (dolist (sym symbols) (remove-symbol sym package)))
+           (ensure-shadow (package symbols)
+             (shadow symbols package))
            (ensure-use (package use)
-             (dolist (used use)
+             (dolist (used (reverse use))
                (do-external-symbols (sym used)
                  (unless (eq sym (find-symbol (string sym) package))
                    (remove-symbol sym package)))
@@ -97,10 +101,10 @@
                    (remove-symbol sym package)))
                (dolist (sym syms)
                  (export sym package))))
-           (ensure-package (name &key nicknames use export unintern)
-             (let* ((p (ensure-exists name nicknames)))
-               (ensure-use p use)
+           (ensure-package (name &key nicknames use unintern shadow export)
+             (let ((p (ensure-exists name nicknames use)))
                (ensure-unintern p unintern)
+               (ensure-shadow p shadow)
                (ensure-export p export)
                p)))
     (ensure-package
@@ -927,17 +931,19 @@ called with an object of type asdf:system."
        (and system-pair
             (system-source-file (cdr system-pair)))))))
 
-(defvar *central-registry*
-  `((directory-namestring *default-pathname-defaults*))
+(defvar *central-registry* nil
 "A list of 'system directory designators' ASDF uses to find systems.
 
-A 'system directory designator' is a pathname or a function
+A 'system directory designator' is a pathname or an expression
 which evaluates to a pathname. For example:
 
     (setf asdf:*central-registry*
           (list '*default-pathname-defaults*
                 #p\"/home/me/cl/systems/\"
                 #p\"/usr/share/common-lisp/systems/\"))
+
+This is for backward compatibilily.
+Going forward, we recommend new users should be using the source-registry.
 ")
 
 (defun sysdef-central-registry-search (system)
@@ -2251,7 +2257,7 @@ with a different configuration, so the configuration would be re-read then."
                (relativize-pathname-directory
                 (truenamize *default-pathname-defaults*)))
               ((eql :implementation) (implementation-identifier))
-              ((eql :implementation-type) (implementation-type))
+              ((eql :implementation-type) (princ-to-string (implementation-type)))
               ((eql :uid) (princ-to-string (get-uid)))))
          (d (if (pathnamep x) r (ensure-directory-pathname r)))
          (s (if (and wildenp (not (pathnamep x)))
@@ -2559,9 +2565,6 @@ with a different configuration, so the configuration would be re-read then."
     ".git" ".hg" ".pc" ".svn" "CVS" "RCS" "SCCS" "_darcs"
     "_sgbak" "autom4te.cache" "cover_db" "_build"))
 
-(defun default-registry ()
-  ())
-
 (defvar *source-registry* ()
   "Either NIL (for uninitialized), or a list of one element,
 said element itself being a list of directory pathnames where to look for .asd files")
@@ -2689,6 +2692,23 @@ with a different configuration, so the configuration would be re-read then."
 (defparameter *source-registry-file* #p"common-lisp/source-registry.conf")
 (defparameter *source-registry-directory* #p"common-lisp/source-registry.conf.d/")
 
+(defun wrapping-source-registry ()
+  `(:source-registry
+    #+sbcl (:tree ,(getenv "SBCL_HOME"))
+   :inherit-configuration))
+(defun default-source-registry ()
+  `(:source-registry
+    #+sbcl (:directory ,(merge-pathnames ".sbcl/systems/" (user-homedir-pathname)))
+    (:directory ,(truenamize (directory-namestring *default-pathname-defaults*)))
+    (:directory ,(merge-pathnames ".local/share/common-lisp/systems/" (user-homedir-pathname)))
+    (:tree ,(merge-pathnames ".local/share/common-lisp/source/" (user-homedir-pathname)))
+    (:directory "/usr/local/share/common-lisp/systems/")
+    (:tree "/usr/local/share/common-lisp/source/")
+    (:directory "/usr/local/share/common-lisp/systems/")
+    (:tree "/usr/local/share/common-lisp/source/")
+    (:directory "/usr/share/common-lisp/systems/")
+    (:tree "/usr/share/common-lisp/source/")
+    :inherit-configuration))
 (defun user-source-registry ()
   (merge-pathnames *source-registry-file* (user-configuration-directory)))
 (defun system-source-registry ()
@@ -2743,7 +2763,7 @@ with a different configuration, so the configuration would be re-read then."
       ((:exclude)
        (setf *default-exclusions* rest))
       ((:default-registry)
-       (default-registry))
+       (inherit-source-registry '(default-source-registry) :register register))
       ((:inherit-configuration)
        (inherit-source-registry inherit :register register))
       ((:ignore-inherited-configuration)
@@ -2754,9 +2774,10 @@ with a different configuration, so the configuration would be re-read then."
 (defun compute-source-registry (&optional parameter)
   (multiple-value-bind (collect result) (make-collector)
     (inherit-source-registry
-     (list*
-      parameter
-      *default-source-registries*)
+     `(wrapping-source-registry
+       ,parameter
+       ,@*default-source-registries*
+       default-source-registry)
      :register
      (lambda (directory &key recurse exclude)
        (register-asd-directory
@@ -2788,34 +2809,7 @@ with a different configuration, so the configuration would be re-read then."
         (when system
           (asdf:operate 'asdf:load-op name)
           t))))
-
-  (defun contrib-sysdef-search (system)
-    (let ((home (getenv "SBCL_HOME")))
-      (when (and home (not (string= home "")))
-        (let* ((name (coerce-name system))
-               (home (truename home))
-               (contrib (merge-pathnames
-                         (make-pathname :directory `(:relative ,name)
-                                        :name name
-                                        :type "asd"
-                                        :case :local
-                                        :version :newest)
-                         home)))
-          (probe-file contrib)))))
-
-  (pushnew
-   '(let ((home (getenv "SBCL_HOME")))
-      (when (and home (not (string= home "")))
-        (merge-pathnames "site-systems/" (truename home))))
-   *central-registry*)
-
-  (pushnew
-   '(merge-pathnames ".sbcl/systems/"
-     (user-homedir-pathname))
-   *central-registry*)
-
-  (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*)
-  (pushnew 'contrib-sysdef-search *system-definition-search-functions*))
+  (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*))
 
 ;;;; -------------------------------------------------------------------------
 ;;;; Cleanups after hot-upgrade.