GitLab

at 2017-04-08T19:42:18-07:00

Changes to allow building CMUCL under FreeBSD 10 and later.

Final cleaned-up changes for FreeBSD 10.

Add a note about FreeBSD 10+ requirements.

Test the commit email stuff with bogus change.

Undo bogus change.

Bogus change for testing #2.

Still testing email.

Edit to test commit list.

Upgrade to ASDF 3.2.1.

Update ASDF documentation to 3.2.1

Update

    means the vendor-supplied C compiler.  The compiler must be

    available under the name specified by your ports Config file.

+   Note for FreeBSD 10 and above: The build requires gcc (Clang will

+   not work) and the lib32 compatiblity package.

+

 c) GNU make

    This has to be available either as gmake or make in your PATH, or

 -c, -r, and -l options for cross-build-world.sh.  The -c option cleans

 out the targe and cross directories; -r does step 4; and -l does step

 5.

+===============
 ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-

-;;; This is ASDF 3.2.0: Another System Definition Facility.

+;;; This is ASDF 3.2.1: Another System Definition Facility.

 ;;;

 ;;; Feedback, bug reports, and patches are all welcome:

 ;;; please mail to <asdf-devel@common-lisp.net>.

      (format-control :initarg :format-control)

      (format-arguments :initarg :format-arguments))

     (:report (lambda (condition stream)

-               (format stream "Not implemented: ~s~@[ ~?~]"

+               (format stream "Not (currently) implemented on ~A: ~S~@[ ~?~]"

+                       (nth-value 1 (symbol-call :uiop :implementation-type))

                        (slot-value condition 'functionality)

                        (slot-value condition 'format-control)

                        (slot-value condition 'format-arguments)))))

 (in-package :uiop/version)

 (with-upgradability ()

-  (defparameter *uiop-version* "3.2.0")

+  (defparameter *uiop-version* "3.2.1")

   (defun unparse-version (version-list)

     "From a parsed version (a list of natural numbers), compute the version string"

       ((eq :not (car x)) (assert (null (cddr x))) (not (featurep (cadr x))))

       ((eq :or (car x)) (some #'featurep (cdr x)))

       ((eq :and (car x)) (every #'featurep (cdr x)))

-      (t (error "Malformed feature specification ~S" x))))

+      (t (parameter-error "~S: malformed feature specification ~S" 'featurep x))))

   ;; Starting with UIOP 3.1.5, these are runtime tests.

   ;; You may bind *features* with a copy of what your target system offers to test its properties.

     #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)

     #+sbcl (sb-ext:posix-getenv x)

     #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)

-    (error "~S is not supported on your implementation" 'getenv))

+    (not-implemented-error 'getenv))

   (defsetf getenv (x) (val)

     "Set an environment variable."

     #+mkcl `(mkcl:setenv ,x ,val)

     #+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))

     #-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl)

-    '(error "~S ~S is not supported on your implementation" 'setf 'getenv))

+    '(not-implemented-error '(setf getenv)))

   (defun getenvp (x)

     "Predicate that is true if the named variable is present in the libc environment,

                       (ecase ext:*case-mode* (:upper "") (:lower "l")))

         #+ecl (format nil "~A~@[-~A~]" s

                       (let ((vcs-id (ext:lisp-implementation-vcs-id)))

-                        (subseq vcs-id 0 (min (length vcs-id) 8))))

+                        (unless (equal vcs-id "UNKNOWN")

+                          (subseq vcs-id 0 (min (length vcs-id) 8)))))

         #+gcl (subseq s (1+ (position #\space s)))

         #+genera

         (multiple-value-bind (major minor) (sct:get-system-version "System")

         #+mkcl (mk-ext:getcwd)

         #+sbcl (sb-ext:parse-native-namestring (sb-unix:posix-getcwd/))

         #+xcl (extensions:current-directory)

-        (error "getcwd not supported on your implementation")))

+        (not-implemented-error 'getcwd)))

   (defun chdir (x)

     "Change current directory, as per POSIX chdir(2), to a given pathname object"

       #+mkcl (mk-ext:chdir x)

       #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :chdir (sb-ext:native-namestring x)))

       #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mkcl sbcl scl xcl)

-      (error "chdir not supported on your implementation"))))

+      (not-implemented-error 'chdir))))

 ;;;; -----------------------------------------------------------------

       ((consp directory)

        (cons :relative directory))

       (t

-       (error (compatfmt "~@<Unrecognized pathname directory component ~S~@:>") directory))))

+       (parameter-error (compatfmt "~@<~S: Unrecognized pathname directory component ~S~@:>")

+                        'normalize-pathname-directory-component directory))))

   (defun denormalize-pathname-directory-component (directory-component)

     "Convert the DIRECTORY-COMPONENT from a CLHS-standard format to a format usable

       ((or null string) pathname)

       (pathname

        (with-output-to-string (s)

-         (flet ((err () #+lispworks (describe pathname) (error "Not a valid unix-namestring ~S" pathname)))

+         (flet ((err () (parameter-error "~S: invalid unix-namestring ~S"

+                                         'unix-namestring pathname)))

            (let* ((dir (normalize-pathname-directory-component (pathname-directory pathname)))

                   (name (pathname-name pathname))

                   (name (and (not (eq name :unspecific)) name))

       ((eq destination t)

        path)

       ((not (pathnamep destination))

-       (error "Invalid destination"))

+       (parameter-error "~S: Invalid destination" 'translate-pathname*))

       ((not (absolute-pathname-p destination))

        (translate-pathname path absolute-source (merge-pathnames* destination root)))

       (root

         ;; logical pathnames have restrictions on wild patterns.

         ;; Not that the results are very portable when you use these patterns on physical pathnames.

         (when (wild-pathname-p dir)

-          (error "Invalid wild pattern in logical directory ~S" directory))

+          (parameter-error "~S: Invalid wild pattern in logical directory ~S"

+                           'directory-files directory))

         (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal)

-          (error "Invalid file pattern ~S for logical directory ~S" pattern directory))

+          (parameter-error "~S: Invalid file pattern ~S for logical directory ~S" 'directory-files pattern directory))

         (setf pattern (make-pathname-logical pattern (pathname-host dir))))

       (let* ((pat (merge-pathnames* pattern dir))

              (entries (ignore-errors (directory* pat))))

 check constraints and normalize each one as per ENSURE-PATHNAME.

        Any empty entries in the environment variable X will be returned as NILs."

     (unless (getf constraints :empty-is-nil t)

-      (error "Cannot have EMPTY-IS-NIL false for GETENV-PATHNAMES."))

+      (parameter-error "Cannot have EMPTY-IS-NIL false for ~S" 'getenv-pathnames))

     (apply 'split-native-pathnames-string (getenvp x)

            :on-error (or on-error

                          `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathnames ,x))

     (cond

       ((not (and (pathnamep directory-pathname) (directory-pathname-p directory-pathname)

                  (physical-pathname-p directory-pathname) (not (wild-pathname-p directory-pathname))))

-       (error "~S was asked to delete ~S but it is not a physical non-wildcard directory pathname"

+       (parameter-error "~S was asked to delete ~S but it is not a physical non-wildcard directory pathname"

               'delete-directory-tree directory-pathname))

       ((not validatep)

-       (error "~S was asked to delete ~S but was not provided a validation predicate"

+       (parameter-error "~S was asked to delete ~S but was not provided a validation predicate"

               'delete-directory-tree directory-pathname))

       ((not (call-function validate directory-pathname))

-       (error "~S was asked to delete ~S but it is not valid ~@[according to ~S~]"

+       (parameter-error "~S was asked to delete ~S but it is not valid ~@[according to ~S~]"

               'delete-directory-tree directory-pathname validate))

       ((not (directory-exists-p directory-pathname))

        (ecase if-does-not-exist

                  (exit `(,exit :code code :abort (not finish-output)))

                  (quit `(,quit :unix-status code :recklessly-p (not finish-output)))))

     #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)

-    (error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code))

+    (not-implemented-error 'quit "(called with exit code ~S)" code))

   (defun die (code format &rest arguments)

     "Die in error with some error message"

     (setf *image-restored-p* nil)

     #-(or clisp clozure (and cmucl executable) lispworks sbcl scl)

     (when executable

-      (error "Dumping an executable is not supported on this implementation! Aborting."))

+      (not-implemented-error 'dump-image "dumping an executable"))

     #+allegro

     (progn

       (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000

               ;; the default is :console - only works with SBCL 1.1.15 or later.

               (when application-type (list :application-type application-type)))))

     #-(or allegro clisp clozure cmucl gcl lispworks sbcl scl)

-    (error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"

-           'dump-image filename (nth-value 1 (implementation-type))))

+    (not-implemented-error 'dump-image))

   (defun create-image (destination lisp-object-files

                        &key kind output-name prologue-code epilogue-code extra-object-files

                             (shell-boolean-exit

                              (restore-image))))))))

                  (when forms `(progn ,@forms))))))

-      #+(or clasp ecl) (check-type kind (member :dll :lib :static-library :program :object :fasl))

+      #+(or clasp ecl mkcl)

+      (check-type kind (member :dll :shared-library :lib :static-library

+                               :fasl :fasb :program))

       (apply #+clasp 'cmp:builder #+clasp kind

-             #+ecl 'c::builder #+ecl kind

-             #+mkcl (ecase kind

-                      ((:dll) 'compiler::build-shared-library)

-                      ((:lib :static-library) 'compiler::build-static-library)

-                      ((:fasl) 'compiler::build-bundle)

-                      ((:program) 'compiler::build-program))

+             #+(or ecl mkcl)

+             (ecase kind

+               ((:dll :shared-library)

+                #+ecl 'c::build-shared-library #+mkcl 'compiler:build-shared-library)

+               ((:lib :static-library)

+                #+ecl 'c::build-static-library #+mkcl 'compiler:build-static-library)

+               ((:fasl #+ecl :fasb)

+                #+ecl 'c::build-fasl #+mkcl 'compiler:build-fasl)

+               #+mkcl ((:fasb) 'compiler:build-bundle)

+               ((:program)

+                #+ecl 'c::build-program #+mkcl 'compiler:build-program))

              (pathname destination)

-             #+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files (append lisp-object-files #+(or clasp ecl) extra-object-files)

-             #+(or clasp ecl) :init-name #+(or clasp ecl) (c::compute-init-name (or output-name destination) :kind kind)

+             #+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files

+             (append lisp-object-files #+(or clasp ecl) extra-object-files)

+             #+ecl :init-name

+             #+ecl (c::compute-init-name (or output-name destination)

+                                         :kind (if (eq kind :fasb) :fasl kind))

              (append

               (when prologue-code `(:prologue-code ,prologue-code))

               (when epilogue-code `(:epilogue-code ,epilogue-code))

   (defun combine-fasls (inputs output)

     "Combine a list of FASLs INPUTS into a single FASL OUTPUT"

     #-(or abcl allegro clisp clozure cmucl lispworks sbcl scl xcl)

-    (error "~A does not support ~S~%inputs ~S~%output  ~S"

-           (implementation-type) 'combine-fasls inputs output)

+    (not-implemented-error 'combine-fasls "~%inputs: ~S~%output: ~S" inputs output)

     #+abcl (funcall 'sys::concatenate-fasls inputs output) ; requires ABCL 1.2.0

     #+(or allegro clisp cmucl sbcl scl xcl) (concatenate-files inputs output)

     #+clozure (ccl:fasl-concatenate output inputs :if-exists :supersede)

     (some

      (cond

        ((and good-chars bad-chars)

-        (error "only one of good-chars and bad-chars can be provided"))

+        (parameter-error "~S: only one of good-chars and bad-chars can be provided"

+                         'requires-escaping-p))

        ((typep good-chars 'function)

         (complement good-chars))

        ((typep bad-chars 'function)

         #'(lambda (c) (not (find c good-chars))))

        ((and bad-chars (typep bad-chars 'sequence))

         #'(lambda (c) (find c bad-chars)))

-       (t (error "requires-escaping-p: no good-char criterion")))

+       (t (parameter-error "~S: no good-char criterion" 'requires-escaping-p)))

      token))

   (defun escape-token (token &key stream quote good-chars bad-chars escaper)

 race conditions."

     (declare (ignorable urgent))

     #+abcl (sys:process-kill (slot-value process-info 'process))

+    #+clasp (mp:process-kill (slot-value process-info 'process))

     ;; On ECL, this will only work on versions later than 2016-09-06,

     ;; but we still want to compile on earlier versions, so we use symbol-call

     #+ecl (symbol-call :ext :terminate-process (slot-value process-info 'process) urgent)

     #+lispworks7+ (sys:pipe-kill-process (slot-value process-info 'process))

     #+mkcl (mk-ext:terminate-process (slot-value process-info 'process)

                                      :force urgent)

-    #-(or abcl ecl lispworks7+ mkcl)

+    #-(or abcl clasp ecl lispworks7+ mkcl)

     (os-cond

      ((os-unix-p) (%posix-send-signal process-info (if urgent 9 15)))

      ((os-windows-p) (if-let (pid (process-info-pid process-info))

        (%handle-if-does-not-exist input if-input-does-not-exist)

        (%handle-if-exists output if-output-exists)

        (%handle-if-exists error-output if-error-output-exists))

+     #+ecl (let ((*standard-input* *stdin*)

+                 (*standard-output* *stdout*)

+                 (*error-output* *stderr*)))

      (let ((process-info (make-instance 'process-info))

            (input (%normalize-io-specifier input :input))

            (output (%normalize-io-specifier output :output))

               #+os-unix (list command)

               #+os-windows

               (string

+               ;; NB: On other Windows implementations, this is utterly bogus

+               ;; except in the most trivial cases where no quoting is needed.

+               ;; Use at your own risk.

+               #-(or allegro clisp clozure ecl)

+               (nest

+                #+(or ecl sbcl) (unless (find-symbol* :escape-arguments #+ecl :ext #+sbcl :sb-impl nil))

+                (parameter-error "~S doesn't support string commands on Windows on this Lisp"

+                                 'launch-program command))

                ;; NB: We add cmd /c here. Behavior without going through cmd is not well specified

                ;; when the command contains spaces or special characters:

                ;; IIUC, the system will use space as a separator,

                ;; On ClozureCL for Windows, we assume you are using

                ;; r15398 or later in 1.9 or later,

                ;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858

+               ;; On ECL, commit 2040629 https://gitlab.com/embeddable-common-lisp/ecl/issues/304

                ;; On SBCL, we assume the patch from fcae0fd (to be part of SBCL 1.3.13)

-               #+(or clozure sbcl) (cons "cmd" (strcat "/c " command))

-               ;; NB: On other Windows implementations, this is utterly bogus

-               ;; except in the most trivial cases where no quoting is needed.

-               ;; Use at your own risk.

-               #-(or allegro clisp clozure sbcl)

-               (parameter-error "~S doesn't support string commands on Windows on this lisp: ~S"

-                                'launch-program command))

+               #+(or clozure ecl sbcl) (cons "cmd" (strcat "/c " command)))

               #+os-windows

               (list

                #+allegro (escape-windows-command command)

      #+(or abcl (and allegro os-unix) clozure cmucl ecl mkcl sbcl)

      (let ((program (car command))

            #-allegro (arguments (cdr command))))

-     #+(and sbcl os-windows)

+     #+(and (or ecl sbcl) os-windows)

      (multiple-value-bind (arguments escape-arguments)

          (if (listp arguments)

              (values arguments t)

            #+mkcl 'mk-ext:run-program

            #+sbcl 'sb-ext:run-program

            #+(or abcl clozure cmucl ecl mkcl sbcl) ,@'(program arguments)

-           #+(and sbcl os-windows) ,@'(:escape-arguments escape-arguments)

+           #+(and (or ecl sbcl) os-windows) ,@'(:escape-arguments escape-arguments)

            :input input :if-input-does-not-exist :error

            :output output :if-output-exists :append

            ,(or #+(or allegro lispworks) :error-output :error) error-output

         stream x

         :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))

       (t

-       (error "Invalid ~S destination ~S" 'slurp-input-stream x)))))

+       (parameter-error "Invalid ~S destination ~S" 'slurp-input-stream x)))))

 ;;;; Vomiting a stream, typically into the input of another program.

 (with-upgradability ()

         x stream

         :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))

       (t

-       (error "Invalid ~S source ~S" 'vomit-output-stream x)))))

+       (parameter-error "Invalid ~S source ~S" 'vomit-output-stream x)))))

 ;;;; Run-program: synchronously run a program in a subprocess, handling input, output and error-output.

            (activity-spec (if (eq actual-spec :output)

                               (ecase direction

                                 ((:input :output)

-                                 (error "~S not allowed as a ~S ~S spec"

-                                        :output 'run-program direction))

+                                 (parameter-error "~S does not allow ~S as a ~S spec"

+                                                  'run-program :output direction))

                                 ((:error-output)

                                  nil))

                               actual-spec)))

   (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM

     (etypecase command

-      (string

-       (os-cond

-        ((os-windows-p)

-         #+(or allegro clisp ecl)

-         (strcat "cmd" " /c " command)

-         #-(or allegro clisp ecl) command)

-        (t command)))

+      (string command)

       (list (escape-shell-command

              (os-cond

               ((os-unix-p) (cons "exec" command))

-              ((os-windows-p)

-               #+(or allegro clisp ecl sbcl)

-               (list* "cmd" "/c" command)

-               #-(or allegro clisp ecl sbcl) command)

               (t command))))))

   (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM

 subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see

 also \"Configuration DSL\"\) in the ASDF manual."

     (mapcar #'(lambda (d) (resolve-location `(,d ,more)))

-            (or (getenv-absolute-directories "XDG_DATA_DIRS")

+            (or (remove nil (getenv-absolute-directories "XDG_DATA_DIRS"))

                 (os-cond

                  ((os-windows-p) (mapcar 'get-folder-path '(:appdata :common-appdata)))

                  (t (mapcar 'parse-unix-namestring '("/usr/local/share/" "/usr/share/")))))))

 subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see

 also \"Configuration DSL\"\) in the ASDF manual."

     (mapcar #'(lambda (d) (resolve-location `(,d ,more)))

-            (or (getenv-absolute-directories "XDG_CONFIG_DIRS")

+            (or (remove nil (getenv-absolute-directories "XDG_CONFIG_DIRS"))

                 (os-cond

                  ((os-windows-p) (xdg-data-dirs "config/"))

                  (t (mapcar 'parse-unix-namestring '("/etc/xdg/")))))))

 (in-package :uiop/backward-driver)

 (eval-when (:compile-toplevel :load-toplevel :execute)

-(with-deprecation ((version-deprecation *uiop-version* :style-warning "3.2.0" :warning "3.2.1"))

+(with-deprecation ((version-deprecation *uiop-version* :style-warning "3.2"))

   ;; Backward compatibility with ASDF 2.000 to 2.26

   ;; For backward-compatibility only, for people using internals

   ;; This public variable will be bound shortly to the currently loaded version of ASDF.

   (defvar *asdf-version* nil)

   ;; We need to clear systems from versions older than the one in this (private) parameter.

-  ;; The latest incompatible defclass is 2.32.13 renaming a slot in component;

+  ;; The latest incompatible defclass is 2.32.13 renaming a slot in component,

+  ;; or 3.2.0.2 for CCL (incompatibly changing some superclasses).

   ;; the latest incompatible gf change is in 3.1.7.20 (see redefined-functions below).

-  (defparameter *oldest-forward-compatible-asdf-version* "3.1.7.20")

+  (defparameter *oldest-forward-compatible-asdf-version* "3.2.0.2")

   ;; Semi-private variable: a designator for a stream on which to output ASDF progress messages

   (defvar *verbose-out* nil)

   ;; Private function by which ASDF outputs progress messages and warning messages:

          ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5.

          ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5

          ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67

-         (asdf-version "3.2.0")

+         (asdf-version "3.2.1")

          (existing-version (asdf-version)))

     (setf *asdf-version* asdf-version)

     (when (and existing-version (not (equal asdf-version existing-version)))

         (redefined-classes

          ;; redefining the classes causes interim circularities

          ;; with the old ASDF during upgrade, and many implementations bork

-         '((#:compile-concatenated-source-op (#:operation) ()))))

+         #-clozure ()

+         #+clozure

+         '((#:compile-concatenated-source-op (#:operation) ())

+           (#:compile-bundle-op (#:operation) ())

+           (#:concatenate-source-op (#:operation) ())

+           (#:dll-op (#:operation) ())

+           (#:lib-op (#:operation) ())

+           (#:monolithic-compile-bundle-op (#:operation) ())

+           (#:monolithic-concatenate-source-op (#:operation) ()))))

     (loop :for name :in redefined-functions

       :for sym = (find-symbol* name :asdf nil)

       :do (when sym (fmakunbound sym)))

   (:use :uiop/common-lisp :uiop :asdf/upgrade

    :asdf/component :asdf/system #:asdf/cache :asdf/find-system :asdf/find-component :asdf/operation)

   (:import-from :asdf/operation #:check-operation-constructor)

+  #-clisp (:unintern #:required-components #:traverse-action #:traverse-sub-actions)

   (:export

    #:action #:define-convenience-action-methods

    #:action-description

                    `(,function ,@prefix ,o ,c ,@suffix))))

         `(progn

            (defmethod ,function (,@prefix (,operation string) ,component ,@suffix ,@more-args)

+             (declare (notinline ,function))

              (let ((,component (find-component () ,component))) ;; do it first, for defsystem-depends-on

                ,(next-method `(safe-read-from-string ,operation :package :asdf/interface) component)))

            (defmethod ,function (,@prefix (,operation symbol) ,component ,@suffix ,@more-args)

+             (declare (notinline ,function))

              (if ,operation

                  ,(next-method

                    `(make-operation ,operation)

                    `(or (find-component () ,component) ,if-no-component))

                  ,if-no-operation))

            (defmethod ,function (,@prefix (,operation operation) ,component ,@suffix ,@more-args)

+             (declare (notinline ,function))

              (if (typep ,component 'component)

                  (error "No defined method for ~S on ~/asdf-action:format-action/"

                         ',function (make-action ,operation ,component))

 ;;;; Plan

 (uiop/package:define-package :asdf/plan

+  ;; asdf/action below is needed for required-components, traverse-action and traverse-sub-actions

+  ;; that used to live there before 3.2.0.

   (:recycle :asdf/plan :asdf)

   (:use :uiop/common-lisp :uiop :asdf/upgrade

    :asdf/component :asdf/operation :asdf/system

    #:build-op #:make

    #:load-system #:load-systems #:load-systems*

    #:compile-system #:test-system #:require-system

-   #:*load-system-operation* #:module-provide-asdf

+   #:module-provide-asdf

    #:component-loaded-p #:already-loaded-systems))

 (in-package :asdf/operate)

 ;;;; Common operations

-(with-upgradability ()

-  (defvar *load-system-operation* 'load-op

-    "Operation used by ASDF:LOAD-SYSTEM. By default, ASDF:LOAD-OP.

-You may override it with e.g. ASDF:LOAD-BUNDLE-OP from asdf/bundle

-or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.

-

-The default operation may change in the future if we implement a

-component-directed strategy for how to load or compile systems.")

-

-  ;; In prepare-op for a system, propagate *load-system-operation* rather than load-op

+(when-upgrading ()

   (defmethod component-depends-on ((o prepare-op) (s system))

-    (loop :for (do . dc) :in (call-next-method)

-          :collect (cons (if (eq do 'load-op) *load-system-operation* do) dc)))

-

+    (call-next-method)))

+(with-upgradability ()

   (defclass build-op (non-propagating-operation) ()

     (:documentation "Since ASDF3, BUILD-OP is the recommended 'master' operation,

 to operate by default on a system or component, via the function BUILD.

 Its meaning is configurable via the :BUILD-OPERATION option of a component.

 which typically specifies the name of a specific operation to which to delegate the build,

 as a symbol or as a string later read as a symbol (after loading the defsystem-depends-on);

-if NIL is specified (the default), BUILD-OP falls back to the *LOAD-SYSTEM-OPERATION*

-that will load the system in the current image, and its typically LOAD-OP."))

+if NIL is specified (the default), BUILD-OP falls back to LOAD-OP,

+that will load the system in the current image."))

   (defmethod component-depends-on ((o build-op) (c component))

-    `((,(or (component-build-operation c) *load-system-operation*) ,c)

+    `((,(or (component-build-operation c) 'load-op) ,c)

       ,@(call-next-method)))

   (defun make (system &rest keys)

     "The recommended way to interact with ASDF3.1 is via (ASDF:MAKE :FOO).

 It will build system FOO using the operation BUILD-OP,

 the meaning of which is configurable by the system, and

-defaults to *LOAD-SYSTEM-OPERATION*, usually LOAD-OP,

-to load it in current image."

+defaults to LOAD-OP, to load it in current image."

     (apply 'operate 'build-op system keys)

     t)

   (defun load-system (system &rest keys &key force force-not verbose version &allow-other-keys)

     "Shorthand for `(operate 'asdf:load-op system)`. See OPERATE for details."

     (declare (ignore force force-not verbose version))

-    (apply 'operate *load-system-operation* system keys)

+    (apply 'operate 'load-op system keys)

     t)

   (defun load-systems* (systems &rest keys)

     (let* ((module (or (required-module s) (coerce-name s)))

            (*modules-being-required* (cons module *modules-being-required*)))

       (assert (null (component-children s)))

-      ;; CMUCL likes its module names to be all upcase.

-      (require (nest #+cmucl (string-upcase) module))))

+      (require module)))

   (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments)

     (unless (and (length=n-p arguments 1)

     ;; cl:require and asdf:operate that could potentially blow up the stack,

     ;; all the while defeating the consistency of the dependency graph.

     (let* ((module (car arguments)) ;; NB: we already checked that it was not null

-           (name (string-downcase module))

-           (system (find-system name nil)))

-      (or system (let ((system (make-instance 'require-system :name name)))

+           ;; CMUCL, MKCL, SBCL like their module names to be all upcase.

+           (module-name (string module))

+           (system-name (string-downcase module))

+           (system (find-system system-name nil)))

+      (or system (let ((system (make-instance 'require-system :name system-name :module module-name)))

                    (register-system system)

                    system))))

     ;; with a name that is traditionally in lowercase. Case is lost along the way. That's fine.

     ;; We could make complex, non-portable rules to try to preserve case, and just documenting

     ;; them would be a hell that it would be a disservice to inflict on users.

-    (let ((module (string-downcase name)))

-      (unless (member module *modules-being-required* :test 'equal)

-        (let ((*modules-being-required* (cons module *modules-being-required*))

-              #+sbcl (sb-impl::*requiring* (remove module sb-impl::*requiring* :test 'equal)))

+    (let ((module-name (string name))

+          (system-name (string-downcase name)))

+      (unless (member module-name *modules-being-required* :test 'equal)

+        (let ((*modules-being-required* (cons module-name *modules-being-required*))

+              #+sbcl (sb-impl::*requiring* (remove module-name sb-impl::*requiring* :test 'equal)))

           (handler-bind

               ((style-warning #'muffle-warning)

                (missing-component (constantly nil))

                     (format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%")

                             name e))))

             (let ((*verbose-out* (make-broadcast-stream)))

-              (let ((system (find-system module nil)))

+              (let ((system (find-system system-name nil)))

                 (when system

-                  (require-system system :verbose nil)

+                  (require-system system-name :verbose nil)

                   t)))))))))

     (nest

      (with-asdf-cache ())

      (let* ((name (coerce-name name))

-            (source-file (if sfp source-file (resolve-symlinks* (load-pathname))))

-            (asd-name (and source-file

-                           (equalp "asd" (pathname-type source-file))

-                           (pathname-name source-file)))

+            (source-file (if sfp source-file (resolve-symlinks* (load-pathname))))))

+     (flet ((fix-case (x) (if (logical-pathname-p source-file) (string-downcase x) x))))

+     (let* ((asd-name (and source-file

+                           (equal "asd" (fix-case (pathname-type source-file)))

+                           (fix-case (pathname-name source-file))))

             (primary-name (primary-system-name name)))

        (when (and asd-name (not (equal asd-name primary-name)))

          (warn (make-condition 'bad-system-name :source-file source-file :name name))))

 (in-package :asdf/bundle)

 (with-upgradability ()

-  (defclass bundle-op (basic-compile-op)

+  (defclass bundle-op (operation)

     ;; NB: use of instance-allocated slots for operations is DEPRECATED

     ;; and only supported in a temporary fashion for backward compatibility.

     ;; Supported replacement: Define slots on program-system instead.

             ;; Using load-op as the goal operation and basic-compile-op as the keep-operation works

             ;; for our needs of gathering all the files we want to include in a bundle.

             ;; Note that we use basic-compile-op rather than compile-op so it will still work on

-            ;; systems when *load-system-operation* is load-bundle-op.

+            ;; systems that would somehow load dependencies with load-bundle-op.

             (required-components

              s :other-systems mono :component-type component-type :keep-component keep-component

              :goal-operation 'load-op :keep-operation 'basic-compile-op)))

       `((,go ,@deps) ,@(call-next-method))))

   ;; Create a single fasl for the entire library

-  (defclass basic-compile-bundle-op (bundle-op)

+  (defclass basic-compile-bundle-op (bundle-op basic-compile-op)

     ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object

                   :allocation :class)

-     (bundle-type :initform :fasl :allocation :class))

+     (bundle-type :initform :fasb :allocation :class))

     (:documentation "Base class for compiling into a bundle"))

   ;; Analog to prepare-op, for load-bundle-op and compile-bundle-op

       ((eql :no-output-file) ;; marker for a bundle-type that has NO output file

        (error "No output file, therefore no pathname type"))

       ((eql :fasl) ;; the type of a fasl

+       (compile-file-type)) ; on image-based platforms, used as input and output

+      ((eql :fasb) ;; the type of a fasl

        #-(or clasp ecl mkcl) (compile-file-type) ; on image-based platforms, used as input and output

        #+(or clasp ecl mkcl) "fasb") ; on C-linking platforms, only used as output for system bundles

       ((member :image)

 or of opaque libraries shipped along the source code."))

   (defclass precompiled-system (system)

-    ((build-pathname :initarg :fasl))

+    ((build-pathname :initarg :fasb :initarg :fasl))

     (:documentation "Class For a system that is delivered as a precompiled fasl"))

   (defclass prebuilt-system (system)

        (if monolithic 'monolithic-dll-op 'dll-op))

       ((:lib :static-library)

        (if monolithic 'monolithic-lib-op 'lib-op))

-      ((:fasl)

+      ((:fasb)

        (if monolithic 'monolithic-compile-bundle-op 'compile-bundle-op))

       ((:image)

        'image-op)

            (dependencies

              (if (operation-monolithic-p o)

                  ;; We want only dependencies, and we use basic-load-op rather than load-op so that

-                 ;; this will keep working on systems when *load-system-operation* is load-bundle-op

+                 ;; this will keep working on systems that load dependencies with load-bundle-op

                  (remove-if-not 'builtin-system-p

                                 (required-components s :component-type 'system

                                                        :keep-operation 'basic-load-op))

 #+(or clasp ecl mkcl)

 (with-upgradability ()

-

-  #+ecl ;; doesn't work on clasp or mkcl (yet?).

-  (unless (use-ecl-byte-compiler-p)

-    (setf *load-system-operation* 'load-bundle-op))

-

   (defun system-module-pathname (module)

     (let ((name (coerce-name module)))

       (some

        (list

         #+clasp (compile-file-pathname (make-pathname :name name :defaults "sys:") :output-type :object)

         #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :lib)

+        #+ecl (compile-file-pathname (make-pathname :name (strcat "lib" name) :defaults "sys:") :type :lib)

         #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :object)

         #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:")

         #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;")))))

                      :name (coerce-name name)

                      :static-library (resolve-symlinks* pathname))))

+  (defun linkable-system (x)

+    (or (if-let (s (find-system x))

+          (and (system-source-file x) s))

+        (if-let (p (system-module-pathname (coerce-name x)))

+          (make-prebuilt-system x p))))

+

   (defmethod component-depends-on :around ((o image-op) (c system))

-    (destructuring-bind ((lib-op . deps)) (call-next-method)

-      (labels ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name))

-               (ensure-linkable-system (x)

-		 (unless (has-it-p x)

-                   (or (if-let (s (find-system x))

-                         (and (system-source-directory x)

-                              (list s)))

-                       (if-let (p (system-module-pathname x))

-                         (list (make-prebuilt-system x p)))))))

-        `((,lib-op

+    (let* ((next (call-next-method))

+           (deps (make-hash-table :test 'equal))

+           (linkable (loop* :for (do . dcs) :in next :collect

+                       (cons do

+                             (loop :for dc :in dcs

+                               :for dep = (and dc (resolve-dependency-spec c dc))

+                               :when dep

+                               :do (setf (gethash (coerce-name (component-system dep)) deps) t)

+                               :collect (or (and (typep dep 'system) (linkable-system dep)) dep))))))

+        `((lib-op

            ,@(unless (no-uiop c)

-               (append (ensure-linkable-system "cmp")

-                       (or (ensure-linkable-system "uiop")

-                           (ensure-linkable-system "asdf"))))

-           ,@deps)))))

+               (list (linkable-system "cmp")

+                     (unless (or (gethash "uiop" deps) (gethash "asdf" deps))

+                       (or (linkable-system "uiop")

+                           (linkable-system "asdf")

+                           "asdf")))))

+          ,@linkable)))

   (defmethod perform ((o link-op) (c system))

     (let* ((object-files (input-files o c))

                         (collect (list directory :recurse recurse :exclude exclude))))))

      :test 'equal :from-end t))

+  ;; MAYBE: move this utility function to uiop/pathname and export it?

+  (defun pathname-directory-depth (p)

+    (length (normalize-pathname-directory-component (pathname-directory p))))

+

+  (defun preferred-source-path-p (x y)

+    "Return T iff X is to be preferred over Y as a source path"

+    (let ((lx (pathname-directory-depth x))

+          (ly (pathname-directory-depth y)))

+      (or (< lx ly)

+          (and (= lx ly)

+               (string< (namestring x)

+                        (namestring y))))))

+

   ;; Will read the configuration and initialize all internal variables.

   (defun compute-source-registry (&optional (parameter *source-registry-parameter*)

                                     (registry *source-registry*))

                                 ;; instead of (load-system 'foo)

                                 (string-downcase name)

                                 name)))

-                 (cond

-                   ((gethash name registry) ; already shadowed by something else

-                    nil)

-                   ((gethash name h) ; conflict at current level

-                    (when *verbose-out*

-                      (warn (compatfmt "~@<In source-registry entry ~A~@[/~*~] ~

-                                found several entries for ~A - picking ~S over ~S~:>")

-                            directory recurse name (gethash name h) asd)))

-                   (t

-                    (setf (gethash name registry) asd)

-                    (setf (gethash name h) asd))))))

-          h)))

+                 (unless (gethash name registry) ; already shadowed by something else

+                   (if-let (old (gethash name h))

+                     ;; If the name appears multiple times,

+                     ;; prefer the one with the shallowest directory,

+                     ;; or if they have same depth, compare unix-namestring with string<

+                     (multiple-value-bind (better worse)

+                         (if (preferred-source-path-p asd old)

+                             (progn (setf (gethash name h) asd) (values asd old))

+                             (values old asd))

+                       (when *verbose-out*

+                         (warn (compatfmt "~@<In source-registry entry ~A~@[/~*~] ~

+                                              found several entries for ~A - picking ~S over ~S~:>")

+                               directory recurse name better worse)))

+                     (setf (gethash name h) asd))))))

+          (maphash #'(lambda (k v) (setf (gethash k registry) v)) h))))

     (values))

   (defun initialize-source-registry (&optional (parameter *source-registry-parameter*))

    #:*compile-file-warnings-behaviour*

    #:*compile-file-failure-behaviour*

    #:*resolve-symlinks*

-   #:*load-system-operation*

    #:*asdf-verbose* ;; unused. For backward-compatibility only.

    #:*verbose-out*

 OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

 WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

  -->

-<!-- Created by GNU Texinfo 6.1, http://www.gnu.org/software/texinfo/ -->

+<!-- Created by GNU Texinfo 6.3, http://www.gnu.org/software/texinfo/ -->

 <head>

 <title>ASDF Manual</title>

 <a name="Top"></a>

 <a name="ASDF_003a-Another-System-Definition-Facility"></a>

 <h1 class="top">ASDF: Another System Definition Facility</h1>

-<p>Manual for Version 3.2.0

+<p>Manual for Version 3.2.1

 </p>

 <p>This manual describes ASDF, a system definition facility

 If multiple systems are found, the consequences are unspecified:

 the search may succeed with any of the found systems,

 or an error may be raised.

-ASDF currently returns the first system found,

-XCVB currently raised an error.

+ASDF 3.2.1 or later returns the pathname whose normalized directory component

+has the shortest length (as a list), and breaks ties by choosing the system

+with the smallest <code>unix-namestring</code> when compared with <code>string&lt;</code>.

+Earlier versions of ASDF return ASDF return the first system found,

+which is implementation-dependent, and may or may not be the pathname

+with the smallest <code>unix-namestring</code> when compared with <code>string&lt;</code>.

+XCVB raises an error.

 If none is found, the search continues.

 </p>

 <p>Exclude statements specify patterns of subdirectories

-This is asdf.info, produced by makeinfo version 6.1 from asdf.texinfo.

+This is asdf.info, produced by makeinfo version 6.3 from asdf.texinfo.

 This manual describes ASDF, a system definition facility for Common Lisp

 programs and libraries.

 ASDF: Another System Definition Facility

 ****************************************

-Manual for Version 3.2.0

+Manual for Version 3.2.1

    This manual describes ASDF, a system definition facility for Common

 Lisp programs and libraries.

    When looking in a tree, if one system is found, the search succeeds.

 If multiple systems are found, the consequences are unspecified: the

 search may succeed with any of the found systems, or an error may be

-raised.  ASDF currently returns the first system found, XCVB currently

-raised an error.  If none is found, the search continues.

+raised.  ASDF 3.2.1 or later returns the pathname whose normalized

+directory component has the shortest length (as a list), and breaks ties

+by choosing the system with the smallest 'unix-namestring' when compared

+with 'string<'.  Earlier versions of ASDF return ASDF return the first

+system found, which is implementation-dependent, and may or may not be

+the pathname with the smallest 'unix-namestring' when compared with

+'string<'.  XCVB raises an error.  If none is found, the search

+continues.

    Exclude statements specify patterns of subdirectories the systems

 from which to ignore.  Typically you don't want to use copies of files

 Node: The here directive133558

 Node: Shell-friendly syntax for configuration135451

 Node: Search Algorithm136468

-Node: Caching Results137969

-Node: Configuration API141213

-Node: Introspection143252

-Node: *source-registry-parameter* variable143516

-Node: Information about system dependencies144085

-Node: Status145001

-Node: Rejected ideas145456

-Node: TODO147837

-Node: Credits for the source-registry148022

-Node: Controlling where ASDF saves compiled files148557

-Ref: Controlling where ASDF saves compiled files-Footnote-1149969

-Node: Output Configurations150013

-Ref: Output Configurations-Footnote-1152874

-Node: Output Backward Compatibility152940

-Node: Output Configuration DSL155666

-Node: Output Configuration Directories161121

-Node: Output Shell-friendly syntax for configuration162678

-Node: Semantics of Output Translations164197

-Node: Output Caching Results165766

-Node: Output location API166246

-Node: Credits for output translations168668

-Node: Error handling169188

-Node: Miscellaneous additional functionality170029

-Node: Controlling file compilation170501

-Node: Controlling source file character encoding173767

-Node: Miscellaneous Functions180584

-Ref: system-relative-pathname180881

-Ref: Miscellaneous Functions-Footnote-1187328

-Node: Some Utility Functions187439

-Node: Getting the latest version198217

-Node: FAQ199162

-Node: Where do I report a bug?199557

-Node: Mailing list199922

-Node: What has changed between ASDF 1 ASDF 2 and ASDF 3?200257

-Node: What are ASDF 1 2 3?202431

-Node: How do I detect the ASDF version?203472

-Node: ASDF can portably name files in subdirectories205779

-Node: Output translations207329

-Node: Source Registry Configuration208356

-Node: Usual operations are made easier to the user209983

-Node: Many bugs have been fixed210569

-Node: ASDF itself is versioned212401

-Node: ASDF can be upgraded213276

-Node: Decoupled release cycle214428

-Node: Pitfalls of the transition to ASDF 2215357

-Node: Pitfalls of the upgrade to ASDF 3219627

-Ref: Pitfalls of the upgrade to ASDF 3-Footnote-1223996

-Node: What happened to the bundle operations224166

-Node: Issues with installing the proper version of ASDF225331

-Node: My Common Lisp implementation comes with an outdated version of ASDF. What to do?225802

-Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?226735

-Node: Issues with configuring ASDF230618

-Node: How can I customize where fasl files are stored?230993

-Node: How can I wholly disable the compiler output cache?232086

-Node: Issues with using and extending ASDF to define systems233465

-Node: How can I cater for unit-testing in my system?234262

-Node: How can I cater for documentation generation in my system?235150

-Node: How can I maintain non-Lisp (e.g. C) source files?235671

-Ref: report-bugs236103

-Node: I want to put my module's files at the top level. How do I do this?236103

-Node: How do I create a system definition where all the source files have a .cl extension?239253

-Node: How do I mark a source file to be loaded only and not compiled?241226

-Node: How do I work with readtables?242222

-Node: How can I capture ASDF's output?245949

-Node: LOAD-PATHNAME has a weird value246420

-Node: ASDF development FAQs247906

-Node: How do I run the tests interactively in a REPL?248145

-Node: Ongoing Work250011

-Node: Bibliography250290

-Node: Concept Index253761

-Node: Function and Class Index260620

-Node: Variable Index272394

+Node: Caching Results138338

+Node: Configuration API141582

+Node: Introspection143621

+Node: *source-registry-parameter* variable143885

+Node: Information about system dependencies144454

+Node: Status145370

+Node: Rejected ideas145825

+Node: TODO148206

+Node: Credits for the source-registry148391

+Node: Controlling where ASDF saves compiled files148926

+Ref: Controlling where ASDF saves compiled files-Footnote-1150338

+Node: Output Configurations150382

+Ref: Output Configurations-Footnote-1153243

+Node: Output Backward Compatibility153309

+Node: Output Configuration DSL156035

+Node: Output Configuration Directories161490

+Node: Output Shell-friendly syntax for configuration163047

+Node: Semantics of Output Translations164566

+Node: Output Caching Results166135

+Node: Output location API166615

+Node: Credits for output translations169037

+Node: Error handling169557

+Node: Miscellaneous additional functionality170398

+Node: Controlling file compilation170870

+Node: Controlling source file character encoding174136

+Node: Miscellaneous Functions180953

+Ref: system-relative-pathname181250

+Ref: Miscellaneous Functions-Footnote-1187697

+Node: Some Utility Functions187808

+Node: Getting the latest version198586

+Node: FAQ199531

+Node: Where do I report a bug?199926

+Node: Mailing list200291

+Node: What has changed between ASDF 1 ASDF 2 and ASDF 3?200626

+Node: What are ASDF 1 2 3?202800

+Node: How do I detect the ASDF version?203841

+Node: ASDF can portably name files in subdirectories206148

+Node: Output translations207698

+Node: Source Registry Configuration208725

+Node: Usual operations are made easier to the user210352

+Node: Many bugs have been fixed210938

+Node: ASDF itself is versioned212770

+Node: ASDF can be upgraded213645

+Node: Decoupled release cycle214797

+Node: Pitfalls of the transition to ASDF 2215726

+Node: Pitfalls of the upgrade to ASDF 3219996

+Ref: Pitfalls of the upgrade to ASDF 3-Footnote-1224365

+Node: What happened to the bundle operations224535

+Node: Issues with installing the proper version of ASDF225700

+Node: My Common Lisp implementation comes with an outdated version of ASDF. What to do?226171

+Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?227104

+Node: Issues with configuring ASDF230987

+Node: How can I customize where fasl files are stored?231362

+Node: How can I wholly disable the compiler output cache?232455

+Node: Issues with using and extending ASDF to define systems233834

+Node: How can I cater for unit-testing in my system?234631

+Node: How can I cater for documentation generation in my system?235519

+Node: How can I maintain non-Lisp (e.g. C) source files?236040

+Ref: report-bugs236472

+Node: I want to put my module's files at the top level. How do I do this?236472

+Node: How do I create a system definition where all the source files have a .cl extension?239622

+Node: How do I mark a source file to be loaded only and not compiled?241595

+Node: How do I work with readtables?242591

+Node: How can I capture ASDF's output?246318

+Node: LOAD-PATHNAME has a weird value246789

+Node: ASDF development FAQs248275

+Node: How do I run the tests interactively in a REPL?248514

+Node: Ongoing Work250380

+Node: Bibliography250659

+Node: Concept Index254130

+Node: Function and Class Index260989

+Node: Variable Index272763

 End Tag Table
   * Feature enhancements

   * Changes

-    * ASDF 3.2.0

+    * ASDF 3.2.1

   * ANSI compliance fixes:

 # -*- Mode: makefile -*-

 include Config.x86_common

+# Set the path to your verison of GCC here.

+CC = gcc -m32

 CPPFLAGS += -march=pentium4 -mfpmath=sse

 UNDEFSYMPATTERN = -Xlinker -u -Xlinker &

 OS_SRC += FreeBSD-os.c elf.c

 OS_LINK_FLAGS = -dynamic -export-dynamic

-OS_LIBS = -lutil -lmd

+OS_LIBS = -B/usr/lib32 -lutil -lmd

 EXEC_FINAL_OBJ = exec-final.o
+CC=gcc 

 CFLAGS = -pthread -O2 -I/usr/local/include -I. -I$(VPATH)

 LDFLAGS = -L/usr/local/lib

 LIBS = -lXm -lXt -lX11

       # See Config.x86_${uname_s}

       case $uname_s in

 	Linux) OS_LIBS=-ldl;;

-	FreeBSD) OS_LIBS=-lutil;;

+	FreeBSD) OS_LIBS="-B/usr/lib32 -lutil";;

       esac

       ;;

   Darwin)

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl

Commits:

9 changed files:

Changes: