- cmucl-cvs - mailman3.common-lisp.net

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2011-12-4-g2326ebc
by Raymond Toy 21 Dec '11

21 Dec '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 2326ebcf3d776a14a7e3ad61edfaf5bca40ebbbc (commit) from d56fecd7db290133ca12fa1a12843327af191ed7 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 2326ebcf3d776a14a7e3ad61edfaf5bca40ebbbc Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Dec 20 22:13:36 2011 -0800 Print out more digits for double-floats in ldb printer. diff --git a/src/lisp/print.c b/src/lisp/print.c index f1e84d4..cdf4b56 100644 --- a/src/lisp/print.c +++ b/src/lisp/print.c @@ -552,7 +552,7 @@ print_otherptr(lispobj obj) case type_DoubleFloat: NEWLINE; - printf("%g", ((struct double_float *) PTR(obj))->value); + printf("%.15lg", ((struct double_float *) PTR(obj))->value); break; #ifdef type_LongFloat @@ -565,7 +565,7 @@ print_otherptr(lispobj obj) #ifdef type_DoubleDoubleFloat case type_DoubleDoubleFloat: NEWLINE; - printf("%g %g", ((struct double_double_float *) PTR(obj))->hi, + printf("%.15lg %.15lg", ((struct double_double_float *) PTR(obj))->hi, ((struct double_double_float *) PTR(obj))->lo); break; #endif @@ -582,9 +582,9 @@ print_otherptr(lispobj obj) #ifdef type_ComplexDoubleFloat case type_ComplexDoubleFloat: NEWLINE; - printf("%g", ((struct complex_double_float *) PTR(obj))->real); + printf("%.15lg", ((struct complex_double_float *) PTR(obj))->real); NEWLINE; - printf("%g", ((struct complex_double_float *) PTR(obj))->imag); + printf("%.15lg", ((struct complex_double_float *) PTR(obj))->imag); break; #endif @@ -600,10 +600,10 @@ print_otherptr(lispobj obj) #ifdef type_ComplexDoubleDoubleFloat case type_ComplexDoubleDoubleFloat: NEWLINE; - printf("%g %g", ((struct complex_double_double_float *) PTR(obj))->real_hi, + printf("%.15lg %.15lg", ((struct complex_double_double_float *) PTR(obj))->real_hi, ((struct complex_double_double_float *) PTR(obj))->real_lo); NEWLINE; - printf("%g %g", ((struct complex_double_double_float *) PTR(obj))->imag_hi, + printf("%.15lg %.15lg", ((struct complex_double_double_float *) PTR(obj))->imag_hi, ((struct complex_double_double_float *) PTR(obj))->imag_lo); break; #endif ----------------------------------------------------------------------- Summary of changes: src/lisp/print.c | 12 ++++++------ 1 files changed, 6 insertions(+), 6 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2011-12-3-gd56fecd
by Raymond Toy 16 Dec '11

16 Dec '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via d56fecd7db290133ca12fa1a12843327af191ed7 (commit) from 71e768a8693790dd13b0b8908a010d100c5dc370 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit d56fecd7db290133ca12fa1a12843327af191ed7 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Dec 14 10:49:11 2011 -0800 Use gcc-4.2 explicitly in case Xcode4 is installed. diff --git a/src/lisp/Config.x86_darwin b/src/lisp/Config.x86_darwin index 404521f..e1daf4f 100644 --- a/src/lisp/Config.x86_darwin +++ b/src/lisp/Config.x86_darwin @@ -2,6 +2,12 @@ include Config.x86_common +# Use gcc-4.2 on Darwin in case someone has Xcode 4 installed. +# Currently there are bugs in cmucl that cause errors when using gcc +# from Xcode 4. Xcode 3 (for OSX 10.5 and 10.6) has gcc-4.2, so this +# shouldn't be a problem. +CC = gcc-4.2 + # Compile code that will run on OSX 10.4 (Tiger) MIN_VER = -mmacosx-version-min=10.4 ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.x86_darwin | 6 ++++++ 1 files changed, 6 insertions(+), 0 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2011-12-2-g71e768a
by Raymond Toy 08 Dec '11

08 Dec '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 71e768a8693790dd13b0b8908a010d100c5dc370 (commit) from a4e33b7683a15bccdf944729b5c1fcb5a81970cf (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 71e768a8693790dd13b0b8908a010d100c5dc370 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Dec 8 10:27:30 2011 -0800 Include the bin directory so we include the build scripts in the src distribution. diff --git a/bin/make-src-dist.sh b/bin/make-src-dist.sh index a65aad8..1e1c016 100755 --- a/bin/make-src-dist.sh +++ b/bin/make-src-dist.sh @@ -51,8 +51,8 @@ fi GTAR_OPTIONS="--exclude=.git --exclude='*.pot.~*~'" if [ -z "$INSTALL_DIR" ]; then echo " Compressing with $ZIP" - ${GTAR:-tar} ${GTAR_OPTIONS} -cf - src | ${ZIP} > cmucl-src-$VERSION.tar.$ZIPEXT + ${GTAR:-tar} ${GTAR_OPTIONS} -cf - bin src | ${ZIP} > cmucl-src-$VERSION.tar.$ZIPEXT else # Install in the specified directory - ${GTAR:-tar} ${GTAR_OPTIONS} -cf - src | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) + ${GTAR:-tar} ${GTAR_OPTIONS} -cf - bin src | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) fi ----------------------------------------------------------------------- Summary of changes: bin/make-src-dist.sh | 4 ++-- 1 files changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2011-12-1-ga4e33b7
by Raymond Toy 08 Dec '11

08 Dec '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via a4e33b7683a15bccdf944729b5c1fcb5a81970cf (commit) from 576ae2a5a8f79bf983ac3da8237854b2b21dd8c6 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit a4e33b7683a15bccdf944729b5c1fcb5a81970cf Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Dec 8 10:22:32 2011 -0800 Fix ticket:50 Check if "" (and "/") is in the list of directories and signal an error so that we use the #P(...) syntax to print out the pathname readably. Update the pot and po files accordingly. diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index ab2f564..308b8b5 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -488,7 +488,14 @@ (error (intl:gettext ":BACK cannot be represented in namestrings."))) ((member :wild-inferiors) (pieces "**/")) - ((or simple-string pattern (eql :wild)) + (simple-string + (when (zerop (length dir)) + (error (intl:gettext "Cannot represent \"\" in namestrings."))) + (when (string-equal dir "/") + (error (intl:gettext "Cannot represent an explicit directory separator in namestrings."))) + (pieces (unparse-unix-piece dir)) + (pieces "/")) + ((or pattern (eql :wild)) (pieces (unparse-unix-piece dir)) (pieces "/")) (t diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 92ace3d..a1087ca 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -9026,7 +9026,15 @@ msgid "" "Convert String to octets using the specified External-format. The\n" " string is bounded by Start (defaulting to 0) and End (defaulting to\n" " the end of the string. If Buffer is given, the octets are stored\n" -" there. If not, a new buffer is created." +" there. If not, a new buffer is created. Buffer-start specifies\n" +" where in the buffer the first octet will be placed.\n" +"\n" +" Three values are returned: The buffer, the number of valid octets\n" +" written, and the number of characters converted. Note that the\n" +" actual number of octets written may be greater than the returned\n" +" value, These represent the partial octets of the next character to\n" +" be converted, but there was not enough room to hold the complete set\n" +" of octets." msgstr "" #: src/code/extfmts.lisp @@ -9807,6 +9815,14 @@ msgid ":BACK cannot be represented in namestrings." msgstr "" #: src/code/filesys.lisp +msgid "Cannot represent \"\" in namestrings." +msgstr "" + +#: src/code/filesys.lisp +msgid "Cannot represent an explicit directory separator in namestrings." +msgstr "" + +#: src/code/filesys.lisp msgid "Cannot specify a directory separator in a pathname name: ~S" msgstr "" diff --git a/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po b/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po index 78da94f..37c3afe 100644 --- a/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po @@ -12874,15 +12874,16 @@ msgid "" "Convert String to octets using the specified External-format. The\n" " string is bounded by Start (defaulting to 0) and End (defaulting to\n" " the end of the string. If Buffer is given, the octets are stored\n" -" there. If not, a new buffer is created." +" there. If not, a new buffer is created. Buffer-start specifies\n" +" where in the buffer the first octet will be placed.\n" +"\n" +" Three values are returned: The buffer, the number of valid octets\n" +" written, and the number of characters converted. Note that the\n" +" actual number of octets written may be greater than the returned\n" +" value, These represent the partial octets of the next character to\n" +" be converted, but there was not enough room to hold the complete set\n" +" of octets." msgstr "" -"Onvertcay Ingstray otay octetsway usingway ethay ecifiedspay Externalway-" -"ormatfay. Ethay\n" -" ingstray isway oundedbay ybay Tartsay (efaultingday otay 0) andway Endway " -"(efaultingday otay\n" -" ethay endway ofway ethay ingstray. Ifway Ufferbay isway ivengay, ethay " -"octetsway areway toredsay\n" -" erethay. Ifway otnay, away ewnay ufferbay isway eatedcray." #: src/code/extfmts.lisp msgid "" @@ -13990,6 +13991,18 @@ msgid ":BACK cannot be represented in namestrings." msgstr ":BACK annotcay ebay epresentedray inway amestringsnay." #: src/code/filesys.lisp +#, fuzzy +msgid "Cannot represent \"\" in namestrings." +msgstr ":BACK annotcay ebay epresentedray inway amestringsnay." + +#: src/code/filesys.lisp +#, fuzzy +msgid "Cannot represent an explicit directory separator in namestrings." +msgstr "" +"Annotcay ecifyspay away irectoryday eparatorsay inway away athnamepay " +"amenay: ~S" + +#: src/code/filesys.lisp msgid "Cannot specify a directory separator in a pathname name: ~S" msgstr "" "Annotcay ecifyspay away irectoryday eparatorsay inway away athnamepay " @@ -30436,6 +30449,20 @@ msgstr "" "eplacementray aracterchay." #~ msgid "" +#~ "Convert String to octets using the specified External-format. The\n" +#~ " string is bounded by Start (defaulting to 0) and End (defaulting to\n" +#~ " the end of the string. If Buffer is given, the octets are stored\n" +#~ " there. If not, a new buffer is created." +#~ msgstr "" +#~ "Onvertcay Ingstray otay octetsway usingway ethay ecifiedspay Externalway-" +#~ "ormatfay. Ethay\n" +#~ " ingstray isway oundedbay ybay Tartsay (efaultingday otay 0) andway " +#~ "Endway (efaultingday otay\n" +#~ " ethay endway ofway ethay ingstray. Ifway Ufferbay isway ivengay, ethay " +#~ "octetsway areway toredsay\n" +#~ " erethay. Ifway otnay, away ewnay ufferbay isway eatedcray." + +#~ msgid "" #~ "Return a pathname describing what file COMPILE-FILE would write to given\n" #~ " these arguments." #~ msgstr "" diff --git a/src/i18n/locale/ko/LC_MESSAGES/cmucl.po b/src/i18n/locale/ko/LC_MESSAGES/cmucl.po index a806bec..12d0955 100644 --- a/src/i18n/locale/ko/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/ko/LC_MESSAGES/cmucl.po @@ -9046,7 +9046,15 @@ msgid "" "Convert String to octets using the specified External-format. The\n" " string is bounded by Start (defaulting to 0) and End (defaulting to\n" " the end of the string. If Buffer is given, the octets are stored\n" -" there. If not, a new buffer is created." +" there. If not, a new buffer is created. Buffer-start specifies\n" +" where in the buffer the first octet will be placed.\n" +"\n" +" Three values are returned: The buffer, the number of valid octets\n" +" written, and the number of characters converted. Note that the\n" +" actual number of octets written may be greater than the returned\n" +" value, These represent the partial octets of the next character to\n" +" be converted, but there was not enough room to hold the complete set\n" +" of octets." msgstr "" #: src/code/extfmts.lisp @@ -9830,6 +9838,14 @@ msgid ":BACK cannot be represented in namestrings." msgstr "" #: src/code/filesys.lisp +msgid "Cannot represent \"\" in namestrings." +msgstr "" + +#: src/code/filesys.lisp +msgid "Cannot represent an explicit directory separator in namestrings." +msgstr "" + +#: src/code/filesys.lisp msgid "Cannot specify a directory separator in a pathname name: ~S" msgstr "" ----------------------------------------------------------------------- Summary of changes: src/code/filesys.lisp | 9 ++++- src/i18n/locale/cmucl.pot | 18 +++++++++- src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po | 43 ++++++++++++++++++---- src/i18n/locale/ko/LC_MESSAGES/cmucl.po | 18 +++++++++- 4 files changed, 77 insertions(+), 11 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp annotated tag snapshot-2011-12 created. snapshot-2011-12
by Raymond Toy 02 Dec '11

02 Dec '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The annotated tag, snapshot-2011-12 has been created at 54235a700500e9a439d266cd984bcfd489dbc885 (tag) tagging 576ae2a5a8f79bf983ac3da8237854b2b21dd8c6 (commit) replaces release-20c tagged by Raymond Toy on Thu Dec 1 20:52:56 2011 -0800 - Log ----------------------------------------------------------------- Snapshot 2011-12 Raymond Toy (24): Ignore files generated by tex. Update asdf to version 2.018. Merge branch 'RELEASE-20C-BRANCH' Merge commit 'release-20c' Change bootfile directory from 20b to 20c. Initial version for 20d release notes. STRING-TO-OCTETS returns the buffer, the number of octets written and Update from change log. Rearrange directory structure. Moved more sripts to bin from src/tools. Update paths for the new location of the scripts. Update paths. Ignore darwin build directories. If -b is not given, try to choose a suitable name from the OS type. Ignore linux and sparc build directories. Exit after print the usage message. Move rebuild-lisp.sh to bin. Move cross-build-world.sh to bin. Move make-dist.sh, make-extra-dist.sh, make-main-dist.sh and Update paths to new locations. Don't add .git directory to src tarball! If compression or version is Forgot to compiler that DECODE-FLOAT can return +/- 1w0 for the sign. Remove hppa-assem.s. It's not referenced anywhere. Update to asdf 2.019; update release info. ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. release-20c-24-g576ae2a
by Raymond Toy 01 Dec '11

01 Dec '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 576ae2a5a8f79bf983ac3da8237854b2b21dd8c6 (commit) from eea87468f7479a152a34ff2ad8f6fd53a011c36b (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 576ae2a5a8f79bf983ac3da8237854b2b21dd8c6 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Nov 28 20:39:27 2011 -0800 Update to asdf 2.019; update release info. diff --git a/src/contrib/asdf/asdf.lisp b/src/contrib/asdf/asdf.lisp index 26ff427..a95826b 100644 --- a/src/contrib/asdf/asdf.lisp +++ b/src/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.018: Another System Definition Facility. +;;; This is ASDF 2.019: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel(a)common-lisp.net>. @@ -56,7 +56,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) ;;; Implementation-dependent tweaks - ;; (declaim (optimize (speed 2) (debug 2) (safety 3))) ; NO: rely on the implementation defaults. + ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; NO: trust implementation defaults. #+allegro (setf excl::*autoload-package-name-alist* (remove "asdf" excl::*autoload-package-name-alist* @@ -86,6 +86,8 @@ (find-symbol (string s) p)) ;; Strip out formatting that is not supported on Genera. ;; Has to be inside the eval-when to make Lispworks happy (!) + (defun strcat (&rest strings) + (apply 'concatenate 'string strings)) (defmacro compatfmt (format) #-(or gcl genera) format #+(or gcl genera) @@ -94,10 +96,8 @@ '(("~3i~_" . "")) #+genera '(("~@<" . "") ("; ~@;" . "; ") ("~@:>" . "") ("~:>" . ""))) :do (loop :for found = (search unsupported format) :while found :do - (setf format - (concatenate 'simple-string - (subseq format 0 found) replacement - (subseq format (+ found (length unsupported))))))) + (setf format (strcat (subseq format 0 found) replacement + (subseq format (+ found (length unsupported))))))) format) (let* (;; For bug reporting sanity, please always bump this version when you modify this file. ;; Please also modify asdf.asd to reflect this change. The script bin/bump-version @@ -107,7 +107,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.018") + (asdf-version "2.019") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -185,7 +185,7 @@ (push sym bothly-exported-symbols) (push sym formerly-exported-symbols))) (loop :for sym :in export :do - (unless (member sym bothly-exported-symbols :test 'string-equal) + (unless (member sym bothly-exported-symbols :test 'equal) (push sym newly-exported-symbols))) (loop :for user :in (package-used-by-list package) :for shadowing = (package-shadowing-symbols user) :do @@ -226,23 +226,19 @@ #:compile-file* #:source-file-type) :unintern (#:*asdf-revision* #:around #:asdf-method-combination - #:split #:make-collector + #:split #:make-collector #:do-dep #:do-one-dep + #:resolve-relative-location-component #:resolve-absolute-location-component #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function :export - (#:defsystem #:oos #:operate #:find-system #:run-shell-command + (#:defsystem #:oos #:operate #:find-system #:locate-system #:run-shell-command #:system-definition-pathname #:with-system-definitions - #:search-for-system-definition #:find-component ; miscellaneous - #:compile-system #:load-system #:test-system #:clear-system - #:compile-op #:load-op #:load-source-op - #:test-op - #:operation ; operations - #:feature ; sort-of operation - #:version ; metaphorically sort-of an operation - #:version-satisfies + #:search-for-system-definition #:find-component #:component-find-path + #:compile-system #:load-system #:load-systems #:test-system #:clear-system + #:operation #:compile-op #:load-op #:load-source-op #:test-op + #:feature #:version #:version-satisfies #:upgrade-asdf #:implementation-identifier #:implementation-type - - #:input-files #:output-files #:output-file #:perform ; operation methods + #:input-files #:output-files #:output-file #:perform #:operation-done-p #:explain #:component #:source-file @@ -334,11 +330,19 @@ #:process-source-registry #:system-registered-p #:asdf-message + #:user-output-translations-pathname + #:system-output-translations-pathname + #:user-output-translations-directory-pathname + #:system-output-translations-directory-pathname + #:user-source-registry + #:system-source-registry + #:user-source-registry-directory + #:system-source-registry-directory ;; Utilities #:absolute-pathname-p ;; #:aif #:it - ;; #:appendf + ;; #:appendf #:orf #:coerce-name #:directory-pathname-p ;; #:ends-with @@ -346,9 +350,7 @@ #:getenv ;; #:length=n-p ;; #:find-symbol* - #:merge-pathnames* - #:coerce-pathname - #:subpathname + #:merge-pathnames* #:coerce-pathname #:subpathname #:pathname-directory-pathname #:read-file-forms ;; #:remove-keys @@ -411,6 +413,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when condition-arguments condition-form condition-format condition-location coerce-name) + (ftype (function (&optional t) (values)) initialize-source-registry) #-(or cormanlisp gcl-pre2.7) (ftype (function (t t) t) (setf module-components-by-name))) @@ -419,8 +422,8 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when #+cormanlisp (progn (deftype logical-pathname () nil) - (defun* make-broadcast-stream () *error-output*) - (defun* file-namestring (p) + (defun make-broadcast-stream () *error-output*) + (defun file-namestring (p) (setf p (pathname p)) (format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p)))) @@ -520,6 +523,9 @@ and NIL NAME, TYPE and VERSION components" :do (pop reldir) (pop defrev) :finally (return (cons defabs (append (reverse defrev) reldir))))))))))) +(defun* ununspecific (x) + (if (eq x :unspecific) nil x)) + (defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*)) "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that if the SPECIFIED pathname does not have an absolute directory, @@ -538,9 +544,7 @@ Also, if either argument is NIL, then the other argument is returned unmodified. (name (or (pathname-name specified) (pathname-name defaults))) (type (or (pathname-type specified) (pathname-type defaults))) (version (or (pathname-version specified) (pathname-version defaults)))) - (labels ((ununspecific (x) - (if (eq x :unspecific) nil x)) - (unspecific-handler (p) + (labels ((unspecific-handler (p) (if (typep p 'logical-pathname) #'ununspecific #'identity))) (multiple-value-bind (host device directory unspecific-handler) (ecase (first directory) @@ -891,24 +895,21 @@ with given pathname and if it exists return its truename." (host (pathname-host pathname)) (port (ext:pathname-port pathname)) (directory (pathname-directory pathname))) - (flet ((not-unspecific (component) - (and (not (eq component :unspecific)) component))) - (cond ((or (not-unspecific port) - (and (not-unspecific host) (plusp (length host))) - (not-unspecific scheme)) - (let ((prefix "")) - (when (not-unspecific port) - (setf prefix (format nil ":~D" port))) - (when (and (not-unspecific host) (plusp (length host))) - (setf prefix (concatenate 'string host prefix))) - (setf prefix (concatenate 'string ":" prefix)) - (when (not-unspecific scheme) - (setf prefix (concatenate 'string scheme prefix))) - (assert (and directory (eq (first directory) :absolute))) - (make-pathname :directory `(:absolute ,prefix ,@(rest directory)) - :defaults pathname))) - (t - pathname))))) + (if (or (ununspecific port) + (and (ununspecific host) (plusp (length host))) + (ununspecific scheme)) + (let ((prefix "")) + (when (ununspecific port) + (setf prefix (format nil ":~D" port))) + (when (and (ununspecific host) (plusp (length host))) + (setf prefix (strcat host prefix))) + (setf prefix (strcat ":" prefix)) + (when (ununspecific scheme) + (setf prefix (strcat scheme prefix))) + (assert (and directory (eq (first directory) :absolute))) + (make-pathname :directory `(:absolute ,prefix ,@(rest directory)) + :defaults pathname))) + pathname)) ;;;; ------------------------------------------------------------------------- ;;;; ASDF Interface, in terms of generic functions. @@ -1171,45 +1172,6 @@ processed in order by OPERATE.")) (properties :accessor component-properties :initarg :properties :initform nil))) -;;; I believe that the following could probably be more efficiently done -;;; by a primary method that invokes SHARED-INITIALIZE in a way that would -;;; appropriately pass the slots to have their initforms re-applied, but I -;;; do not know how to write such a method. [2011/09/02:rpg] -(defmethod reinitialize-instance :after ((obj component) &rest initargs - &key (version nil version-suppliedp) - (description nil description-suppliedp) - (long-description nil - long-description-suppliedp) - (load-dependencies nil - ld-suppliedp) - in-order-to - do-first - inline-methods - parent - properties) - "We reuse component objects from previously-existing systems, so we need to -make sure we clear them thoroughly." - (declare (ignore initargs load-dependencies - long-description description version)) - ;; this is a cache and should be cleared - (slot-makunbound obj 'absolute-pathname) - ;; component operation times are no longer valid when the component changes - (clrhash (component-operation-times obj)) - (unless version-suppliedp (slot-makunbound obj 'version)) - (unless description-suppliedp - (slot-makunbound obj 'description)) - (unless long-description-suppliedp - (slot-makunbound obj 'long-description)) - ;; replicate the logic of the initforms... - (unless ld-suppliedp - (setf (component-load-dependencies obj) nil)) - (setf (component-in-order-to obj) in-order-to - (component-do-first obj) do-first - (component-inline-methods obj) inline-methods - (slot-value obj 'parent) parent - (slot-value obj 'properties) properties)) - - (defun* component-find-path (component) (reverse (loop :for c = component :then (component-parent c) @@ -1282,21 +1244,6 @@ make sure we clear them thoroughly." :initarg :default-component-class :accessor module-default-component-class))) -;;; see comment with REINITIALIZE-INSTANCE method on COMPONENT -;;; [2011/09/02:rpg] -(defmethod reinitialize-instance :after ((obj module) &rest initargs &key) - "Clear MODULE's slots so it can be reused." - (slot-makunbound obj 'components-by-name) - ;; this may be a more elegant approach than in the - ;; COMPONENT method [2011/09/02:rpg] - (loop :for (initarg slot-name default) :in - `((:components components nil) - (:if-component-dep-fails if-component-dep-fails :fail) - (:default-component-class default-component-class - ,*default-component-class*)) - :unless (member initarg initargs) - :do (setf (slot-value obj slot-name) default))) - (defun* component-parent-pathname (component) ;; No default anymore (in particular, no *default-pathname-defaults*). ;; If you force component to have a NULL pathname, you better arrange @@ -1330,7 +1277,12 @@ make sure we clear them thoroughly." (acons property new-value (slot-value c 'properties))))) new-value) -(defclass system (module) +(defclass proto-system () ; slots to keep when resetting a system + ;; To preserve identity for all objects, we'd need keep the components slots + ;; but also to modify parse-component-form to reset the recycled objects. + ((name) #|(components) (components-by-names)|#)) + +(defclass system (module proto-system) (;; description and long-description are now available for all component's, ;; but now also inherited from component, but we add the legacy accessor (description :accessor system-description :initarg :description) @@ -1343,24 +1295,6 @@ make sure we clear them thoroughly." :writer %set-system-source-file) (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on))) -;;; see comment with REINITIALIZE-INSTANCE method on COMPONENT -;;; [2011/09/02:rpg] -(defmethod reinitialize-instance :after ((obj system) &rest initargs &key) - "Clear SYSTEM's slots so it can be reused." - ;; note that SYSTEM-SOURCE-FILE is very specially handled, - ;; by DO-DEFSYSTEM, so we need to *PRESERVE* its value and - ;; not squash it. SYSTEM COMPONENTS are handled very specially, - ;; because they are always, effectively, reused, since the system component - ;; is made early in DO-DEFSYSTEM, instead of being made later, in - ;; PARSE-COMPONENT-FORM [2011/09/02:rpg] - (loop :for (initarg slot-name) :in - `((:author author) - (:maintainer maintainer) - (:licence licence) - (:defsystem-depends-on defsystem-depends-on)) - :unless (member initarg initargs) - :do (slot-makunbound obj slot-name))) - ;;;; ------------------------------------------------------------------------- ;;;; version-satisfies @@ -1448,11 +1382,10 @@ NB: ignores leading zeroes, and so doesn't distinguish between 2.003 and 2.3" (file-position s (+ start network-volume-offset #x14)))) - (concatenate 'string - (read-null-terminated-string s) - (progn - (file-position s (+ start remaining-offset)) - (read-null-terminated-string s)))))) + (strcat (read-null-terminated-string s) + (progn + (file-position s (+ start remaining-offset)) + (read-null-terminated-string s)))))) (defun* parse-windows-shortcut (pathname) (with-open-file (s pathname :element-type '(unsigned-byte 8)) @@ -1539,15 +1472,25 @@ called with an object of type asdf:system." ;;; for the sake of keeping things reasonably neat, we adopt a ;;; convention that functions in this list are prefixed SYSDEF- -(defparameter *system-definition-search-functions* - '(sysdef-central-registry-search - sysdef-source-registry-search - sysdef-find-asdf)) +(defvar *system-definition-search-functions* '()) + +(setf *system-definition-search-functions* + (append + ;; Remove known-incompatible sysdef functions from ancient sbcl asdf. + (remove 'contrib-sysdef-search *system-definition-search-functions*) + ;; Tuck our defaults at the end of the list if they were absent. + ;; This is imperfect, in case they were removed on purpose, + ;; but then it will be the responsibility of whoever does that + ;; to upgrade asdf before he does such a thing rather than after. + (remove-if #'(lambda (x) (member x *system-definition-search-functions*)) + '(sysdef-central-registry-search + sysdef-source-registry-search + sysdef-find-asdf)))) (defun* search-for-system-definition (system) - (let ((system-name (coerce-name system))) - (some #'(lambda (x) (funcall x system-name)) - (cons 'find-system-if-being-defined *system-definition-search-functions*)))) + (some (let ((name (coerce-name system))) #'(lambda (x) (funcall x name))) + (cons 'find-system-if-being-defined + *system-definition-search-functions*))) (defvar *central-registry* nil "A list of 'system directory designators' ASDF uses to find systems. @@ -1597,7 +1540,7 @@ Going forward, we recommend new users should be using the source-registry. (let ((shortcut (make-pathname :defaults defaults :version :newest :case :local - :name (concatenate 'string name ".asd") + :name (strcat name ".asd") :type "lnk"))) (when (probe-file* shortcut) (let ((target (parse-windows-shortcut shortcut))) @@ -1671,6 +1614,7 @@ Going forward, we recommend new users should be using the source-registry. 0))) (defmethod find-system ((name null) &optional (error-p t)) + (declare (ignorable name)) (when error-p (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) @@ -1690,7 +1634,7 @@ Going forward, we recommend new users should be using the source-registry. (let ((*systems-being-defined* (make-hash-table :test 'equal))) (funcall thunk)))) -(defmacro with-system-definitions (() &body body) +(defmacro with-system-definitions ((&optional) &body body) `(call-with-system-definitions #'(lambda () ,@body))) (defun* load-sysdef (name pathname) @@ -1711,17 +1655,27 @@ Going forward, we recommend new users should be using the source-registry. (load pathname))) (delete-package package))))) -(defmethod find-system ((name string) &optional (error-p t)) - (with-system-definitions () - (let* ((in-memory (system-registered-p name)) ; load from disk if absent or newer on disk - (previous (cdr in-memory)) - (previous (and (typep previous 'system) previous)) - (previous-time (car in-memory)) +(defun* locate-system (name) + "Given a system NAME designator, try to locate where to load the system from. +Returns four values: FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME +FOUNDP is true when a new was found, either a new unregistered one or a previously registered one. +FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed as is +PATHNAME when not null is a path from where to load the system, associated with FOUND-SYSTEM, or with the PREVIOUS system. +PREVIOUS when not null is a previously loaded SYSTEM object of same name. +PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded." + (let* ((name (coerce-name name)) + (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk + (previous (cdr in-memory)) + (previous (and (typep previous 'system) previous)) + (previous-time (car in-memory)) (found (search-for-system-definition name)) - (found-system (and (typep found 'system) found)) - (pathname (or (and (typep found '(or pathname string)) (pathname found)) - (and found-system (system-source-file found-system)) - (and previous (system-source-file previous))))) + (found-system (and (typep found 'system) found)) + (pathname (or (and (typep found '(or pathname string)) (pathname found)) + (and found-system (system-source-file found-system)) + (and previous (system-source-file previous)))) + (foundp (and (or found-system pathname previous) t))) + (check-type found (or null pathname system)) + (when foundp (setf pathname (resolve-symlinks* pathname)) (when (and pathname (not (absolute-pathname-p pathname))) (setf pathname (ensure-pathname-absolute pathname)) @@ -1731,23 +1685,37 @@ Going forward, we recommend new users should be using the source-registry. (system-source-file previous) pathname))) (%set-system-source-file pathname previous) (setf previous-time nil)) - (when (and found-system (not previous)) - (register-system found-system)) - (when (and pathname - (or (not previous-time) - ;; don't reload if it's already been loaded, - ;; or its filestamp is in the future which means some clock is skewed - ;; and trying to load might cause an infinite loop. - (< previous-time (safe-file-write-date pathname) (get-universal-time)))) - (load-sysdef name pathname)) - (let ((in-memory (system-registered-p name))) ; try again after loading from disk - (cond - (in-memory - (when pathname - (setf (car in-memory) (safe-file-write-date pathname))) - (cdr in-memory)) - (error-p - (error 'missing-component :requires name))))))) + (values foundp found-system pathname previous previous-time)))) + +(defmethod find-system ((name string) &optional (error-p t)) + (with-system-definitions () + (loop + (restart-case + (multiple-value-bind (foundp found-system pathname previous previous-time) + (locate-system name) + (declare (ignore foundp)) + (when (and found-system (not previous)) + (register-system found-system)) + (when (and pathname + (or (not previous-time) + ;; don't reload if it's already been loaded, + ;; or its filestamp is in the future which means some clock is skewed + ;; and trying to load might cause an infinite loop. + (< previous-time (safe-file-write-date pathname) (get-universal-time)))) + (load-sysdef name pathname)) + (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed + (return + (cond + (in-memory + (when pathname + (setf (car in-memory) (safe-file-write-date pathname))) + (cdr in-memory)) + (error-p + (error 'missing-component :requires name)))))) + (reinitialize-source-registry-and-retry () + :report (lambda (s) + (format s "~@<Retry finding system ~A after reinitializing the source-registry.~@:>" name)) + (initialize-source-registry)))))) (defun* find-system-fallback (requested fallback &rest keys &key source-file &allow-other-keys) (setf fallback (coerce-name fallback) @@ -1873,12 +1841,9 @@ Host, device and version components are taken from DEFAULTS." (and pathname (merge-pathnames* (coerce-pathname subpath :type type) (pathname-directory-pathname pathname)))) -(defun* try-subpathname (pathname subpath &key type) - (let* ((sp (and pathname (probe-file* pathname) - (subpathname pathname subpath :type type))) - (ts (and sp (probe-file* sp)))) - (and ts (values sp ts)))) - +(defun subpathname* (pathname subpath &key type) + (and pathname + (subpathname (ensure-directory-pathname pathname) subpath :type type))) ;;;; ------------------------------------------------------------------------- ;;;; Operations @@ -1982,10 +1947,9 @@ class specifier, not an operation." (cdr (assoc (type-of o) (component-in-order-to c)))) (defmethod component-self-dependencies ((o operation) (c component)) - (let ((all-deps (component-depends-on o c))) - (remove-if-not #'(lambda (x) - (member (component-name c) (cdr x) :test #'string=)) - all-deps))) + (remove-if-not + #'(lambda (x) (member (component-name c) (cdr x) :test #'string=)) + (component-depends-on o c))) (defmethod input-files ((operation operation) (c component)) (let ((parent (component-parent c)) @@ -2357,10 +2321,18 @@ recursive calls to traverse.") ((component-parent c) (around-compile-hook (component-parent c))))) +(defun ensure-function (fun &key (package :asdf)) + (etypecase fun + ((or symbol function) fun) + (cons (eval `(function ,fun))) + (string (eval `(function ,(with-standard-io-syntax + (let ((*package* (find-package package))) + (read-from-string fun)))))))) + (defmethod call-with-around-compile-hook ((c component) thunk) (let ((hook (around-compile-hook c))) (if hook - (funcall hook thunk) + (funcall (ensure-function hook) thunk) (funcall thunk)))) (defvar *compile-op-compile-file-function* 'compile-file* @@ -2546,31 +2518,38 @@ recursive calls to traverse.") (defgeneric* operate (operation-class system &key &allow-other-keys)) (defgeneric* perform-plan (plan &key)) +;;;; Separating this into a different function makes it more forward-compatible +(defun* cleanup-upgraded-asdf (old-version) + (let ((new-version (asdf:asdf-version))) + (unless (equal old-version new-version) + (cond + ((version-satisfies new-version old-version) + (asdf-message (compatfmt "~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%") + old-version new-version)) + ((version-satisfies old-version new-version) + (warn (compatfmt "~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%") + old-version new-version)) + (t + (asdf-message (compatfmt "~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%") + old-version new-version))) + (let ((asdf (funcall (find-symbol* 'find-system :asdf) :asdf))) + ;; Invalidate all systems but ASDF itself. + (setf *defined-systems* (make-defined-systems-table)) + (register-system asdf) + ;; If we're in the middle of something, restart it. + (when *systems-being-defined* + (let ((l (loop :for name :being :the :hash-keys :of *systems-being-defined* :collect name))) + (clrhash *systems-being-defined*) + (dolist (s l) (find-system s nil)))) + t)))) + ;;;; Try to upgrade of ASDF. If a different version was used, return T. ;;;; We need do that before we operate on anything that depends on ASDF. (defun* upgrade-asdf () (let ((version (asdf:asdf-version))) (handler-bind (((or style-warning warning) #'muffle-warning)) (operate 'load-op :asdf :verbose nil)) - (let ((new-version (asdf:asdf-version))) - (block nil - (cond - ((equal version new-version) - (return nil)) - ((version-satisfies new-version version) - (asdf-message (compatfmt "~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%") - version new-version)) - ((version-satisfies version new-version) - (warn (compatfmt "~&~@<Downgraded ASDF from version ~A to version ~A~@:>~%") - version new-version)) - (t - (asdf-message (compatfmt "~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%") - version new-version))) - (let ((asdf (funcall (find-symbol* 'find-system :asdf) :asdf))) - ;; invalidate all systems but ASDF itself - (setf *defined-systems* (make-defined-systems-table)) - (register-system asdf) - t))))) + (cleanup-upgraded-asdf version))) (defmethod perform-plan ((steps list) &key) (let ((*package* *package*) @@ -2634,7 +2613,7 @@ created with the same initargs as the original one. ")) (setf (documentation 'oos 'function) (format nil - "Short for _operate on system_ and an alias for the OPERATE function. ~&~&~a" + "Short for _operate on system_ and an alias for the OPERATE function.~%~%~a" operate-docstring)) (setf (documentation 'operate 'function) operate-docstring)) @@ -2646,6 +2625,9 @@ See OPERATE for details." (apply 'operate 'load-op system args) t) +(defun* load-systems (&rest systems) + (map () 'load-system systems)) + (defun* compile-system (system &rest args &key force verbose version &allow-other-keys) "Shorthand for `(operate 'asdf:compile-op system)`. See OPERATE @@ -2702,7 +2684,7 @@ Returns the new tree (which probably shares structure with the old one)" (if first-op-tree (progn (aif (assoc op2 (cdr first-op-tree)) - (if (find c (cdr it)) + (if (find c (cdr it) :test #'equal) nil (setf (cdr it) (cons c (cdr it)))) (setf (cdr first-op-tree) @@ -2724,8 +2706,7 @@ Returns the new tree (which probably shares structure with the old one)" (defvar *serial-depends-on* nil) (defun* sysdef-error-component (msg type name value) - (sysdef-error (concatenate 'string msg - (compatfmt "~&~@<The value specified for ~(~A~) ~A is ~S~@:>")) + (sysdef-error (strcat msg (compatfmt "~&~@<The value specified for ~(~A~) ~A is ~S~@:>")) type name value)) (defun* check-component-input (type name weakly-depends-on @@ -2802,29 +2783,22 @@ Returns the new tree (which probably shares structure with the old one)" (warn (compatfmt "~@<Invalid version ~S for component ~S~@[ of ~S~]~@:>") version name parent))) - (let* ((other-args (remove-keys - '(components pathname default-component-class - perform explain output-files operation-done-p - weakly-depends-on - depends-on serial in-order-to) - rest)) + (let* ((args (list* :name (coerce-name name) + :pathname pathname + :parent parent + (remove-keys + '(components pathname default-component-class + perform explain output-files operation-done-p + weakly-depends-on depends-on serial in-order-to) + rest))) (ret (find-component parent name))) (when weakly-depends-on (appendf depends-on (remove-if (complement #'find-system) weakly-depends-on))) (when *serial-depends-on* (push *serial-depends-on* depends-on)) - (if ret - (apply 'reinitialize-instance ret - :name (coerce-name name) - :pathname pathname - :parent parent - other-args) - (setf ret - (apply 'make-instance (class-for-type parent type) - :name (coerce-name name) - :pathname pathname - :parent parent - other-args))) + (if ret ; preserve identity + (apply 'reinitialize-instance ret args) + (setf ret (apply 'make-instance (class-for-type parent type) args))) (component-pathname ret) ; eagerly compute the absolute pathname (when (typep ret 'module) (setf (module-default-component-class ret) @@ -2856,6 +2830,10 @@ Returns the new tree (which probably shares structure with the old one)" (%refresh-component-inline-methods ret rest) ret))) +(defun* reset-system (system &rest keys &key &allow-other-keys) + (change-class (change-class system 'proto-system) 'system) + (apply 'reinitialize-instance system keys)) + (defun* do-defsystem (name &rest options &key pathname (class 'system) defsystem-depends-on &allow-other-keys) @@ -2868,14 +2846,14 @@ Returns the new tree (which probably shares structure with the old one)" (with-system-definitions () (let* ((name (coerce-name name)) (registered (system-registered-p name)) - (system (cdr (or registered - (register-system (make-instance 'system :name name))))) + (registered! (if registered + (rplaca registered (get-universal-time)) + (register-system (make-instance 'system :name name)))) + (system (reset-system (cdr registered!) + :name name :source-file (load-pathname))) (component-options (remove-keys '(:class) options))) - (%set-system-source-file (load-pathname) system) (setf (gethash name *systems-being-defined*) system) - (when registered - (setf (car registered) (get-universal-time))) - (map () 'load-system defsystem-depends-on) + (apply 'load-systems defsystem-depends-on) ;; We change-class (when necessary) AFTER we load the defsystem-dep's ;; since the class might not be defined as part of those. (let ((class (class-for-type nil class))) @@ -2960,7 +2938,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." (ccl:run-program (cond ((os-unix-p) "/bin/sh") - ((os-windows-p) (format nil "CMD /C ~A" command)) ; BEWARE! + ((os-windows-p) (strcat "CMD /C " command)) ; BEWARE! (t (error "Unsupported OS"))) (if (os-unix-p) (list "-c" command) '()) :input nil :output *verbose-out* :wait t))) @@ -2972,6 +2950,9 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." (list "-c" command) :input nil :output *verbose-out*)) + #+cormanlisp + (win32:system command) + #+ecl ;; courtesy of Juan Jose Garcia Ripoll (ext:system command) @@ -3162,20 +3143,23 @@ located." (defun* user-configuration-directories () (let ((dirs - `(,(try-subpathname (getenv "XDG_CONFIG_HOME") "common-lisp/") - ,@(loop :with dirs = (getenv "XDG_CONFIG_DIRS") - :for dir :in (split-string dirs :separator ":") - :collect (try-subpathname dir "common-lisp/")) + `(,@(when (os-unix-p) + (cons + (subpathname* (getenv "XDG_CONFIG_HOME") "common-lisp/") + (loop :with dirs = (getenv "XDG_CONFIG_DIRS") + :for dir :in (split-string dirs :separator ":") + :collect (subpathname* dir "common-lisp/")))) ,@(when (os-windows-p) - `(,(try-subpathname (or #+lispworks (sys:get-folder-path :local-appdata) - (getenv "LOCALAPPDATA")) - "common-lisp/config/") + `(,(subpathname* (or #+lispworks (sys:get-folder-path :local-appdata) + (getenv "LOCALAPPDATA")) + "common-lisp/config/") ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData - ,(try-subpathname (or #+lispworks (sys:get-folder-path :appdata) - (getenv "APPDATA")) - "common-lisp/config/"))) - ,(try-subpathname (user-homedir) ".config/common-lisp/")))) - (remove-duplicates (remove-if #'null dirs) :from-end t :test 'equal))) + ,(subpathname* (or #+lispworks (sys:get-folder-path :appdata) + (getenv "APPDATA")) + "common-lisp/config/"))) + ,(subpathname (user-homedir) ".config/common-lisp/")))) + (remove-duplicates (remove-if-not #'absolute-pathname-p dirs) + :from-end t :test 'equal))) (defun* system-configuration-directories () (cond @@ -3183,19 +3167,23 @@ located." ((os-windows-p) (aif ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData - (try-subpathname (or #+lispworks (sys:get-folder-path :common-appdata) - (getenv "ALLUSERSAPPDATA") - (subpathname (getenv "ALLUSERSPROFILE") "Application Data/")) - "common-lisp/config/") + (subpathname* (or #+lispworks (sys:get-folder-path :common-appdata) + (getenv "ALLUSERSAPPDATA") + (subpathname* (getenv "ALLUSERSPROFILE") "Application Data/")) + "common-lisp/config/") (list it))))) -(defun* in-first-directory (dirs x) - (loop :for dir :in dirs - :thereis (and dir (probe-file* (merge-pathnames* x (ensure-directory-pathname dir)))))) -(defun* in-user-configuration-directory (x) - (in-first-directory (user-configuration-directories) x)) -(defun* in-system-configuration-directory (x) - (in-first-directory (system-configuration-directories) x)) +(defun* in-first-directory (dirs x &key (direction :input)) + (loop :with fun = (ecase direction + ((nil :input :probe) 'probe-file*) + ((:output :io) 'identity)) + :for dir :in dirs + :thereis (and dir (funcall fun (merge-pathnames* x (ensure-directory-pathname dir)))))) + +(defun* in-user-configuration-directory (x &key (direction :input)) + (in-first-directory (user-configuration-directories) x :direction direction)) +(defun* in-system-configuration-directory (x &key (direction :input)) + (in-first-directory (system-configuration-directories) x :direction direction)) (defun* configuration-inheritance-directive-p (x) (let ((kw '(:inherit-configuration :ignore-inherited-configuration))) @@ -3549,14 +3537,14 @@ Please remove it from your ASDF configuration")) (defparameter *output-translations-file* (coerce-pathname "asdf-output-translations.conf")) (defparameter *output-translations-directory* (coerce-pathname "asdf-output-translations.conf.d/")) -(defun* user-output-translations-pathname () - (in-user-configuration-directory *output-translations-file*)) -(defun* system-output-translations-pathname () - (in-system-configuration-directory *output-translations-file*)) -(defun* user-output-translations-directory-pathname () - (in-user-configuration-directory *output-translations-directory*)) -(defun* system-output-translations-directory-pathname () - (in-system-configuration-directory *output-translations-directory*)) +(defun* user-output-translations-pathname (&key (direction :input)) + (in-user-configuration-directory *output-translations-file* :direction direction)) +(defun* system-output-translations-pathname (&key (direction :input)) + (in-system-configuration-directory *output-translations-file* :direction direction)) +(defun* user-output-translations-directory-pathname (&key (direction :input)) + (in-user-configuration-directory *output-translations-directory* :direction direction)) +(defun* system-output-translations-directory-pathname (&key (direction :input)) + (in-system-configuration-directory *output-translations-directory* :direction direction)) (defun* environment-output-translations () (getenv "ASDF_OUTPUT_TRANSLATIONS")) @@ -3679,8 +3667,8 @@ effectively disabling the output translation facility." (translate-pathname path absolute-source destination)))) (defun* apply-output-translations (path) + #+cormanlisp (truenamize path) #-cormanlisp (etypecase path - #+cormanlisp (t (truenamize path)) (logical-pathname path) ((or pathname string) @@ -3721,7 +3709,7 @@ effectively disabling the output translation facility." (defun* tmpize-pathname (x) (make-pathname - :name (format nil "ASDF-TMP-~A" (pathname-name x)) + :name (strcat "ASDF-TMP-" (pathname-name x)) :defaults x)) (defun* delete-file-if-exists (x) @@ -3852,6 +3840,7 @@ with a different configuration, so the configuration would be re-read then." (loop :for f :in entries :for p = (or (and (typep f 'logical-pathname) f) (let* ((u (ignore-errors (funcall merger f)))) + ;; The first u avoids a cumbersome (truename u) error (and u (equal (ignore-errors (truename u)) f) u))) :when p :collect p) entries)) @@ -3865,8 +3854,9 @@ with a different configuration, so the configuration would be re-read then." (filter-logical-directory-results directory entries #'(lambda (f) - (make-pathname :defaults directory :version (pathname-version f) - :name (pathname-name f) :type (pathname-type f)))))) + (make-pathname :defaults directory + :name (pathname-name f) :type (ununspecific (pathname-type f)) + :version (ununspecific (pathname-version f))))))) (defun* directory-asd-files (directory) (directory-files directory *wild-asd*)) @@ -3875,9 +3865,9 @@ with a different configuration, so the configuration would be re-read then." (let* ((directory (ensure-directory-pathname directory)) #-(or abcl cormanlisp genera xcl) (wild (merge-pathnames* - #-(or abcl allegro cmu lispworks scl xcl) + #-(or abcl allegro cmu lispworks sbcl scl xcl) *wild-directory* - #+(or abcl allegro cmu lispworks scl xcl) "*.*" + #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*" directory)) (dirs #-(or abcl cormanlisp genera xcl) @@ -3887,16 +3877,16 @@ with a different configuration, so the configuration would be re-read then." #+(or abcl xcl) (system:list-directory directory) #+cormanlisp (cl::directory-subdirs directory) #+genera (fs:directory-list directory)) - #+(or abcl allegro cmu genera lispworks scl xcl) + #+(or abcl allegro cmu genera lispworks sbcl scl xcl) (dirs (loop :for x :in dirs :for d = #+(or abcl xcl) (extensions:probe-directory x) #+allegro (excl:probe-directory x) - #+(or cmu scl) (directory-pathname-p x) + #+(or cmu sbcl scl) (directory-pathname-p x) #+genera (getf (cdr x) :directory) #+lispworks (lw:file-directory-p x) :when d :collect #+(or abcl allegro xcl) d #+genera (ensure-directory-pathname (first x)) - #+(or cmu lispworks scl) x))) + #+(or cmu lispworks sbcl scl) x))) (filter-logical-directory-results directory dirs (let ((prefix (normalize-pathname-directory-component @@ -4021,12 +4011,12 @@ with a different configuration, so the configuration would be re-read then." #+scl (:tree #p"file://modules/"))) (defun* default-source-registry () `(:source-registry - #+sbcl (:directory ,(try-subpathname (user-homedir) ".sbcl/systems/")) + #+sbcl (:directory ,(subpathname (user-homedir) ".sbcl/systems/")) (:directory ,(default-directory)) ,@(loop :for dir :in `(,@(when (os-unix-p) `(,(or (getenv "XDG_DATA_HOME") - (try-subpathname (user-homedir) ".local/share/")) + (subpathname (user-homedir) ".local/share/")) ,@(split-string (or (getenv "XDG_DATA_DIRS") "/usr/local/share:/usr/share") :separator ":"))) @@ -4037,18 +4027,18 @@ with a different configuration, so the configuration would be re-read then." (getenv "APPDATA")) ,(or #+lispworks (sys:get-folder-path :common-appdata) (getenv "ALLUSERSAPPDATA") - (try-subpathname (getenv "ALLUSERSPROFILE") "Application Data/"))))) - :collect `(:directory ,(try-subpathname dir "common-lisp/systems/")) - :collect `(:tree ,(try-subpathname dir "common-lisp/source/"))) + (subpathname* (getenv "ALLUSERSPROFILE") "Application Data/"))))) + :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) + :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) :inherit-configuration)) -(defun* user-source-registry () - (in-user-configuration-directory *source-registry-file*)) -(defun* system-source-registry () - (in-system-configuration-directory *source-registry-file*)) -(defun* user-source-registry-directory () - (in-user-configuration-directory *source-registry-directory*)) -(defun* system-source-registry-directory () - (in-system-configuration-directory *source-registry-directory*)) +(defun* user-source-registry (&key (direction :input)) + (in-user-configuration-directory *source-registry-file* :direction direction)) +(defun* system-source-registry (&key (direction :input)) + (in-system-configuration-directory *source-registry-file* :direction direction)) +(defun* user-source-registry-directory (&key (direction :input)) + (in-user-configuration-directory *source-registry-directory* :direction direction)) +(defun* system-source-registry-directory (&key (direction :input)) + (in-system-configuration-directory *source-registry-directory* :direction direction)) (defun* environment-source-registry () (getenv "CL_SOURCE_REGISTRY")) @@ -4126,8 +4116,7 @@ with a different configuration, so the configuration would be re-read then." (collect (list directory :recurse recurse :exclude exclude))))) :test 'equal :from-end t))) -;; Will read the configuration and initialize all internal variables, -;; and return the new configuration. +;; Will read the configuration and initialize all internal variables. (defun* compute-source-registry (&optional parameter (registry *source-registry*)) (dolist (entry (flatten-source-registry parameter)) (destructuring-bind (directory &key recurse exclude) entry diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 0c926f7..d73037c 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -23,7 +23,7 @@ New in this release: * Feature enhancements * Changes - * ASDF2 updated to version 2.018. + * ASDF2 updated to version 2.019. * Behavior of STRING-TO-OCTETS has changed. This is an incompatible change from the previous version but should be more useful when a buffer is given which is not large enough to hold @@ -33,6 +33,8 @@ New in this release: * ANSI compliance fixes: * Bugfixes: + * DECODE-FLOAT was not correctly declared and could not be + compiled to handle double-double-floats. * Trac Tickets: ----------------------------------------------------------------------- Summary of changes: src/contrib/asdf/asdf.lisp | 539 +++++++++++++++++++------------------- src/general-info/release-20d.txt | 4 +- 2 files changed, 267 insertions(+), 276 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. release-20c-23-geea8746
by Raymond Toy 19 Nov '11

19 Nov '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via eea87468f7479a152a34ff2ad8f6fd53a011c36b (commit) from 44ca897b25dda1179df1d8bfa3469d75594385d6 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit eea87468f7479a152a34ff2ad8f6fd53a011c36b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Nov 18 20:27:26 2011 -0800 Remove hppa-assem.s. It's not referenced anywhere. diff --git a/src/lisp/hppa-assem.s b/src/lisp/hppa-assem.s deleted file mode 100644 index f021720..0000000 --- a/src/lisp/hppa-assem.s +++ /dev/null @@ -1,356 +0,0 @@ -#define LANGUAGE_ASSEMBLY - -#include "internals.h" -#include "lispregs.h" - - .import $global$,data - .import foreign_function_call_active,data - .import current_control_stack_pointer,data - .import current_control_frame_pointer,data - .import current_binding_stack_pointer,data - .import current_dynamic_space_free_pointer,data - - .space $TEXT$ - .subspa $CODE$ - .import $$dyncall,MILLICODE - - -/* - * Call-into-lisp - */ - - .export call_into_lisp -call_into_lisp - .proc - .callinfo entry_gr=18,save_rp - .enter - /* arg0=function, arg1=cfp, arg2=nargs */ - - /* Clear the descriptor regs, moving in args as approporate. */ - copy r0,reg_CODE - copy r0,reg_FDEFN - copy arg0,reg_LEXENV - zdep arg2,29,30,reg_NARGS - copy r0,reg_OCFP - copy r0,reg_LRA - copy r0,reg_A0 - copy r0,reg_A1 - copy r0,reg_A2 - copy r0,reg_A3 - copy r0,reg_A4 - copy r0,reg_A5 - copy r0,reg_L0 - copy r0,reg_L1 - copy r0,reg_L2 - - /* Establish NIL. */ - ldil L%NIL,reg_NULL - ldo R%NIL(reg_NULL),reg_NULL - - /* Turn on pseudo-atomic. */ - ldo 4(r0),reg_ALLOC - - /* No longer in foreign function call land. */ - addil L%foreign_function_call_active-$global$,dp - stw r0,R%foreign_function_call_active-$global$(0,r1) - - /* Load lisp state. */ - addil L%current_dynamic_space_free_pointer-$global$,dp - ldw R%current_dynamic_space_free_pointer-$global$(0,r1),r1 - add reg_ALLOC,r1,reg_ALLOC - addil L%current_binding_stack_pointer-$global$,dp - ldw R%current_binding_stack_pointer-$global$(0,r1),reg_BSP - addil L%current_control_stack_pointer-$global$,dp - ldw R%current_control_stack_pointer-$global$(0,r1),reg_CSP - addil L%current_control_frame_pointer-$global$,dp - ldw R%current_control_frame_pointer-$global$(0,r1),reg_OCFP - copy arg1,reg_CFP - - /* End of pseudo-atomic. */ - addit,od -4,reg_ALLOC,reg_ALLOC - - /* Establish lisp arguments. */ - ldw 0(reg_CFP),reg_A0 - ldw 4(reg_CFP),reg_A1 - ldw 8(reg_CFP),reg_A2 - ldw 12(reg_CFP),reg_A3 - ldw 16(reg_CFP),reg_A4 - ldw 20(reg_CFP),reg_A5 - - /* Calculate the LRA. */ - ldil L%lra+type_OtherPointer,reg_LRA - ldo R%lra+type_OtherPointer(reg_LRA),reg_LRA - - /* Indirect the closure */ - ldw CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_CODE - addi 6*4-type_FunctionPointer,reg_CODE,reg_LIP - - /* And into lisp we go. */ - .export break_here -break_here - be,n 0(sr5,reg_LIP) - - .align 8 -lra - .word type_ReturnPcHeader - copy reg_OCFP,reg_CSP - - /* Copy CFP (r4) into someplace else and restore r4. */ - copy reg_CFP,reg_NL1 - ldw -64(0,sp),r4 - - /* Copy the return value. */ - copy reg_A0,ret0 - - /* Turn on pseudo-atomic. */ - addi 4,reg_ALLOC,reg_ALLOC - - /* Store the lisp state. */ - copy reg_ALLOC,reg_NL0 - depi 0,31,3,reg_NL0 - addil L%current_dynamic_space_free_pointer-$global$,dp - stw reg_NL0,R%current_dynamic_space_free_pointer-$global$(0,r1) - addil L%current_binding_stack_pointer-$global$,dp - stw reg_BSP,R%current_binding_stack_pointer-$global$(0,r1) - addil L%current_control_stack_pointer-$global$,dp - stw reg_CSP,R%current_control_stack_pointer-$global$(0,r1) - addil L%current_control_frame_pointer-$global$,dp - stw reg_NL1,R%current_control_frame_pointer-$global$(0,r1) - - /* Back in C land. [CSP is just a handy non-zero value.] */ - addil L%foreign_function_call_active-$global$,dp - stw reg_CSP,R%foreign_function_call_active-$global$(0,r1) - - /* Turn off pseudo-atomic and check for traps. */ - addit,od -4,reg_ALLOC,reg_ALLOC - - /* And thats all. */ - .leave - .procend - - -/* - * Call-into-C - */ - - - .export call_into_c -call_into_c - /* Set up a lisp stack frame. Note: we convert the raw return pc into - * a fixnum pc-offset because we don't have ahold of an lra object. - */ - copy reg_CFP, reg_OCFP - copy reg_CSP, reg_CFP - addi 32, reg_CSP, reg_CSP - stw reg_OCFP, 0(0,reg_CFP) - sub reg_LIP, reg_CODE, reg_NL5 - addi 3-type_OtherPointer, reg_NL5, reg_NL5 - stw reg_NL5, 4(0,reg_CFP) - stw reg_CODE, 8(0,reg_CFP) - - /* Turn on pseudo-atomic. */ - addi 4, reg_ALLOC, reg_ALLOC - - /* Store the lisp state. */ - copy reg_ALLOC,reg_NL5 - depi 0,31,3,reg_NL5 - addil L%current_dynamic_space_free_pointer-$global$,dp - stw reg_NL5,R%current_dynamic_space_free_pointer-$global$(0,r1) - addil L%current_binding_stack_pointer-$global$,dp - stw reg_BSP,R%current_binding_stack_pointer-$global$(0,r1) - addil L%current_control_stack_pointer-$global$,dp - stw reg_CSP,R%current_control_stack_pointer-$global$(0,r1) - addil L%current_control_frame_pointer-$global$,dp - stw reg_CFP,R%current_control_frame_pointer-$global$(0,r1) - - /* Back in C land. [CSP is just a handy non-zero value.] */ - addil L%foreign_function_call_active-$global$,dp - stw reg_CSP,R%foreign_function_call_active-$global$(0,r1) - - /* Turn off pseudo-atomic and check for traps. */ - addit,od -4,reg_ALLOC,reg_ALLOC - - /* in order to be able to call incrementally linked (ld -A) functions, - we have to do some mild trickery here */ - copy reg_CFUNC,%r22 - bl $$dyncall,r31 - copy r31, r2 - - /* Clear the callee saves descriptor regs. */ - copy r0, reg_A5 - copy r0, reg_L0 - copy r0, reg_L1 - copy r0, reg_L2 - - /* Turn on pseudo-atomic. */ - ldi 4, reg_ALLOC - - /* Turn off foreign function call. */ - addil L%foreign_function_call_active-$global$,dp - stw r0,R%foreign_function_call_active-$global$(0,r1) - - /* Load ALLOC. */ - addil L%current_dynamic_space_free_pointer-$global$,dp - ldw R%current_dynamic_space_free_pointer-$global$(0,r1),r1 - add reg_ALLOC,r1,reg_ALLOC - - /* We don't need to load OCFP, CFP, CSP, or BSP because they are - * in caller saves registers. - */ - - /* End of pseudo-atomic. */ - addit,od -4,reg_ALLOC,reg_ALLOC - - /* Restore CODE. Even though it is in a callee saves register - * it might have been GC'ed. - */ - ldw 8(0,reg_CFP), reg_CODE - - /* Restore the return pc. */ - ldw 4(0,reg_CFP), reg_NL0 - addi type_OtherPointer-3, reg_NL0, reg_NL0 - add reg_CODE, reg_NL0, reg_LIP - - /* Pop the lisp stack frame, and back we go. */ - copy reg_CFP, reg_CSP - be 0(4,reg_LIP) - copy reg_OCFP, reg_CFP - - - -/* - * Stuff to sanctify a block of memory for execution. - */ - - .EXPORT sanctify_for_execution -sanctify_for_execution - .proc - .callinfo - .enter - /* arg0=start addr, arg1=length in bytes */ - add arg0,arg1,arg1 - ldo -1(arg1),arg1 - depi 0,31,5,arg0 - depi 0,31,5,arg1 - ldsid (arg0),r19 - mtsp r19,sr1 - ldi 32,r19 ; bytes per cache line -sanctify_loop - fdc 0(sr1,arg0) - comb,< arg0,arg1,sanctify_loop - fic,m r19(sr1,arg0) - .leave - .procend - - -/* - * Trampolines. - */ - - .EXPORT closure_tramp -closure_tramp - /* reg_FDEFN holds the fdefn object. */ - ldw FDEFN_FUNCTION_OFFSET(0,reg_FDEFN),reg_LEXENV - ldw CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_L0 - addi FUNCTION_CODE_OFFSET, reg_L0, reg_LIP - bv,n 0(reg_LIP) - - .EXPORT undefined_tramp -undefined_tramp - break trap_Error,0 - /* Number of argument bytes */ - .byte 4 - .byte UNDEFINED_SYMBOL_ERROR - /* Escape to create 16bit BE number from following two values */ - .byte 254 - /* SC_OFFSET(sc_DescriptorReg,reg_LEXENV) */ - /* Shouldn't this be reg_FDEFN, instead? */ - .byte (0x40 + sc_DescriptorReg) - .byte 1 - .align 4 - - -/* - * Core saving/restoring support - */ - - .export call_on_stack -call_on_stack - /* arg0 = fn to invoke, arg1 = new stack base */ - - /* Compute the new stack pointer. */ - addi 64,arg1,sp - - /* Zero out the previous stack pointer. */ - stw r0,-4(0,sp) - - /* Invoke the function. */ - ble 0(4,arg0) - copy r31, r2 - - /* Flame out. */ - break 0,0 - - .export save_state -save_state - .proc - .callinfo entry_gr=18,entry_fr=21,save_rp,calls - .enter - - /* Remember the function we want to invoke */ - copy arg0,r19 - - /* Pass the new stack pointer in as arg0 */ - copy sp,arg0 - - /* Leave arg1 as arg1. */ - - /* do the call. */ - ble 0(4,r19) - copy r31, r2 - -_restore_state - .leave - .procend - - .export restore_state -restore_state - .proc - .callinfo - copy arg0,sp - b _restore_state - copy arg1,ret0 - .procend - - - - .export SingleStepTraps -SingleStepTraps - break trap_SingleStepBreakpoint,0 - break trap_SingleStepBreakpoint,0 - - - - .align 8 - .export function_end_breakpoint_guts -function_end_breakpoint_guts - .word type_ReturnPcHeader - /* multiple value return point -- just jump to trap. */ - b,n function_end_breakpoint_trap - /* single value return point -- convert to multiple w/ n=1 */ - copy reg_CSP, reg_OCFP - addi 4, reg_CSP, reg_CSP - addi 4, r0, reg_NARGS - copy reg_NULL, reg_A1 - copy reg_NULL, reg_A2 - copy reg_NULL, reg_A3 - copy reg_NULL, reg_A4 - copy reg_NULL, reg_A5 - - .export function_end_breakpoint_trap -function_end_breakpoint_trap - break trap_FunctionEndBreakpoint,0 - b,n function_end_breakpoint_trap - - .export function_end_breakpoint_end -function_end_breakpoint_end ----------------------------------------------------------------------- Summary of changes: src/lisp/hppa-assem.s | 356 ------------------------------------------------- 1 files changed, 0 insertions(+), 356 deletions(-) delete mode 100644 src/lisp/hppa-assem.s hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. release-20c-22-g44ca897
by Raymond Toy 17 Nov '11

17 Nov '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 44ca897b25dda1179df1d8bfa3469d75594385d6 (commit) from 667a476adeae105dd8b712a14d4e136f58e5810d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 44ca897b25dda1179df1d8bfa3469d75594385d6 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Nov 16 23:21:18 2011 -0800 Forgot to compiler that DECODE-FLOAT can return +/- 1w0 for the sign. diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 985ce24..6dcd544 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -306,7 +306,9 @@ (defknown decode-float (float) (values (float 0.5d0 (1d0)) float-exponent - (member 1f0 -1f0 -1d0 1d0)) + (member 1f0 -1f0 -1d0 1d0 + #+double-double -1w0 + #+double-double 1w0)) (movable foldable flushable explicit-check)) (defknown scale-float (float float-exponent) float (movable foldable flushable explicit-check)) ----------------------------------------------------------------------- Summary of changes: src/compiler/fndb.lisp | 4 +++- 1 files changed, 3 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch rearrange-dir updated. release-20c-21-g667a476
by Raymond Toy 07 Nov '11

07 Nov '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rearrange-dir has been updated via 667a476adeae105dd8b712a14d4e136f58e5810d (commit) from 26f37caf6696a9a8816c5872526c88d94845c187 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 667a476adeae105dd8b712a14d4e136f58e5810d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Nov 6 19:13:00 2011 -0800 Don't add .git directory to src tarball! If compression or version is not given, use some reasonable default so we don't end up with a weird tarball. diff --git a/bin/make-src-dist.sh b/bin/make-src-dist.sh index f19dae2..a65aad8 100755 --- a/bin/make-src-dist.sh +++ b/bin/make-src-dist.sh @@ -25,7 +25,18 @@ done shift `expr $OPTIND - 1` -VERSION=$1 +# If no compression given, default to gzip (on the assumption that +# that is available everywhere.) +if [ -z "$ENABLE_BZIP" -a -z "$ENABLE_GZIP" ]; then + ENABLE_GZIP=-b +fi + +# If no version is given, default to today's date +if [ -n "$1" ]; then + VERSION=$1 +else + VERSION="`date '+%Y-%m-%d-%H:%M:%S'`" +fi echo Creating source distribution if [ -n "$ENABLE_GZIP" ]; then @@ -37,7 +48,7 @@ if [ -n "$ENABLE_BZIP" ]; then ZIPEXT="bz2" fi -GTAR_OPTIONS="--exclude=CVS --exclude='*.pot.~*~'" +GTAR_OPTIONS="--exclude=.git --exclude='*.pot.~*~'" if [ -z "$INSTALL_DIR" ]; then echo " Compressing with $ZIP" ${GTAR:-tar} ${GTAR_OPTIONS} -cf - src | ${ZIP} > cmucl-src-$VERSION.tar.$ZIPEXT ----------------------------------------------------------------------- Summary of changes: bin/make-src-dist.sh | 15 +++++++++++++-- 1 files changed, 13 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch rearrange-dir updated. release-20c-20-g26f37ca
by Raymond Toy 06 Nov '11

