Ignore:
Timestamp:
Nov 15, 2012, 1:22:57 AM (7 years ago)
Author:
rme
Message:

Update ASDF to version 2.26. Update and rename README file.

See ticket:1028.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/tools/asdf.lisp

    r15423 r15496  
    11;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
    2 ;;; This is ASDF 2.23: Another System Definition Facility.
     2;;; This is ASDF 2.26: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    5151#+genera (in-package :future-common-lisp-user)
    5252
    53 #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl sbcl scl xcl)
     53#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
    5454(error "ASDF is not supported on your implementation. Please help us port it.")
    5555
     
    7272                 (< system::*gcl-minor-version* 7)))
    7373    (pushnew :gcl-pre2.7 *features*))
    74   #+(or abcl (and allegro ics) (and clisp unicode) clozure (and cmu unicode)
    75         (and ecl unicode) lispworks (and sbcl sb-unicode) scl)
     74  #+(or abcl (and allegro ics) (and (or clisp cmu ecl mkcl) unicode)
     75        clozure lispworks (and sbcl sb-unicode) scl)
    7676  (pushnew :asdf-unicode *features*)
    7777  ;;; make package if it doesn't exist yet.
     
    8787  #+ecl (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t))
    8888  #+ecl (unless (use-ecl-byte-compiler-p) (require :cmp))
     89  #+mkcl (require :cmp)
     90  #+mkcl (setq clos::*redefine-class-in-place* t) ;; Make sure we have strict ANSI class redefinition semantics
    8991
    9092  ;;; Package setup, step 2.
     
    117119         ;; "2.345.0.7" would be your seventh local modification of official release 2.345
    118120         ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
    119          (asdf-version "2.23")
     121         (asdf-version "2.26")
    120122         (existing-asdf (find-class 'component nil))
    121123         (existing-version *asdf-version*)
     
    229231          (pkgdcl
    230232           :asdf
    231            :nicknames (:asdf-utilities) ;; DEPRECATED! Do not use, for backward compatibility only.
    232233           :use (:common-lisp)
    233234           :redefined-functions
     
    304305            #:*compile-file-failure-behaviour*
    305306            #:*resolve-symlinks*
    306             #:*require-asdf-operator*
     307            #:*load-system-operation*
    307308            #:*asdf-verbose*
    308309            #:*verbose-out*
     
    363364            #:system-source-registry-directory
    364365
    365             ;; Utilities
     366            ;; Utilities: please use asdf-utils instead
     367            #|
    366368            ;; #:aif #:it
    367             #:appendf #:orf
     369            ;; #:appendf #:orf
    368370            #:length=n-p
    369371            #:remove-keys #:remove-keyword
    370             #:first-char #:last-char #:ends-with
     372            #:first-char #:last-char #:string-suffix-p
    371373            #:coerce-name
    372374            #:directory-pathname-p #:ensure-directory-pathname
    373375            #:absolute-pathname-p #:ensure-pathname-absolute #:pathname-root
    374             #:getenv #:getenv-pathname #:getenv-pathname
     376            #:getenv #:getenv-pathname #:getenv-pathnames
    375377            #:getenv-absolute-directory #:getenv-absolute-directories
    376378            #:probe-file*
     
    388390            #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors*
    389391            #:*wild-path* #:wilden
    390             #:directorize-pathname-host-device
     392            #:directorize-pathname-host-device|#
    391393            )))
    392394        #+genera (import 'scl:boolean :asdf)
     
    419421(defparameter +asdf-methods+
    420422  '(perform-with-restarts perform explain output-files operation-done-p))
     423
     424(defvar *load-system-operation* 'load-op
     425  "Operation used by ASDF:LOAD-SYSTEM. By default, ASDF:LOAD-OP.
     426You may override it with e.g. ASDF:LOAD-FASL-OP from asdf-bundle,
     427or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.")
     428
     429(defvar *compile-op-compile-file-function* 'compile-file*
     430  "Function used to compile lisp files.")
     431
     432
    421433
    422434#+allegro
     
    451463  (deftype logical-pathname () nil)
    452464  (defun make-broadcast-stream () *error-output*)
     465  (defun translate-logical-pathname (x) x)
    453466  (defun file-namestring (p)
    454467    (setf p (pathname p))
     
    660673         ;; See CLHS make-pathname and 19.2.2.2.3.
    661674         ;; We only use it on implementations that support it,
    662          #+(or abcl allegro clozure cmu gcl genera lispworks sbcl scl xcl) :unspecific
     675         #+(or abcl allegro clozure cmu gcl genera lispworks mkcl sbcl scl xcl) :unspecific
    663676         #+(or clisp ecl #|These haven't been tested:|# cormanlisp mcl) nil))
    664677    (destructuring-bind (name &optional (type unspecific))
     
    742755            (unless (ccl:%null-ptr-p value)
    743756              (ccl:%get-cstring value))))
     757  #+mkcl (#.(or (find-symbol* 'getenv :si) (find-symbol* 'getenv :mk-ext)) x)
    744758  #+sbcl (sb-ext:posix-getenv x)
    745   #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl sbcl scl xcl)
     759  #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
    746760  (error "~S is not supported on your implementation" 'getenv))
    747761
     
    850864      ((not (consp l)) (return nil)))))
    851865
    852 (defun* ends-with (s suffix)
     866(defun* string-suffix-p (s suffix)
    853867  (check-type s string)
    854868  (check-type suffix string)
     
    878892    (string (probe-file* (parse-namestring p)))
    879893    (pathname (unless (wild-pathname-p p)
    880                 #.(or #+(or allegro clozure cmu cormanlisp ecl lispworks sbcl scl)
     894                #.(or #+(or allegro clozure cmu cormanlisp ecl lispworks mkcl sbcl scl)
    881895                      '(probe-file p)
    882896                      #+clisp (aif (find-symbol* '#:probe-pathname :ext)
     
    24512465        (funcall thunk))))
    24522466
    2453 (defvar *compile-op-compile-file-function* 'compile-file*
    2454   "Function used to compile lisp files.")
    2455 
    24562467;;; perform is required to check output-files to find out where to put
    24572468;;; its answers, in case it has been overridden for site policy
    24582469(defmethod perform ((operation compile-op) (c cl-source-file))
    2459   #-:broken-fasl-loader
    24602470  (let ((source-file (component-pathname c))
    24612471        ;; on some implementations, there are more than one output-file,
     
    24902500(defmethod output-files ((operation compile-op) (c cl-source-file))
    24912501  (declare (ignorable operation))
    2492   (let ((p (lispize-pathname (component-pathname c))))
    2493     #-broken-fasl-loader (list (compile-file-pathname p))
    2494     #+broken-fasl-loader (list p)))
     2502  (let* ((p (lispize-pathname (component-pathname c)))
     2503         (f (compile-file-pathname ;; fasl
     2504             p #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl))
     2505         #+mkcl (o (compile-file-pathname p :fasl-p nil))) ;; object file
     2506    #+ecl (if (use-ecl-byte-compiler-p)
     2507              (list f)
     2508              (list (compile-file-pathname p :type :object) f))
     2509    #+mkcl (list o f)
     2510    #-(or ecl mkcl) (list f)))
    24952511
    24962512(defmethod perform ((operation compile-op) (c static-file))
     
    25332549
    25342550(defmethod perform ((o load-op) (c cl-source-file))
    2535   (map () #'load (input-files o c)))
     2551  (map () #'load
     2552       #-(or ecl mkcl)
     2553       (input-files o c)
     2554       #+(or ecl mkcl)
     2555       (loop :for i :in (input-files o c)
     2556             :unless (string= (pathname-type i) "fas")
     2557             :collect (compile-file-pathname (lispize-pathname i)))))
    25362558
    25372559(defmethod perform ((operation load-op) (c static-file))
     
    27372759        operate-docstring))
    27382760
    2739 (defun* load-system (system &rest args &key force verbose version &allow-other-keys)
     2761(defun* load-system (system &rest keys &key force verbose version &allow-other-keys)
    27402762  "Shorthand for `(operate 'asdf:load-op system)`.
    27412763See OPERATE for details."
    27422764  (declare (ignore force verbose version))
    2743   (apply 'operate 'load-op system args)
     2765  (apply 'operate *load-system-operation* system keys)
    27442766  t)
    27452767
     
    27532775  (remove-if-not 'component-loaded-p (registered-systems)))
    27542776
    2755 (defun require-system (s)
    2756   (load-system s :force-not (loaded-systems)))
     2777(defun require-system (s &rest keys &key &allow-other-keys)
     2778  (apply 'load-system s :force-not (loaded-systems) keys))
    27572779
    27582780(defun* compile-system (system &rest args &key force verbose version
     
    30973119    (ccl::with-cstrs ((%command command)) (_system %command))
    30983120
     3121    #+mkcl
     3122    ;; This has next to no chance of working on basic Windows!
     3123    ;; Your best hope is that Cygwin or MSYS is somewhere in the PATH.
     3124    (multiple-value-bind (io process exit-code)
     3125        (apply #'mkcl:run-program #+windows "sh" #-windows "/bin/sh"
     3126                                  (list "-c" command)
     3127                                  :input nil :output t #|*verbose-out*|# ;; will be *verbose-out* when we support it
     3128                                  #-windows '(:search nil))
     3129      (declare (ignore io process))
     3130      exit-code)
     3131
    30993132    #+sbcl
    31003133    (sb-ext:process-exit-code
     
    31083141    (ext:run-shell-command command)
    31093142
    3110     #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mcl sbcl scl xcl)
     3143    #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mcl mkcl sbcl scl xcl)
    31113144    (error "RUN-SHELL-COMMAND not implemented for this Lisp")))
    31123145
     
    31983231  (first-feature
    31993232   '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp) :cmu
    3200      :ecl :gcl (:lw :lispworks) :mcl :sbcl :scl :symbolics :xcl)))
     3233     :ecl :gcl (:lw :lispworks) :mcl :mkcl :sbcl :scl :symbolics :xcl)))
    32013234
    32023235(defun operating-system ()
     
    32333266     (list
    32343267      #+allegro
    3235       (format nil "~A~A~@[~A~]"
     3268      (format nil "~A~@[~A~]~@[~A~]~@[~A~]"
    32363269              excl::*common-lisp-version-number*
    3237               ;; ANSI vs MoDeRn - thanks to Robert Goldman and Charley Cox
    3238               (if (eq excl:*current-case-mode* :case-sensitive-lower) "M" "A")
     3270              ;; M means "modern", as opposed to ANSI-compatible mode (which I consider default)
     3271              (and (eq excl:*current-case-mode* :case-sensitive-lower) "M")
    32393272              ;; Note if not using International ACL
    32403273              ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm
    3241               (excl:ics-target-case (:-ics "8")))
     3274              (excl:ics-target-case (:-ics "8"))
     3275              (and (member :smp *features*) "S"))
    32423276      #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
    32433277      #+clisp
     
    32733307(defun* hostname ()
    32743308  ;; Note: untested on RMCL
    3275   #+(or abcl clozure cmucl ecl genera lispworks mcl sbcl scl xcl) (machine-instance)
     3309  #+(or abcl clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance)
    32763310  #+cormanlisp "localhost" ;; is there a better way? Does it matter?
    32773311  #+allegro (excl.osi:gethostname)
     
    32893323  (truenamize
    32903324   (pathname-directory-pathname
     3325    #+cormanlisp (ensure-directory-pathname (user-homedir-pathname))
    32913326    #+mcl (current-user-homedir-pathname)
    3292     #-mcl (user-homedir-pathname))))
     3327    #-(or cormanlisp mcl) (user-homedir-pathname))))
    32933328
    32943329(defun* ensure-pathname* (x want-absolute want-directory fmt &rest args)
     
    33053340                      x :separator (string (inter-directory-separator)))
    33063341        :collect (apply 'ensure-pathname* dir want-absolute want-directory fmt args)))
    3307 (defun getenv-pathname (x &key want-absolute want-directory &aux (s (getenv x)))
     3342(defun* getenv-pathname (x &key want-absolute want-directory &aux (s (getenv x)))
    33083343  (ensure-pathname* s want-absolute want-directory "from (getenv ~S)" x))
    3309 (defun getenv-pathnames (x &key want-absolute want-directory &aux (s (getenv x)))
     3344(defun* getenv-pathnames (x &key want-absolute want-directory &aux (s (getenv x)))
    33103345  (and (plusp (length s))
    33113346       (split-pathnames* s want-absolute want-directory "from (getenv ~S) = ~S" x s)))
    3312 (defun getenv-absolute-directory (x)
     3347(defun* getenv-absolute-directory (x)
    33133348  (getenv-pathname x :want-absolute t :want-directory t))
    3314 (defun getenv-absolute-directories (x)
     3349(defun* getenv-absolute-directories (x)
    33153350  (getenv-pathnames x :want-absolute t :want-directory t))
    33163351
     3352(defun* get-folder-path (folder)
     3353  (or ;; this semi-portably implements a subset of the functionality of lispworks' sys:get-folder-path
     3354   #+(and lispworks mswindows) (sys:get-folder-path folder)
     3355   ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
     3356   (ecase folder
     3357    (:local-appdata (getenv-absolute-directory "LOCALAPPDATA"))
     3358    (:appdata (getenv-absolute-directory "APPDATA"))
     3359    (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA")
     3360                         (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))))))
    33173361
    33183362(defun* user-configuration-directories ()
     
    33243368                  :collect (subpathname* dir "common-lisp/"))))
    33253369           ,@(when (os-windows-p)
    3326                `(,(subpathname* (or #+lispworks (sys:get-folder-path :local-appdata)
    3327                                     (getenv-absolute-directory "LOCALAPPDATA"))
    3328                                "common-lisp/config/")
    3329                  ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
    3330                  ,(subpathname* (or #+lispworks (sys:get-folder-path :appdata)
    3331                                     (getenv-absolute-directory "APPDATA"))
    3332                                 "common-lisp/config/")))
     3370               `(,(subpathname* (get-folder-path :local-appdata) "common-lisp/config/")
     3371                 ,(subpathname* (get-folder-path :appdata) "common-lisp/config/")))
    33333372           ,(subpathname (user-homedir) ".config/common-lisp/"))))
    33343373    (remove-duplicates (remove-if-not #'absolute-pathname-p dirs)
     
    33413380     (aif
    33423381      ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData
    3343       (subpathname* (or #+lispworks (sys:get-folder-path :common-appdata)
    3344                         (getenv-absolute-directory "ALLUSERSAPPDATA")
    3345                         (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))
    3346                     "common-lisp/config/")
     3382      (subpathname* (get-folder-path :common-appdata) "common-lisp/config/")
    33473383      (list it)))))
    33483384
     
    34693505     (try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation)
    34703506     (when (os-windows-p)
    3471        (try (or #+lispworks (sys:get-folder-path :local-appdata)
    3472                 (getenv-absolute-directory "LOCALAPPDATA")
    3473                 #+lispworks (sys:get-folder-path :appdata)
    3474                 (getenv-absolute-directory "APPDATA"))
     3507       (try (or (get-folder-path :local-appdata)
     3508                (get-folder-path :appdata))
    34753509            "common-lisp" "cache" :implementation))
    34763510     '(:home ".cache" "common-lisp" :implementation))))
     
    36993733              (when h `((,(truenamize h) ,*wild-inferiors*) ())))
    37003734    ;; The below two are not needed: no precompiled ASDF system there
    3701     #+ecl (,(translate-logical-pathname "SYS:**;*.*") ())
     3735    #+(or ecl mkcl) (,(translate-logical-pathname "SYS:**;*.*") ())
     3736    #+mkcl (,(translate-logical-pathname "CONTRIB:") ())
    37023737    ;; #+clozure ,(ignore-errors (list (wilden (let ((*default-pathname-defaults* #p"")) (truename #p"ccl:"))) ()))
    37033738    ;; All-import, here is where we want user stuff to be:
     
    38763911      ;; what cfp should be doing, w/ mp* instead of mp
    38773912      (let* ((type (pathname-type (apply 'compile-file-pathname "x.lisp" keys)))
    3878              (defaults (make-pathname
    3879                         :type type :defaults (merge-pathnames* input-file))))
    3880         (merge-pathnames* output-file defaults))
     3913             (defaults (make-pathname
     3914                        :type type :defaults (merge-pathnames* input-file))))
     3915        (merge-pathnames* output-file defaults))
    38813916      (apply-output-translations
    3882        (apply 'compile-file-pathname input-file keys))))
     3917       (apply 'compile-file-pathname input-file
     3918              (if output-file keys (remove-keyword :output-file keys))))))
    38833919
    38843920(defun* tmpize-pathname (x)
     
    39553991         (subpathname (user-homedir) ".fasls/")) ;; Use ".cache/common-lisp/" instead ???
    39563992     (include-per-user-information nil)
    3957      (map-all-source-files (or #+(or ecl clisp) t nil))
     3993     (map-all-source-files (or #+(or clisp ecl mkcl) t nil))
    39583994     (source-to-target-mappings nil))
    3959   #+(or ecl clisp)
     3995  #+(or clisp ecl mkcl)
    39603996  (when (null map-all-source-files)
    3961     (error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on ECL and CLISP"))
     3997    (error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on CLISP, ECL and MKCL"))
    39623998  (let* ((fasl-type (pathname-type (compile-file-pathname "foo.lisp")))
    39633999         (mapped-files (if map-all-source-files *wild-file*
     
    41624198             (setf inherit t)
    41634199             (push ':inherit-configuration directives))
    4164             ((ends-with s "//") ;; TODO: allow for doubling of separator even outside Unix?
     4200            ((string-suffix-p s "//") ;; TODO: allow for doubling of separator even outside Unix?
    41654201             (push `(:tree ,(check (subseq s 0 (- (length s) 2)))) directives))
    41664202            (t
     
    41934229(defun* wrapping-source-registry ()
    41944230  `(:source-registry
     4231    #+ecl (:tree ,(translate-logical-pathname "SYS:"))
     4232    #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
    41954233    #+sbcl (:tree ,(truenamize (getenv-pathname "SBCL_HOME" :want-directory t)))
    41964234    :inherit-configuration
     
    42014239    #+sbcl (:directory ,(subpathname (user-homedir) ".sbcl/systems/"))
    42024240    (:directory ,(default-directory))
    4203       ,@(loop :for dir :in
    4204           `(,@(when (os-unix-p)
    4205                 `(,(or (getenv-absolute-directory "XDG_DATA_HOME")
    4206                        (subpathname (user-homedir) ".local/share/"))
    4207                   ,@(or (getenv-absolute-directories "XDG_DATA_DIRS")
    4208                         '("/usr/local/share" "/usr/share"))))
    4209             ,@(when (os-windows-p)
    4210                 `(,(or #+lispworks (sys:get-folder-path :local-appdata)
    4211                        (getenv-absolute-directory "LOCALAPPDATA"))
    4212                   ,(or #+lispworks (sys:get-folder-path :appdata)
    4213                        (getenv-absolute-directory "APPDATA"))
    4214                   ,(or #+lispworks (sys:get-folder-path :common-appdata)
    4215                        (getenv-absolute-directory "ALLUSERSAPPDATA")
    4216                        (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/")))))
    4217           :collect `(:directory ,(subpathname* dir "common-lisp/systems/"))
    4218           :collect `(:tree ,(subpathname* dir "common-lisp/source/")))
    4219       :inherit-configuration))
     4241    ,@(loop :for dir :in
     4242        `(,@(when (os-unix-p)
     4243              `(,(or (getenv-absolute-directory "XDG_DATA_HOME")
     4244                     (subpathname (user-homedir) ".local/share/"))
     4245                ,@(or (getenv-absolute-directories "XDG_DATA_DIRS")
     4246                      '("/usr/local/share" "/usr/share"))))
     4247          ,@(when (os-windows-p)
     4248              (mapcar 'get-folder-path '(:local-appdata :appdata :common-appdata))))
     4249        :collect `(:directory ,(subpathname* dir "common-lisp/systems/"))
     4250        :collect `(:tree ,(subpathname* dir "common-lisp/source/")))
     4251    :inherit-configuration))
    42204252(defun* user-source-registry (&key (direction :input))
    42214253  (in-user-configuration-directory *source-registry-file* :direction direction))
     
    43634395
    43644396
    4365 ;;; ECL support for COMPILE-OP / LOAD-OP
     4397;;; ECL and MKCL support for COMPILE-OP / LOAD-OP
    43664398;;;
    4367 ;;; In ECL, these operations produce both FASL files and the
    4368 ;;; object files that they are built from. Having both of them allows
    4369 ;;; us to later on reuse the object files for bundles, libraries,
    4370 ;;; standalone executables, etc.
     4399;;; In ECL and MKCL, these operations produce both
     4400;;; FASL files and the object files that they are built from.
     4401;;; Having both of them allows us to later on reuse the object files
     4402;;; for bundles, libraries, standalone executables, etc.
    43714403;;;
    43724404;;; This has to be in asdf.lisp and not asdf-ecl.lisp, or else it becomes
    43734405;;; a problem for asdf on ECL to compile asdf-ecl.lisp after loading asdf.lisp.
    43744406;;;
    4375 #+ecl
     4407;;; Also, register-pre-built-system.
     4408
     4409#+(or ecl mkcl)
    43764410(progn
    4377   (setf *compile-op-compile-file-function* 'ecl-compile-file)
    4378 
    4379   (defun ecl-compile-file (input-file &rest keys &key &allow-other-keys)
    4380     (if (use-ecl-byte-compiler-p)
    4381         (apply 'compile-file* input-file keys)
    4382         (multiple-value-bind (object-file flags1 flags2)
    4383             (apply 'compile-file* input-file :system-p t keys)
    4384           (values (and object-file
    4385                        (c::build-fasl (compile-file-pathname object-file :type :fasl)
    4386                                       :lisp-files (list object-file))
    4387                        object-file)
    4388                   flags1
    4389                   flags2))))
    4390 
    4391   (defmethod output-files ((operation compile-op) (c cl-source-file))
    4392     (declare (ignorable operation))
    4393     (let* ((p (lispize-pathname (component-pathname c)))
    4394            (f (compile-file-pathname p :type :fasl)))
    4395       (if (use-ecl-byte-compiler-p)
    4396           (list f)
    4397           (list (compile-file-pathname p :type :object) f))))
    4398 
    4399   (defmethod perform ((o load-op) (c cl-source-file))
    4400     (map () #'load
    4401          (loop :for i :in (input-files o c)
    4402            :unless (string= (pathname-type i) "fas")
    4403                :collect (compile-file-pathname (lispize-pathname i))))))
    4404 
    4405 ;;;; -----------------------------------------------------------------
    4406 ;;;; Hook into REQUIRE for ABCL, CLISP, ClozureCL, CMUCL, ECL and SBCL
     4411  (defun register-pre-built-system (name)
     4412    (register-system (make-instance 'system :name (coerce-name name) :source-file nil)))
     4413
     4414  #+(or (and ecl win32) (and mkcl windows))
     4415  (unless (assoc "asd" #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* :test 'equal)
     4416    (appendf #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* '(("asd" . si::load-source))))
     4417
     4418  (setf #+ecl ext:*module-provider-functions* #+mkcl mk-ext::*module-provider-functions*
     4419        (loop :for f :in #+ecl ext:*module-provider-functions*
     4420          #+mkcl mk-ext::*module-provider-functions*
     4421          :unless (eq f 'module-provide-asdf)
     4422          :collect #'(lambda (name)
     4423                       (let ((l (multiple-value-list (funcall f name))))
     4424                         (and (first l) (register-pre-built-system (coerce-name name)))
     4425                         (values-list l)))))
     4426
     4427  (setf *compile-op-compile-file-function* 'compile-file-keeping-object)
     4428
     4429  (defun compile-file-keeping-object (input-file &rest keys &key &allow-other-keys)
     4430    (#+ecl if #+ecl (use-ecl-byte-compiler-p) #+ecl (apply 'compile-file* input-file keys)
     4431     #+mkcl progn
     4432     (multiple-value-bind (object-file flags1 flags2)
     4433         (apply 'compile-file* input-file
     4434                #+ecl :system-p #+ecl t #+mkcl :fasl-p #+mkcl nil keys)
     4435       (values (and object-file
     4436                    (compiler::build-fasl
     4437                     (compile-file-pathname object-file
     4438                                            #+ecl :type #+ecl :fasl #+mkcl :fasl-p #+mkcl t)
     4439                     #+ecl :lisp-files #+mkcl :lisp-object-files (list object-file))
     4440                    object-file)
     4441               flags1
     4442               flags2)))))
     4443
     4444;;;; -----------------------------------------------------------------------
     4445;;;; Hook into REQUIRE for ABCL, CLISP, ClozureCL, CMUCL, ECL, MKCL and SBCL
    44074446;;;;
    4408 (defvar *require-asdf-operator* 'load-op)
    4409 
    44104447(defun* module-provide-asdf (name)
    44114448  (handler-bind
     
    44194456          (system (find-system (string-downcase name) nil)))
    44204457      (when system
    4421         (operate *require-asdf-operator* system :verbose nil :force-not (loaded-systems))
     4458        (require-system system :verbose nil)
    44224459        t))))
    44234460
    4424 #+(or abcl clisp clozure cmu ecl sbcl)
     4461#+(or abcl clisp clozure cmu ecl mkcl sbcl)
    44254462(let ((x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom))))
    44264463  (when x
     
    44304467            #+clozure ccl:*module-provider-functions*
    44314468            #+(or cmu ecl) ext:*module-provider-functions*
     4469            #+mkcl mk-ext:*module-provider-functions*
    44324470            #+sbcl sb-ext:*module-provider-functions*))))
    44334471
     
    44494487  (asdf-message ";; ASDF, version ~a~%" (asdf-version)))
    44504488
     4489#+mkcl
     4490(progn
     4491  (defvar *loading-asdf-bundle* nil)
     4492  (unless *loading-asdf-bundle*
     4493    (let ((*central-registry*
     4494           (cons (translate-logical-pathname #P"CONTRIB:asdf-bundle;") *central-registry*))
     4495          (*loading-asdf-bundle* t))
     4496      (clear-system :asdf-bundle) ;; we hope to force a reload.
     4497      (multiple-value-bind (result bundling-error)
     4498          (ignore-errors (asdf:oos 'asdf:load-op :asdf-bundle))
     4499        (unless result
     4500          (format *error-output*
     4501                  "~&;;; ASDF: Failed to load package 'asdf-bundle'!~%;;; ASDF: Reason is: ~A.~%"
     4502                  bundling-error))))))
     4503
    44514504#+allegro
    44524505(eval-when (:compile-toplevel :execute)
Note: See TracChangeset for help on using the changeset viewer.