Loading asdf-ecl.lisp +1 −21 Original line number Diff line number Diff line Loading @@ -16,32 +16,12 @@ ;;; ;;; COMPILE-OP / LOAD-OP ;;; ;;; We change these operations to produce both FASL files and the ;;; In ECL, these operations produce both FASL files and the ;;; object files that they are built from. Having both of them allows ;;; us to later on reuse the object files for bundles, libraries, ;;; standalone executables, etc. ;;; (defmethod initialize-instance :after ((instance compile-op) &key &allow-other-keys) (setf (slot-value instance 'flags) '(:system-p t))) (defmethod output-files ((o compile-op) (c cl-source-file)) (list (compile-file-pathname (component-pathname c) :type :object) (compile-file-pathname (component-pathname c) :type :fasl))) (defmethod perform :after ((o compile-op) (c cl-source-file)) ;; Note how we use OUTPUT-FILES to find the binary locations ;; This allows the user to override the names. (let* ((input (output-files o c)) (output (compile-file-pathname (first input) :type :fasl))) (c:build-fasl output :lisp-files (remove "fas" input :key #'pathname-type :test #'string=)))) (defmethod perform ((o load-op) (c cl-source-file)) (loop for i in (input-files o c) unless (string= (pathname-type i) "fas") collect (let ((output (compile-file-pathname i))) (load output)))) ;;; ;;; BUNDLE-OP ;;; Loading asdf.lisp +41 −18 Original line number Diff line number Diff line Loading @@ -48,6 +48,8 @@ (cl:in-package :cl-user) (declaim (optimize (speed 1) (debug 3) (safety 3))) (eval-when (:compile-toplevel :load-toplevel :execute) (let ((asdf (find-package :asdf))) (when asdf Loading @@ -56,6 +58,8 @@ (unexport sym asdf) (unintern sym)))))) #+ecl (require 'cmp) (defpackage #:asdf (:documentation "Another System Definition Facility") (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command Loading Loading @@ -175,7 +179,7 @@ ;;;; (defparameter *asdf-version* ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace (subseq "VERSION:1.594" (1+ (length "VERSION")))) (subseq "VERSION:1.595" (1+ (length "VERSION")))) (defun asdf-version () *asdf-version*) Loading Loading @@ -1239,11 +1243,20 @@ to `~a` which is not a directory.~@:>" :initform *compile-file-warnings-behaviour*) (on-failure :initarg :on-failure :accessor operation-on-failure :initform *compile-file-failure-behaviour*) (flags :initarg :system-p :accessor compile-op-flags :initform nil))) (flags :initarg :flags :accessor compile-op-flags :initform #-ecl nil #+ecl '(:system-p t)))) (defmethod perform :before ((operation compile-op) (c source-file)) (map nil #'ensure-directories-exist (output-files operation c))) #+ecl (defmethod perform :after ((o compile-op) (c cl-source-file)) ;; Note how we use OUTPUT-FILES to find the binary locations ;; This allows the user to override the names. (let* ((input (output-files o c)) (output (compile-file-pathname (first input) :type :fasl))) (c:build-fasl output :lisp-files (remove "fas" input :key #'pathname-type :test #'string=)))) (defmethod perform :after ((operation operation) (c component)) (setf (gethash (type-of operation) (component-operation-times c)) (get-universal-time))) Loading Loading @@ -1275,7 +1288,10 @@ to `~a` which is not a directory.~@:>" (error 'compile-error :component c :operation operation))))) (defmethod output-files ((operation compile-op) (c cl-source-file)) #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c))) #-:broken-fasl-loader (list #-ecl (compile-file-pathname (component-pathname c)) #+ecl (compile-file-pathname (component-pathname c) :type :object) #+ecl (compile-file-pathname (component-pathname c) :type :fasl)) #+:broken-fasl-loader (list (component-pathname c))) (defmethod perform ((operation compile-op) (c static-file)) Loading @@ -1296,7 +1312,11 @@ to `~a` which is not a directory.~@:>" (defclass load-op (basic-load-op) ()) (defmethod perform ((o load-op) (c cl-source-file)) (mapcar #'load (input-files o c))) #-ecl (mapcar #'load (input-files o c)) #+ecl (loop :for i :in (input-files o c) :unless (string= (pathname-type i) "fas") :collect (let ((output (compile-file-pathname i))) (load output)))) (defmethod perform around ((o load-op) (c cl-source-file)) (let ((state :initial)) Loading Loading @@ -1981,32 +2001,33 @@ with a different configuration, so the configuration would be re-read then." (setf *output-translations* '()) (values)) (defun resolve-location (x) (defun resolve-location (x &optional wildenp) (if (atom x) (resolve-absolute-location-component x nil) (loop :with path = (resolve-absolute-location-component (car x) t) (resolve-absolute-location-component x wildenp) (loop :with path = (resolve-absolute-location-component (car x) nil) :for (component . morep) :on (cdr x) :do (setf path (resolve-relative-location-component path component morep)) :do (setf path (resolve-relative-location-component path component (and wildenp (not morep)))) :finally (return path)))) (defun resolve-absolute-location-component (x morep) (defun resolve-absolute-location-component (x wildenp) (let* ((r (etypecase x (pathname x) (string (ensure-directory-pathname x)) ((eql :home) (user-homedir-pathname)) ((eql :user-cache) (resolve-location *user-cache*)) ((eql :system-cache) (resolve-location *system-cache*)) ((eql :user-cache) (resolve-location *user-cache* nil)) ((eql :system-cache) (resolve-location *system-cache* nil)) ((eql :current-directory) (truenamize *default-pathname-defaults*)) ((eql :root) (make-pathname :directory '(:absolute))))) (s (if (or (pathnamep x) morep) r (wilden r)))) (s (if (and wildenp (not (pathnamep x))) (wilden r) r))) (unless (absolute-pathname-p s) (error "Not an absolute pathname ~S" s)) s)) (defun resolve-relative-location-component (super x morep) (defun resolve-relative-location-component (super x &optional wildenp) (let* ((r (etypecase x (pathname x) (string x) Loading @@ -2017,7 +2038,9 @@ with a different configuration, so the configuration would be re-read then." ((eql :implementation-type) (implementation-type)) ((eql :uid) (princ-to-string (get-uid))))) (d (if (pathnamep x) r (ensure-directory-pathname r))) (s (if (or (pathnamep x) morep) d (wilden d)))) (s (if (and wildenp (not (pathnamep x))) (wilden d) d))) (when (and (absolute-pathname-p s) (not (pathname-match-p s (wilden super)))) (error "pathname ~S is not relative to ~S" s super)) (merge-pathnames s super))) Loading Loading @@ -2194,8 +2217,8 @@ with a different configuration, so the configuration would be re-read then." (dst (second directive))) (if (eq src :include) (process-output-translations (pathname dst) :inherit nil :collect collect) (let* ((trusrc (truenamize (resolve-location src))) (trudst (if dst (resolve-location dst) trusrc))) (let* ((trusrc (truenamize (resolve-location src t))) (trudst (if dst (resolve-location dst t) trusrc))) (funcall collect (list trusrc trudst))))))) ;; Will read the configuration and initialize all internal variables, Loading Loading
asdf-ecl.lisp +1 −21 Original line number Diff line number Diff line Loading @@ -16,32 +16,12 @@ ;;; ;;; COMPILE-OP / LOAD-OP ;;; ;;; We change these operations to produce both FASL files and the ;;; In ECL, these operations produce both FASL files and the ;;; object files that they are built from. Having both of them allows ;;; us to later on reuse the object files for bundles, libraries, ;;; standalone executables, etc. ;;; (defmethod initialize-instance :after ((instance compile-op) &key &allow-other-keys) (setf (slot-value instance 'flags) '(:system-p t))) (defmethod output-files ((o compile-op) (c cl-source-file)) (list (compile-file-pathname (component-pathname c) :type :object) (compile-file-pathname (component-pathname c) :type :fasl))) (defmethod perform :after ((o compile-op) (c cl-source-file)) ;; Note how we use OUTPUT-FILES to find the binary locations ;; This allows the user to override the names. (let* ((input (output-files o c)) (output (compile-file-pathname (first input) :type :fasl))) (c:build-fasl output :lisp-files (remove "fas" input :key #'pathname-type :test #'string=)))) (defmethod perform ((o load-op) (c cl-source-file)) (loop for i in (input-files o c) unless (string= (pathname-type i) "fas") collect (let ((output (compile-file-pathname i))) (load output)))) ;;; ;;; BUNDLE-OP ;;; Loading
asdf.lisp +41 −18 Original line number Diff line number Diff line Loading @@ -48,6 +48,8 @@ (cl:in-package :cl-user) (declaim (optimize (speed 1) (debug 3) (safety 3))) (eval-when (:compile-toplevel :load-toplevel :execute) (let ((asdf (find-package :asdf))) (when asdf Loading @@ -56,6 +58,8 @@ (unexport sym asdf) (unintern sym)))))) #+ecl (require 'cmp) (defpackage #:asdf (:documentation "Another System Definition Facility") (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command Loading Loading @@ -175,7 +179,7 @@ ;;;; (defparameter *asdf-version* ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace (subseq "VERSION:1.594" (1+ (length "VERSION")))) (subseq "VERSION:1.595" (1+ (length "VERSION")))) (defun asdf-version () *asdf-version*) Loading Loading @@ -1239,11 +1243,20 @@ to `~a` which is not a directory.~@:>" :initform *compile-file-warnings-behaviour*) (on-failure :initarg :on-failure :accessor operation-on-failure :initform *compile-file-failure-behaviour*) (flags :initarg :system-p :accessor compile-op-flags :initform nil))) (flags :initarg :flags :accessor compile-op-flags :initform #-ecl nil #+ecl '(:system-p t)))) (defmethod perform :before ((operation compile-op) (c source-file)) (map nil #'ensure-directories-exist (output-files operation c))) #+ecl (defmethod perform :after ((o compile-op) (c cl-source-file)) ;; Note how we use OUTPUT-FILES to find the binary locations ;; This allows the user to override the names. (let* ((input (output-files o c)) (output (compile-file-pathname (first input) :type :fasl))) (c:build-fasl output :lisp-files (remove "fas" input :key #'pathname-type :test #'string=)))) (defmethod perform :after ((operation operation) (c component)) (setf (gethash (type-of operation) (component-operation-times c)) (get-universal-time))) Loading Loading @@ -1275,7 +1288,10 @@ to `~a` which is not a directory.~@:>" (error 'compile-error :component c :operation operation))))) (defmethod output-files ((operation compile-op) (c cl-source-file)) #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c))) #-:broken-fasl-loader (list #-ecl (compile-file-pathname (component-pathname c)) #+ecl (compile-file-pathname (component-pathname c) :type :object) #+ecl (compile-file-pathname (component-pathname c) :type :fasl)) #+:broken-fasl-loader (list (component-pathname c))) (defmethod perform ((operation compile-op) (c static-file)) Loading @@ -1296,7 +1312,11 @@ to `~a` which is not a directory.~@:>" (defclass load-op (basic-load-op) ()) (defmethod perform ((o load-op) (c cl-source-file)) (mapcar #'load (input-files o c))) #-ecl (mapcar #'load (input-files o c)) #+ecl (loop :for i :in (input-files o c) :unless (string= (pathname-type i) "fas") :collect (let ((output (compile-file-pathname i))) (load output)))) (defmethod perform around ((o load-op) (c cl-source-file)) (let ((state :initial)) Loading Loading @@ -1981,32 +2001,33 @@ with a different configuration, so the configuration would be re-read then." (setf *output-translations* '()) (values)) (defun resolve-location (x) (defun resolve-location (x &optional wildenp) (if (atom x) (resolve-absolute-location-component x nil) (loop :with path = (resolve-absolute-location-component (car x) t) (resolve-absolute-location-component x wildenp) (loop :with path = (resolve-absolute-location-component (car x) nil) :for (component . morep) :on (cdr x) :do (setf path (resolve-relative-location-component path component morep)) :do (setf path (resolve-relative-location-component path component (and wildenp (not morep)))) :finally (return path)))) (defun resolve-absolute-location-component (x morep) (defun resolve-absolute-location-component (x wildenp) (let* ((r (etypecase x (pathname x) (string (ensure-directory-pathname x)) ((eql :home) (user-homedir-pathname)) ((eql :user-cache) (resolve-location *user-cache*)) ((eql :system-cache) (resolve-location *system-cache*)) ((eql :user-cache) (resolve-location *user-cache* nil)) ((eql :system-cache) (resolve-location *system-cache* nil)) ((eql :current-directory) (truenamize *default-pathname-defaults*)) ((eql :root) (make-pathname :directory '(:absolute))))) (s (if (or (pathnamep x) morep) r (wilden r)))) (s (if (and wildenp (not (pathnamep x))) (wilden r) r))) (unless (absolute-pathname-p s) (error "Not an absolute pathname ~S" s)) s)) (defun resolve-relative-location-component (super x morep) (defun resolve-relative-location-component (super x &optional wildenp) (let* ((r (etypecase x (pathname x) (string x) Loading @@ -2017,7 +2038,9 @@ with a different configuration, so the configuration would be re-read then." ((eql :implementation-type) (implementation-type)) ((eql :uid) (princ-to-string (get-uid))))) (d (if (pathnamep x) r (ensure-directory-pathname r))) (s (if (or (pathnamep x) morep) d (wilden d)))) (s (if (and wildenp (not (pathnamep x))) (wilden d) d))) (when (and (absolute-pathname-p s) (not (pathname-match-p s (wilden super)))) (error "pathname ~S is not relative to ~S" s super)) (merge-pathnames s super))) Loading Loading @@ -2194,8 +2217,8 @@ with a different configuration, so the configuration would be re-read then." (dst (second directive))) (if (eq src :include) (process-output-translations (pathname dst) :inherit nil :collect collect) (let* ((trusrc (truenamize (resolve-location src))) (trudst (if dst (resolve-location dst) trusrc))) (let* ((trusrc (truenamize (resolve-location src t))) (trudst (if dst (resolve-location dst t) trusrc))) (funcall collect (list trusrc trudst))))))) ;; Will read the configuration and initialize all internal variables, Loading