06 Nov '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rearrange-dir has been updated via 26f37caf6696a9a8816c5872526c88d94845c187 (commit) from 4f7056212a2c6de20d0ae59776e9c29cdb4e9d26 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 26f37caf6696a9a8816c5872526c88d94845c187 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Nov 5 22:51:11 2011 -0700 Update paths to new locations. diff --git a/BUILDING b/BUILDING index 675cb99..c11ef26 100644 --- a/BUILDING +++ b/BUILDING @@ -55,17 +55,14 @@ Setting up a build environment or, if you want to use the git sources directly: - git clone git://common-lisp.net/projects/cmucl/cmucl.git src - - (The "src" is important to keep everything the same with git as it - was with cvs.) + git clone git://common-lisp.net/projects/cmucl/cmucl.git Whatever you do, the sources must be in a directory named src inside the base directory. Since the build tools keep all generated files in separate target directories, the src directory can be read-only (e.g. mounted read-only via NFS, etc.) - The build tools are all in the src/tools directory. + The build tools are all in the bin directory. That's it, you are now ready to build CMU CL. @@ -82,7 +79,7 @@ a) Simple builds Use this to build from a version of CMUCL that is very close to the sources you are trying to build now: - src/tools/build.sh -C "" -o "<name-of-old-lisp> <options-to-lisp>" + bin/build.sh -C "" -o "<name-of-old-lisp> <options-to-lisp>" This will build CMUCL 3 times, each time with the result of the previous build. The last time, the additional libraries like CLX, @@ -101,7 +98,7 @@ b) Slightly more complicated builds For these, you can use this: - src/tools/build.sh -C "" -o "<old-lisp>" -B boot1.lisp -B boot2.lisp + bin/build.sh -C "" -o "<old-lisp>" -B boot1.lisp -B boot2.lisp The bootstrap files listed with the -B option (as many as needed) are loaded in order, so be sure to get them right. @@ -124,8 +121,8 @@ read the bootfiles for additional instructions, if any. If there are no bootfiles, then you can use a) above. -The build.sh script supports other options, and src/tools/build.sh -? -will give a quick summary. Read src/tools/build.sh for more +The build.sh script supports other options, and bin/build.sh -? +will give a quick summary. Read bin/build.sh for more information. A general outline of the build process @@ -219,10 +216,10 @@ To complete the build so that you something similar to what the releases of CMUCL do, there are a few more steps: e) Build the utilities like Gray streams, simple streams, CLX, CLM, - and Hemlock. Use the src/tools/build-utils.sh script for this, as + and Hemlock. Use the bin/build-utils.sh script for this, as described below -f) Create tarfiles using the src/tools/make-dist.sh script, as +f) Create tarfiles using the bin/make-dist.sh script, as explained below. With these tarfiles, you can install them anywhere. The contents of @@ -246,13 +243,13 @@ the scripts included with this little text? Overview of the included build scripts -------------------------------------- -* src/tools/build.sh [-123obvuBCU?] +* bin/build.sh [-123obvuBCU?] This is the main build script. It essentially calls the other build scripts described below in the proper sequence to build cmucl from an existing binary of cmucl. -* src/tools/create-target.sh target-directory [lisp-variant [motif-variant]] +* bin/create-target.sh target-directory [lisp-variant [motif-variant]] This script creates a new target directory, which is a shadow of the source directory, that will contain all the files that are created by @@ -290,7 +287,7 @@ sample setenv.lisp includes a set of features that should work for the intended configuration. Note also that some adding or removing some features may require a cross-compile instead of a normal compile. -* src/tools/clean-target.sh [-l] target-directory [more dirs] +* bin/clean-target.sh [-l] target-directory [more dirs] Cleans the given target directory, so that all created files will be removed. This is useful to force recompilation. If the -l flag is @@ -298,7 +295,7 @@ given, then the C runtime is also removed, including all the lisp executable, any lisp cores, all object files, lisp.nm, internals.h, and the config file. -* src/tools/build-world.sh target-directory [build-binary] [build-flags...] +* bin/build-world.sh target-directory [build-binary] [build-flags...] Starts a complete world build for the given target, using the lisp binary/core specified as a build host. The recompilation step will @@ -309,13 +306,13 @@ step of the world build will inform you of that fact. In that case, you'll have to use the rebuild-lisp.sh script, and then restart the world build process with build-world.sh -* src/tools/rebuild-lisp.sh target-directory +* bin/rebuild-lisp.sh target-directory This script will force a complete recompilation of the C runtime code of CMU CL (aka the lisp executable). Doing this will necessitate building a new kernel.core file, using build-world.sh. -* src/tools/load-world.sh target-directory version +* bin/load-world.sh target-directory version This will finish the CMU CL rebuilding process, by loading the remaining compiled files generated in the world build process into the @@ -330,14 +327,14 @@ ISO8601 format is often a good idea, e.g. "18d+ 2002-05-06" for a binary that is based on sources current on the 6th May, 2002, which is post the 18d release. -* src/tools/build-utils.sh target-directory +* bin/build-utils.sh target-directory This script will build auxiliary libraries packaged with CMU CL, including CLX, CMUCL/Motif, the Motif debugger, inspector, and control panel, and the Hemlock editor. It will use the lisp executable and core of the given target. -* src/tools/make-dist.sh [-bg] [-G group] [-O owner] target-directory version arch os +* bin/make-dist.sh [-bg] [-G group] [-O owner] target-directory version arch os This script creates both main and extra distribution tarballs from the given target directory, using the make-main-dist.sh and @@ -369,7 +366,7 @@ names will have the form: Of course, the "bz2" will be "gz" if you specified gzip compression instead of bzip. -* /src/tools/make-main-dist.sh target-directory version arch os +* /bin/make-main-dist.sh target-directory version arch os This is script is not normally invoked by the user; make-dist will do it appropriately. @@ -382,7 +379,7 @@ simple streams. This is intended to be run from make-dist.sh. -* src/tools/make-extra-dist.sh target-directory version arch os +* bin/make-extra-dist.sh target-directory version arch os This is script is not normally invoked by the user; make-dist will do it appropriately. @@ -426,7 +423,7 @@ Set up everything as described in the setup section above. Then execute: # Create a new target directory structure/config for OpenBSD: -src/tools/create-target.sh openbsd OpenBSD_gencgc OpenBSD +bin/create-target.sh openbsd OpenBSD_gencgc OpenBSD # edit openbsd/setenv.lisp to contain what we want: cat <<EOF > openbsd/setenv.lisp @@ -452,7 +449,7 @@ cat <<EOF > openbsd/setenv.lisp EOF # Recompile the lisp world, and dump a new kernel.core: -src/tools/build-world.sh openbsd lisp # Or whatever you need to invoke your +bin/build-world.sh openbsd lisp # Or whatever you need to invoke your # current lisp binary+core # If build-world tells you (as it will the first time) that: @@ -462,15 +459,15 @@ src/tools/build-world.sh openbsd lisp # Or whatever you need to invoke your # build-world.sh: # Recompile lisp binary itself: -src/tools/rebuild-lisp.sh openbsd +bin/rebuild-lisp.sh openbsd # Restart build-world.sh now: -src/tools/build-world.sh openbsd lisp +bin/build-world.sh openbsd lisp # Now we populate the kernel.core with further compiled files, # and dump the final lisp.core file: -src/tools/load-world.sh openbsd "18d+ 2002-05-06" +bin/load-world.sh openbsd "18d+ 2002-05-06" # The second argument above is the version number that the built # core will announce. Please always put the build-date and some @@ -555,8 +552,8 @@ up-to-date with the current sources. Create a cross-compiler directory to hold the cross-compiler and a target directory to hold the result: - src/tools/create-target.sh xcross - src/tools/create-target.sh xtarget + bin/create-target.sh xcross + bin/create-target.sh xtarget 2. Adjust cross-compilation script @@ -592,13 +589,13 @@ up-to-date with the current sources. 3. Build the cross compiler and target Now compile the result: - src/tools/cross-build-world.sh xtarget xcross xtarget/cross.lisp [v9 binary] + bin/cross-build-world.sh xtarget xcross xtarget/cross.lisp [v9 binary] 4. Rebuild the lisp files: When this finishes, you need to compile the C code: - src/tools/rebuild-lisp.sh xtarget + bin/rebuild-lisp.sh xtarget At this point, you may want to run cross-build-world.sh again to generate a new kernel.core. It shouldn't build anything; @@ -608,7 +605,7 @@ up-to-date with the current sources. With the new kernel.core, we need to create a lisp.core: - src/tools/load-world.sh xtarget "new lisp" + bin/load-world.sh xtarget "new lisp" Test the result with @@ -635,8 +632,8 @@ same file system, via NFS or something else. compiled target. We assume we are on ppc/darwin. So, when running create-target.sh we need to specify the target: - src/tools/create-target.sh x86-cross x86 - src/tools/create-target.sh x86-target x86 + bin/create-target.sh x86-cross x86 + bin/create-target.sh x86-target x86 2. Adjust the cross-compilation script. An example for ppc/darwin to x86/linux is in src/tools/cross-scripts/cross-ppc-x86.lisp. @@ -644,7 +641,7 @@ same file system, via NFS or something else. 3. Build the cross compiler and target, as above, using the specified cross-compile script: - src/tools/cross-build-world.sh x86-target x86-cross cross.lisp [ppc binary] + bin/cross-build-world.sh x86-target x86-cross cross.lisp [ppc binary] where cross.lisp is the cross-compile script from 2) above. @@ -661,13 +658,13 @@ same file system, via NFS or something else. Compile the lisp code: - src/tools/rebuild-lisp.sh x86-target + bin/rebuild-lisp.sh x86-target 5. Now run load-world.sh to create the desired lisp.core from lisp and kernel.core. As above, PCL has not been compiled, so select restart 3 (return nil from pclload) to create lisp.core - src/tools/load-world.sh x86-target "new x86" + bin/load-world.sh x86-target "new x86" At this point, you will have a shiny new lisp on the new platform. Since it's missing PCL, you will need to do at least one normal build ----------------------------------------------------------------------- Summary of changes: BUILDING | 69 +++++++++++++++++++++++++++++-------------------------------- 1 files changed, 33 insertions(+), 36 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0