Date: Tuesday, December 14, 2010 @ 16:26:02
Author: rtoy
Path: /project/cmucl/cvsroot/src/lisp
Tag: cross-sol-x86-branch
Modified: Config.sparc_common
Add -DFEATURE_SSE2 if we're compiling on x86 and have either
FEATURE_X87 or FEATURE_SSE2 defined.
---------------------+
Config.sparc_common | 14 +++++++++++++-
1 file changed, 13 insertions(+), 1 deletion(-)
Index: src/lisp/Config.sparc_common
diff -u src/lisp/Config.sparc_common:1.3.6.1 src/lisp/Config.sparc_common:1.3.6.2
-…
[View More]-- src/lisp/Config.sparc_common:1.3.6.1 Mon Dec 13 23:25:11 2010
+++ src/lisp/Config.sparc_common Tue Dec 14 16:26:02 2010
@@ -27,12 +27,24 @@
GC_SRC = gencgc.c
endif
+# Enable support for SSE2. If FEATURE_X87 is set, we want SSE2
+# support in the C code too so that the same binary is built in both
+# cases. If neither is set, then we don't want any SSE2 support at
+# all.
+ifdef FEATURE_X87
+SSE2 = -DFEATURE_SSE2
+else
+ifdef FEATURE_SSE2
+SSE2 = -DFEATURE_SSE2
+endif
+endif
+
# Enable support for Unicode
ifdef FEATURE_UNICODE
UNICODE = -DUNICODE
endif
-CPPFLAGS = -I. -I$(PATH1) -DSOLARIS -DSVR4 $(CC_V8PLUS) $(LINKAGE) $(GENCGC) $(UNICODE)
+CPPFLAGS = -I. -I$(PATH1) -DSOLARIS -DSVR4 $(CC_V8PLUS) $(LINKAGE) $(GENCGC) $(UNICODE) $(SSE2)
CFLAGS = -g $(CC_V8PLUS)
[View Less]
Date: Saturday, December 11, 2010 @ 17:39:46
Author: rtoy
Path: /project/cmucl/cvsroot/src/code
Modified: intl.lisp
Speed up building on sparc. Time taken is now almost half! This was
caused by all the calls to stat in PROBE-FILE in LOCATE-DOMAIN-FILE
for files that did not exist. The default locale was C, so every
message lookup was causing many stat's to non-exist files. (There
were over 1000 calls/sec on a 750 MHz sparc!)
So we cache all the calls to PROBE-FILE in LOCATE-DOMAIN-…
[View More]FILE. But
just in case, we also allow the user to get at the hash table to
examine it (GET-DOMAIN-FILE-CACHE) and also allow the user to clear it
(CLEAR-DOMAIN-FILE-CACHE) in case new translations are added without
restarting lisp.
-----------+
intl.lisp | 70 ++++++++++++++++++++++++++++++++++++++----------------------
1 file changed, 45 insertions(+), 25 deletions(-)
Index: src/code/intl.lisp
diff -u src/code/intl.lisp:1.8 src/code/intl.lisp:1.9
--- src/code/intl.lisp:1.8 Tue Jul 13 23:13:20 2010
+++ src/code/intl.lisp Sat Dec 11 17:39:46 2010
@@ -1,6 +1,6 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-
-;;; $Revision: 1.8 $
+;;; $Revision: 1.9 $
;;; Copyright 1999-2010 Paul Foley (mycroft(a)actrix.gen.nz)
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
@@ -23,7 +23,7 @@
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
;;; DAMAGE.
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.8 2010-07-14 03:13:20 rtoy Rel $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.9 2010-12-11 22:39:46 rtoy Exp $")
(in-package "INTL")
@@ -79,29 +79,49 @@
(ash (the (unsigned-byte 8) (read-byte stream)) 8)
(the (unsigned-byte 8) (read-byte stream))))
-(defun locate-domain-file (domain locale locale-dir)
- ;; The default locale-dir includes search lists. If we get called
- ;; before the search lists are initialized, we lose. The search
- ;; lists are initialized in environment-init, which sets
- ;; *environment-list-initialized*. This way, we return NIL to
- ;; indicate there's no domain file to use.
- (when lisp::*environment-list-initialized*
- (flet ((path (locale base)
- (merge-pathnames (make-pathname :directory (list :relative locale
- "LC_MESSAGES")
- :name domain :type "mo")
- base)))
- (let ((locale (or (gethash locale *locale-aliases*) locale)))
- (dolist (base (if (listp locale-dir) locale-dir (list locale-dir)))
- (let ((probe
- (or (probe-file (path locale base))
- (let ((dot (position #\. locale)))
- (and dot (probe-file (path (subseq locale 0 dot) base))))
- (let ((at (position #\@ locale)))
- (and at (probe-file (path (subseq locale 0 at) base))))
- (let ((us (position #\_ locale)))
- (and us (probe-file (path (subseq locale 0 us) base)))))))
- (when probe (return probe))))))))
+;; If the domain file doesn't exist because the locale isn't
+;; supported, we end up doing a huge number of stats looking for a
+;; non-existent file everytime a translation is needed. This is
+;; really expensive. So create a cache to hold the results.
+(let ((domain-file-cache (make-hash-table :test 'equal)))
+ (defun get-domain-file-cache ()
+ ;; Mostly for debugging to let the user get at the cache.
+ domain-file-cache)
+ (defun clear-domain-file-cache ()
+ ;; Mostly for debugging. But also useful if we now have installed
+ ;; some new translations.
+ (clrhash domain-file-cache))
+ (defun locate-domain-file (domain locale locale-dir)
+ ;; The default locale-dir includes search lists. If we get called
+ ;; before the search lists are initialized, we lose. The search
+ ;; lists are initialized in environment-init, which sets
+ ;; *environment-list-initialized*. This way, we return NIL to
+ ;; indicate there's no domain file to use.
+ (when lisp::*environment-list-initialized*
+ (flet ((path (locale base)
+ (merge-pathnames (make-pathname :directory (list :relative locale
+ "LC_MESSAGES")
+ :name domain :type "mo")
+ base))
+ (memoized-probe-file (p)
+ ;; Cache the results of probe-file and return the
+ ;; cached value when possible.
+ (multiple-value-bind (value foundp)
+ (gethash p domain-file-cache)
+ (if foundp
+ value
+ (setf (gethash p domain-file-cache) (probe-file p))))))
+ (let ((locale (or (gethash locale *locale-aliases*) locale)))
+ (dolist (base (if (listp locale-dir) locale-dir (list locale-dir)))
+ (let ((probe
+ (or (memoized-probe-file (path locale base))
+ (let ((dot (position #\. locale)))
+ (and dot (memoized-probe-file (path (subseq locale 0 dot) base))))
+ (let ((at (position #\@ locale)))
+ (and at (memoized-probe-file (path (subseq locale 0 at) base))))
+ (let ((us (position #\_ locale)))
+ (and us (memoized-probe-file (path (subseq locale 0 us) base)))))))
+ (when probe (return probe)))))))))
(defun find-encoding (domain)
(when (null (domain-entry-encoding domain))
[View Less]
Date: Thursday, December 9, 2010 @ 00:13:51
Author: rtoy
Path: /project/cmucl/cvsroot/src
Modified: code/seq.lisp general-info/release-20c.txt
SUBSEQ was sometimes crashing lisp when the end index was less than
the start. This was due to one of two things: The result sequence
was created with a negative length, creating invalid objects, or
accessing the invalid object would cause a segfault.
code/seq.lisp:
o Declare the type of LENGTH in MAKE-SEQUENCE-OF-TYPE better. It's
not a …
[View More]fixnum, but an index (non-negative fixnum). This should catch
any mistakes where we try to create sequences of negative length.
o Explicitly catch invalid START and END indices in VECTOR-SUBSEQ* and
LIST-SUBSEQ* and signal an error
general-info/release-20c.txt:
o Document bugfix.
------------------------------+
code/seq.lisp | 8 ++++++--
general-info/release-20c.txt | 3 +++
2 files changed, 9 insertions(+), 2 deletions(-)
Index: src/code/seq.lisp
diff -u src/code/seq.lisp:1.58 src/code/seq.lisp:1.59
--- src/code/seq.lisp:1.58 Tue Apr 20 13:57:45 2010
+++ src/code/seq.lisp Thu Dec 9 00:13:50 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/seq.lisp,v 1.58 2010-04-20 17:57:45 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/code/seq.lisp,v 1.59 2010-12-09 05:13:50 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -124,7 +124,7 @@
(defun make-sequence-of-type (type length)
"Returns a sequence of the given TYPE and LENGTH."
- (declare (fixnum length))
+ (declare (type index length))
(case (type-specifier-atom type)
(list (make-list length))
((bit-vector simple-bit-vector) (make-array length :element-type '(mod 2)))
@@ -285,6 +285,8 @@
(defun vector-subseq* (sequence start &optional end)
(declare (vector sequence) (fixnum start))
(when (null end) (setf end (length sequence)))
+ (unless (<= start end)
+ (error "Illegal bounding indices: ~S ~S" start end))
(do ((old-index start (1+ old-index))
(new-index 0 (1+ new-index))
(copy (make-sequence-like sequence (- end start))))
@@ -294,6 +296,8 @@
(defun list-subseq* (sequence start &optional end)
(declare (list sequence) (fixnum start))
+ (when (and end (> start (the fixnum end)))
+ (error "Illegal bounding indices: ~S ~S" start end))
(if (and end (>= start (the fixnum end)))
()
(let* ((groveled (nthcdr start sequence))
Index: src/general-info/release-20c.txt
diff -u src/general-info/release-20c.txt:1.13 src/general-info/release-20c.txt:1.14
--- src/general-info/release-20c.txt:1.13 Thu Dec 2 09:26:45 2010
+++ src/general-info/release-20c.txt Thu Dec 9 00:13:50 2010
@@ -85,6 +85,9 @@
- FORMAT signals an warning if ~:; is used inside ~:[.
- SET-SYSTEM-EXTERNAL-FORMAT was not actually setting the filename
encoding if given.
+ - SUBSEQ with an end index less than the start index sometimes
+ crashes CMUCL. Now, signal an error if the boudns are not
+ valid.
* Trac Tickets:
[View Less]
Date: Wednesday, December 8, 2010 @ 18:57:02
Author: rtoy
Path: /project/cmucl/cvsroot/src/contrib/asdf
Modified: asdf.lisp
Update to version 2.011.
-----------+
asdf.lisp | 351 ++++++++++++++++++++++++++++++++----------------------------
1 file changed, 188 insertions(+), 163 deletions(-)
Index: src/contrib/asdf/asdf.lisp
diff -u src/contrib/asdf/asdf.lisp:1.10 src/contrib/asdf/asdf.lisp:1.11
--- src/contrib/asdf/asdf.lisp:1.10 Thu Nov 4 10:04:10 2010
+++ src/contrib/asdf/asdf.…
[View More]lisp Wed Dec 8 18:57:02 2010
@@ -49,6 +49,8 @@
(cl:in-package :cl-user)
+#+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
+
(eval-when (:compile-toplevel :load-toplevel :execute)
;;; make package if it doesn't exist yet.
;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
@@ -66,20 +68,25 @@
;;;; Create packages in a way that is compatible with hot-upgrade.
;;;; See https://bugs.launchpad.net/asdf/+bug/485687
-;;;; See more at the end of the file.
+;;;; See more near the end of the file.
(eval-when (:load-toplevel :compile-toplevel :execute)
(defvar *asdf-version* nil)
(defvar *upgraded-p* nil)
- (let* ((asdf-version "2.010") ;; same as 2.146
+ (let* (;; For bug reporting sanity, please always bump this version when you modify this file.
+ ;; "2.345" would be an official release
+ ;; "2.345.6" would be a development version in the official upstream
+ ;; "2.345.0.7" would be your local modification of an official release
+ ;; "2.345.6.7" would be your local modification of a development version
+ (asdf-version "2.011")
(existing-asdf (fboundp 'find-system))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
(unless (and existing-asdf already-there)
(when existing-asdf
- (format *error-output*
- "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%"
- existing-version asdf-version))
+ (format *trace-output*
+ "~&~@<; ~@;Upgrading ASDF package ~@[from version ~A ~]to version ~A~@:>~%"
+ existing-version asdf-version))
(labels
((unlink-package (package)
(let ((u (find-package package)))
@@ -180,7 +187,8 @@
#:apply-output-translations #:translate-pathname* #:resolve-location)
:unintern
(#:*asdf-revision* #:around #:asdf-method-combination
- #:split #:make-collector)
+ #:split #:make-collector
+ #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function
:fmakunbound
(#:system-source-file
#:component-relative-pathname #:system-relative-pathname
@@ -234,6 +242,7 @@
#:system-relative-pathname
#:map-systems
+ #:operation-description
#:operation-on-warnings
#:operation-on-failure
#:component-visited-p
@@ -286,7 +295,7 @@
;; Utilities
#:absolute-pathname-p
- ;; #:aif #:it
+ ;; #:aif #:it
;; #:appendf
#:coerce-name
#:directory-pathname-p
@@ -295,11 +304,12 @@
#:getenv
;; #:get-uid
;; #:length=n-p
+ ;; #:find-symbol*
#:merge-pathnames*
#:pathname-directory-pathname
#:read-file-forms
- ;; #:remove-keys
- ;; #:remove-keyword
+ ;; #:remove-keys
+ ;; #:remove-keyword
#:resolve-symlinks
#:split-string
#:component-name-to-pathname-components
@@ -312,31 +322,6 @@
(cons existing-version *upgraded-p*)
*upgraded-p*))))))
-;; More cleanups in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
-(when *upgraded-p*
- #+ecl
- (when (find-class 'compile-op nil)
- (defmethod update-instance-for-redefined-class :after
- ((c compile-op) added deleted plist &key)
- (declare (ignore added deleted))
- (let ((system-p (getf plist 'system-p)))
- (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
- (when (find-class 'module nil)
- (eval
- '(progn
- (defmethod update-instance-for-redefined-class :after
- ((m module) added deleted plist &key)
- (declare (ignorable deleted plist))
- (when *asdf-verbose* (format *trace-output* "Updating ~A~%" m))
- (when (member 'components-by-name added)
- (compute-module-components-by-name m)))
- (defmethod update-instance-for-redefined-class :after
- ((s system) added deleted plist &key)
- (declare (ignorable deleted plist))
- (when *asdf-verbose* (format *trace-output* "Updating ~A~%" s))
- (when (member 'source-file added)
- (%set-system-source-file (probe-asd (component-name s) (component-pathname s)) s)))))))
-
;;;; -------------------------------------------------------------------------
;;;; User-visible parameters
;;;;
@@ -378,7 +363,8 @@
(setf excl:*warn-on-nested-reader-conditionals* nil)))
;;;; -------------------------------------------------------------------------
-;;;; ASDF Interface, in terms of generic functions.
+;;;; General Purpose Utilities
+
(macrolet
((defdef (def* def)
`(defmacro ,def* (name formals &rest rest)
@@ -390,113 +376,6 @@
(defdef defgeneric* defgeneric)
(defdef defun* defun))
-(defgeneric* find-system (system &optional error-p))
-(defgeneric* perform-with-restarts (operation component))
-(defgeneric* perform (operation component))
-(defgeneric* operation-done-p (operation component))
-(defgeneric* explain (operation component))
-(defgeneric* output-files (operation component))
-(defgeneric* input-files (operation component))
-(defgeneric* component-operation-time (operation component))
-(defgeneric* operation-description (operation component)
- (:documentation "returns a phrase that describes performing this operation
-on this component, e.g. \"loading /a/b/c\".
-You can put together sentences using this phrase."))
-
-(defgeneric* system-source-file (system)
- (:documentation "Return the source file in which system is defined."))
-
-(defgeneric* component-system (component)
- (:documentation "Find the top-level system containing COMPONENT"))
-
-(defgeneric* component-pathname (component)
- (:documentation "Extracts the pathname applicable for a particular component."))
-
-(defgeneric* component-relative-pathname (component)
- (:documentation "Returns a pathname for the component argument intended to be
-interpreted relative to the pathname of that component's parent.
-Despite the function's name, the return value may be an absolute
-pathname, because an absolute pathname may be interpreted relative to
-another pathname in a degenerate way."))
-
-(defgeneric* component-property (component property))
-
-(defgeneric* (setf component-property) (new-value component property))
-
-(defgeneric* version-satisfies (component version))
-
-(defgeneric* find-component (base path)
- (:documentation "Finds the component with PATH starting from BASE module;
-if BASE is nil, then the component is assumed to be a system."))
-
-(defgeneric* source-file-type (component system))
-
-(defgeneric* operation-ancestor (operation)
- (:documentation
- "Recursively chase the operation's parent pointer until we get to
-the head of the tree"))
-
-(defgeneric* component-visited-p (operation component)
- (:documentation "Returns the value stored by a call to
-VISIT-COMPONENT, if that has been called, otherwise NIL.
-This value stored will be a cons cell, the first element
-of which is a computed key, so not interesting. The
-CDR wil be the DATA value stored by VISIT-COMPONENT; recover
-it as (cdr (component-visited-p op c)).
- In the current form of ASDF, the DATA value retrieved is
-effectively a boolean, indicating whether some operations are
-to be performed in order to do OPERATION X COMPONENT. If the
-data value is NIL, the combination had been explored, but no
-operations needed to be performed."))
-
-(defgeneric* visit-component (operation component data)
- (:documentation "Record DATA as being associated with OPERATION
-and COMPONENT. This is a side-effecting function: the association
-will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the
-OPERATION\).
- No evidence that DATA is ever interesting, beyond just being
-non-NIL. Using the data field is probably very risky; if there is
-already a record for OPERATION X COMPONENT, DATA will be quietly
-discarded instead of recorded.
- Starting with 2.006, TRAVERSE will store an integer in data,
-so that nodes can be sorted in decreasing order of traversal."))
-
-
-(defgeneric* (setf visiting-component) (new-value operation component))
-
-(defgeneric* component-visiting-p (operation component))
-
-(defgeneric* component-depends-on (operation component)
- (:documentation
- "Returns a list of dependencies needed by the component to perform
- the operation. A dependency has one of the following forms:
-
- (<operation> <component>*), where <operation> is a class
- designator and each <component> is a component
- designator, which means that the component depends on
- <operation> having been performed on each <component>; or
-
- (FEATURE <feature>), which means that the component depends
- on <feature>'s presence in *FEATURES*.
-
- Methods specialized on subclasses of existing component types
- should usually append the results of CALL-NEXT-METHOD to the
- list."))
-
-(defgeneric* component-self-dependencies (operation component))
-
-(defgeneric* traverse (operation component)
- (:documentation
-"Generate and return a plan for performing OPERATION on COMPONENT.
-
-The plan returned is a list of dotted-pairs. Each pair is the CONS
-of ASDF operation object and a COMPONENT object. The pairs will be
-processed in order by OPERATE."))
-
-
-;;;; -------------------------------------------------------------------------
-;;;; General Purpose Utilities
-
(defmacro while-collecting ((&rest collectors) &body body)
"COLLECTORS should be a list of names for collections. A collector
defines a function that, when applied to an argument inside BODY, will
@@ -535,11 +414,11 @@
(directory (pathname-directory specified))
(directory
(cond
- #-(or sbcl cmu)
+ #-(or sbcl cmu scl)
((stringp directory) `(:absolute ,directory) directory)
#+gcl
- ((and (consp directory) (stringp (first directory)))
- `(:absolute ,@directory))
+ ((and (consp directory) (not (member (first directory) '(:absolute :relative))))
+ `(:relative ,@directory))
((or (null directory)
(and (consp directory) (member (first directory) '(:absolute :relative))))
directory)
@@ -675,9 +554,8 @@
:append (list k v)))
(defun* getenv (x)
- (#+abcl ext:getenv
+ (#+(or abcl clisp) ext:getenv
#+allegro sys:getenv
- #+clisp ext:getenv
#+clozure ccl:getenv
#+(or cmu scl) (lambda (x) (cdr (assoc x ext:*environment-list* :test #'string=)))
#+ecl si:getenv
@@ -723,7 +601,8 @@
:defaults pathspec))))
(defun* absolute-pathname-p (pathspec)
- (and pathspec (eq :absolute (car (pathname-directory (pathname pathspec))))))
+ (and (typep pathspec '(or pathname string))
+ (eq :absolute (car (pathname-directory (pathname pathspec))))))
(defun* length=n-p (x n) ;is it that (= (length x) n) ?
(check-type n (integer 0 *))
@@ -755,7 +634,7 @@
(defun* get-uid ()
#+allegro (excl.osi:getuid)
#+clisp (loop :for s :in '("posix:uid" "LINUX:getuid")
- :for f = (ignore-errors (read-from-string s))
+ :for f = (ignore-errors (read-from-string s))
:when f :return (funcall f))
#+(or cmu scl) (unix:unix-getuid)
#+ecl #.(cl:if (cl:< ext:+ecl-version-number+ 100601)
@@ -777,6 +656,9 @@
:directory '(:absolute)
:name nil :type nil :version nil))
+(defun* find-symbol* (s p)
+ (find-symbol (string s) p))
+
(defun* probe-file* (p)
"when given a pathname P, probes the filesystem for a file or directory
with given pathname and if it exists return its truename."
@@ -785,8 +667,8 @@
(string (probe-file* (parse-namestring p)))
(pathname (unless (wild-pathname-p p)
#.(or #+(or allegro clozure cmu ecl sbcl scl) '(probe-file p)
- #+clisp (aif (find-symbol (string :probe-pathname) :ext) `(ignore-errors (,it p)))
- '(ignore-errors (truename p)))))))
+ #+clisp (aif (find-symbol (string '#:probe-pathname) :ext) `(ignore-errors (,it p)))
+ '(ignore-errors (truename p)))))))
(defun* truenamize (p)
"Resolve as much of a pathname as possible"
@@ -859,6 +741,134 @@
(translate-pathname absolute-pathname wild-root (wilden new-base))))))
;;;; -------------------------------------------------------------------------
+;;;; ASDF Interface, in terms of generic functions.
+(defgeneric* find-system (system &optional error-p))
+(defgeneric* perform-with-restarts (operation component))
+(defgeneric* perform (operation component))
+(defgeneric* operation-done-p (operation component))
+(defgeneric* explain (operation component))
+(defgeneric* output-files (operation component))
+(defgeneric* input-files (operation component))
+(defgeneric* component-operation-time (operation component))
+(defgeneric* operation-description (operation component)
+ (:documentation "returns a phrase that describes performing this operation
+on this component, e.g. \"loading /a/b/c\".
+You can put together sentences using this phrase."))
+
+(defgeneric* system-source-file (system)
+ (:documentation "Return the source file in which system is defined."))
+
+(defgeneric* component-system (component)
+ (:documentation "Find the top-level system containing COMPONENT"))
+
+(defgeneric* component-pathname (component)
+ (:documentation "Extracts the pathname applicable for a particular component."))
+
+(defgeneric* component-relative-pathname (component)
+ (:documentation "Returns a pathname for the component argument intended to be
+interpreted relative to the pathname of that component's parent.
+Despite the function's name, the return value may be an absolute
+pathname, because an absolute pathname may be interpreted relative to
+another pathname in a degenerate way."))
+
+(defgeneric* component-property (component property))
+
+(defgeneric* (setf component-property) (new-value component property))
+
+(defgeneric* version-satisfies (component version))
+
+(defgeneric* find-component (base path)
+ (:documentation "Finds the component with PATH starting from BASE module;
+if BASE is nil, then the component is assumed to be a system."))
+
+(defgeneric* source-file-type (component system))
+
+(defgeneric* operation-ancestor (operation)
+ (:documentation
+ "Recursively chase the operation's parent pointer until we get to
+the head of the tree"))
+
+(defgeneric* component-visited-p (operation component)
+ (:documentation "Returns the value stored by a call to
+VISIT-COMPONENT, if that has been called, otherwise NIL.
+This value stored will be a cons cell, the first element
+of which is a computed key, so not interesting. The
+CDR wil be the DATA value stored by VISIT-COMPONENT; recover
+it as (cdr (component-visited-p op c)).
+ In the current form of ASDF, the DATA value retrieved is
+effectively a boolean, indicating whether some operations are
+to be performed in order to do OPERATION X COMPONENT. If the
+data value is NIL, the combination had been explored, but no
+operations needed to be performed."))
+
+(defgeneric* visit-component (operation component data)
+ (:documentation "Record DATA as being associated with OPERATION
+and COMPONENT. This is a side-effecting function: the association
+will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the
+OPERATION\).
+ No evidence that DATA is ever interesting, beyond just being
+non-NIL. Using the data field is probably very risky; if there is
+already a record for OPERATION X COMPONENT, DATA will be quietly
+discarded instead of recorded.
+ Starting with 2.006, TRAVERSE will store an integer in data,
+so that nodes can be sorted in decreasing order of traversal."))
+
+
+(defgeneric* (setf visiting-component) (new-value operation component))
+
+(defgeneric* component-visiting-p (operation component))
+
+(defgeneric* component-depends-on (operation component)
+ (:documentation
+ "Returns a list of dependencies needed by the component to perform
+ the operation. A dependency has one of the following forms:
+
+ (<operation> <component>*), where <operation> is a class
+ designator and each <component> is a component
+ designator, which means that the component depends on
+ <operation> having been performed on each <component>; or
+
+ (FEATURE <feature>), which means that the component depends
+ on <feature>'s presence in *FEATURES*.
+
+ Methods specialized on subclasses of existing component types
+ should usually append the results of CALL-NEXT-METHOD to the
+ list."))
+
+(defgeneric* component-self-dependencies (operation component))
+
+(defgeneric* traverse (operation component)
+ (:documentation
+"Generate and return a plan for performing OPERATION on COMPONENT.
+
+The plan returned is a list of dotted-pairs. Each pair is the CONS
+of ASDF operation object and a COMPONENT object. The pairs will be
+processed in order by OPERATE."))
+
+
+;;;; -------------------------------------------------------------------------
+;;; Methods in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
+(when *upgraded-p*
+ #+ecl
+ (when (find-class 'compile-op nil)
+ (defmethod update-instance-for-redefined-class :after
+ ((c compile-op) added deleted plist &key)
+ (declare (ignore added deleted))
+ (let ((system-p (getf plist 'system-p)))
+ (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
+ (when (find-class 'module nil)
+ (eval
+ `(defmethod update-instance-for-redefined-class :after
+ ((m module) added deleted plist &key)
+ (declare (ignorable deleted plist))
+ (when (or *asdf-verbose* *load-verbose*)
+ (asdf-message "~&~@<; ~@; Updating ~A for ASDF ~A~@:>~%" m ,(asdf-version)))
+ (when (member 'components-by-name added)
+ (compute-module-components-by-name m))
+ (when (and (typep m 'system) (member 'source-file added))
+ (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) m))))))
+
+;;;; -------------------------------------------------------------------------
;;;; Classes, Conditions
(define-condition system-definition-error (error) ()
@@ -1000,7 +1010,7 @@
(format s "~@<component ~S not found~@[ in ~A~]~@:>"
(missing-requires c)
(when (missing-parent c)
- (component-name (missing-parent c)))))
+ (coerce-name (missing-parent c)))))
(defmethod print-object ((c missing-component-of-version) s)
(format s "~@<component ~S does not match version ~A~@[ in ~A~]~@:>"
@@ -1295,7 +1305,7 @@
:condition condition))))
(let ((*package* package))
(asdf-message
- "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
+ "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%"
on-disk *package*)
(load on-disk)))
(delete-package package))))
@@ -1309,19 +1319,22 @@
(error 'missing-component :requires name)))))))
(defun* register-system (name system)
- (asdf-message "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
+ (asdf-message "~&~@<; ~@;Registering ~A as ~A~@:>~%" system name)
(setf (gethash (coerce-name name) *defined-systems*)
(cons (get-universal-time) system)))
(defun* find-system-fallback (requested fallback &rest keys &key source-file &allow-other-keys)
(setf fallback (coerce-name fallback)
- source-file (or source-file *compile-file-truename* *load-truename*)
+ source-file (or source-file
+ (if *resolve-symlinks*
+ (or *compile-file-truename* *load-truename*)
+ (or *compile-file-pathname* *load-pathname*)))
requested (coerce-name requested))
(when (equal requested fallback)
(let* ((registered (cdr (gethash fallback *defined-systems*)))
(system (or registered
(apply 'make-instance 'system
- :name fallback :source-file source-file keys))))
+ :name fallback :source-file source-file keys))))
(unless registered
(register-system fallback system))
(throw 'find-system system))))
@@ -2201,9 +2214,9 @@
(defun* class-for-type (parent type)
(or (loop :for symbol :in (list
- (unless (keywordp type) type)
- (find-symbol (symbol-name type) *package*)
- (find-symbol (symbol-name type) :asdf))
+ type
+ (find-symbol* type *package*)
+ (find-symbol* type :asdf))
:for class = (and symbol (find-class symbol nil))
:when (and class (subtypep class 'component))
:return class)
@@ -2390,8 +2403,8 @@
#+mswindows "sh" #-mswindows "/bin/sh" command)
:input nil :whole nil
#+mswindows :show-window #+mswindows :hide)
- (format *verbose-out* "~{~&; ~a~%~}~%" stderr)
- (format *verbose-out* "~{~&; ~a~%~}~%" stdout)
+ (asdf-message "~{~&; ~a~%~}~%" stderr)
+ (asdf-message "~{~&; ~a~%~}~%" stdout)
exit-code)
#+clisp ;XXX not exactly *verbose-out*, I know
@@ -3121,6 +3134,18 @@
;;;; -----------------------------------------------------------------
;;;; Compatibility mode for ASDF-Binary-Locations
+(defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
+ (declare (ignorable operation-class system args))
+ (when (find-symbol* '#:output-files-for-system-and-operation :asdf)
+ (error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using.
+ASDF 2 now achieves the same purpose with its builtin ASDF-OUTPUT-TRANSLATIONS,
+which should be easier to configure. Please stop using ASDF-BINARY-LOCATIONS,
+and instead use ASDF-OUTPUT-TRANSLATIONS. See the ASDF manual for details.
+In case you insist on preserving your previous A-B-L configuration, but
+do not know how to achieve the same effect with A-O-T, you may use function
+ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual;
+call that function where you would otherwise have loaded and configured A-B-L.")))
+
(defun* enable-asdf-binary-locations-compatibility
(&key
(centralize-lisp-binaries nil)
@@ -3548,7 +3573,7 @@
(clear-output-translations))
;;;; -----------------------------------------------------------------
-;;;; Hook into REQUIRE for ABCL, ClozureCL, CMUCL, ECL and SBCL
+;;;; Hook into REQUIRE for ABCL, CLISP, ClozureCL, CMUCL, ECL and SBCL
;;;;
(defun* module-provide-asdf (name)
(handler-bind
@@ -3564,7 +3589,7 @@
t))))
#+(or abcl clisp clozure cmu ecl sbcl)
-(let ((x (and #+clisp (find-symbol "*MODULE-PROVIDER-FUNCTIONS*" :custom))))
+(let ((x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom))))
(when x
(eval `(pushnew 'module-provide-asdf
#+abcl sys::*module-provider-functions*
[View Less]
Date: Monday, December 6, 2010 @ 20:25:14
Author: rtoy
Path: /project/cmucl/cvsroot/cmucl-www/cmucl-www/www
Modified: download.html index.html news/index.html
Update for 2010-12 snapshot release.
-----------------+
download.html | 78 +++++++++++++++++++++++++++++++++++++++++++++++++-----
index.html | 51 +++++++++++++++++++----------------
news/index.html | 27 ++++++++++++++++++
3 files changed, 127 insertions(+), 29 deletions(-)
Index: cmucl-www/cmucl-www/www/…
[View More]download.html
diff -u cmucl-www/cmucl-www/www/download.html:1.26 cmucl-www/cmucl-www/www/download.html:1.27
--- cmucl-www/cmucl-www/www/download.html:1.26 Mon Nov 1 13:09:21 2010
+++ cmucl-www/cmucl-www/www/download.html Mon Dec 6 20:25:14 2010
@@ -92,6 +92,69 @@
</tr>
<tr>
+ <th>2010-12</th>
+ <td>
+ <ul>
+ <li><a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode</a></li>
+ <li><a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode extras</a></li>
+ <li><a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode</a></li>
+ <li><a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode extras</a></li>
+ </ul>
+ </td>
+ <td>
+ <ul>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode extras</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode extras</a></li>
+ </ul>
+ </td>
+ <td>
+ </p>
+<!--FreeBSD
+ Not available
+-->
+ </td>
+ <td>
+<!--Solaris 10 -->
+ <ul>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode extras</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode extras</a></li>
+ </ul>
+ </td>
+ <td>
+ <p></p>
+<!--Not yet available
+ <ul>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode extras</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode extras</a></li>
+ </ul>
+-->
+ </td>
+ <td>
+ <p/>
+<!--Not yet available
+ <ul>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Unicode extras</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-2010…">Non-Unicode extras</a></li>
+ </ul>
+-->
+ </td>
+ <td>
+ <ul>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/cmucl-src-…">Source code</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/12/release-20…">Release notes for 20c</a></li>
+ </ul>
+ </td>
+ </tr>
+
+ <tr>
<th>2010-11</th>
<td>
<ul>
@@ -150,7 +213,7 @@
<td>
<ul>
<li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/11/cmucl-src-…">Source code</a></li>
- <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/11/release-20…">Release notes for 20b</a></li>
+ <li> <a href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/11/release-20…">Release notes for 20c</a></li>
</ul>
</td>
</tr>
@@ -174,11 +237,14 @@
</ul>
</td>
<td>
- <p></p>
-<!--FreeBSD not yet available
- <ul>
- </ul>
--->
+ <dl>
+ <dt>8.1-stable
+ <dd> <a
+ href="http://common-lisp.net/project/cmucl/downloads/release/20b/cmucl-20b-x86-fr…">Unicode</a></dd>
+ <dd> <a href="http://common-lisp.net/project/cmucl/downloads/release/20b/cmucl-20b-x86-fr…">Unicode extras</a></dd>
+ <dd> <a href="http://common-lisp.net/project/cmucl/downloads/release/20b/cmucl-20b-non-un…">Non-Unicode</a></dd>
+ <dd> <a href="http://common-lisp.net/project/cmucl/downloads/release/20b/cmucl-20b-non-un…">Non-Unicode extras</a></dd>
+ </dl>
</td>
<td>
<!--Solaris 10 -->
Index: cmucl-www/cmucl-www/www/index.html
diff -u cmucl-www/cmucl-www/www/index.html:1.18 cmucl-www/cmucl-www/www/index.html:1.19
--- cmucl-www/cmucl-www/www/index.html:1.18 Mon Nov 1 09:54:10 2010
+++ cmucl-www/cmucl-www/www/index.html Mon Dec 6 20:25:14 2010
@@ -68,6 +68,34 @@
Also see <a href="news/index.html">News</a> for older news.
<dl>
+<dt><strong>Snapshot 2010-12</strong>
+<dd>
+ The 2010-11 snapshot has been released. See the release notes for
+ details, but here is a quick summary of the changes between the
+ this snapshot and the 2010-11 snapshot.
+ <ul>
+ <li> ASDF2 updated to version 2.010.</li>
+ <li> On x86, <code>REALPART</code> and <code>IMAGPART</code> no longer incorrectly returns 0
+ instead of the correct part of a complex number in some
+ situations.</li>
+ <li> The command line parser now correctly handles the case where
+ "--" is the first command option.</li>
+ <li> <code>build.sh</code> was accidenally loading the site-init file, but it
+ shouldn't. </li>
+ <li> On sparc, the vops to add a float to a complex were broken,
+ resulting in a complex number with the float as realpart and
+ garbage for the imaginary part. This is now fixed.</li>
+ <li> <code>XLIB::GET-BEST-AUTHORIZATION</code> will now return authorization data
+ if the protocol is :local, if the xauth file contains just
+ "localhost/unix:0". Previously, no authorization data was
+ returned because <code>GET-BEST-AUTHORIZATION</code> was looking for the
+ hostname.</li>
+ <li> <code>FORMAT</code> signals an warning if <code>~:;</code> is used inside <code>~:[.</code></li>
+ <li> <code>SET-SYSTEM-EXTERNAL-FORMAT</code> was not actually setting the filename
+ encoding if given.</li>
+ </ul>
+</dd>
+
<dt><strong>20b patch 000</strong>
<dd>
A critical bug in <code>REALPART</code> and <code>IMAGPART</code> has
@@ -75,29 +103,6 @@
this issue in the 20b release. <a href="install.html">Installation</a>
instructions are available.
</dd>
-<dt><strong>Snapshot 2010-11</strong>
-<dd>
- The 2010-11 snapshot has been released. See the release notes for
- details, but here is a quick summary of the changes between the
- snapshot and the 20b release:
- <ul>
- <li> Update to Unicode 5.2.0.</li>
- <li> Support for character name completion for use with Slime.</li>
- <li> <code>COMPILE-FILE</code> accepts a
- <code>:DECODING-ERROR</code> argument that indicates how to handle
- decoding errors when reading the file.</li>
- <li> <code>RUN-PROGRAM</code> accepts <code>:EXTERNAL-FORMAT</code>
- parameter to specify the external format for streams that are
- created.</li>
- <li> <code>READ-CHAR</code> signals errors on non-character
- streams. <code>READ-BYTE</code> signals errors on character
- streams. This is a change from previous versions. However, both
- will work if the stream is a <code>binary-text-stream</code>.</li>
- <li> <code>REALPART</code> and <code>IMAGPARG</code> no longer
- returns 0 instead of the correct part of a complex number in some
- situations. </li>
- </ul>
-</dd>
<dt><strong>CMUCL 20b released</strong></dt>
<dd>
CMUCL 20b has been released, For information on the changes between
Index: cmucl-www/cmucl-www/www/news/index.html
diff -u cmucl-www/cmucl-www/www/news/index.html:1.43 cmucl-www/cmucl-www/www/news/index.html:1.44
--- cmucl-www/cmucl-www/www/news/index.html:1.43 Mon Nov 1 10:05:40 2010
+++ cmucl-www/cmucl-www/www/news/index.html Mon Dec 6 20:25:14 2010
@@ -11,6 +11,33 @@
<p>
<dl>
+<dt>2010-12 snapshot
+<dd>
+Some of the important changes are listed below. See the <a
+href="http://common-lisp.net/project/cmucl/downloads/snapshots/2010/11/release-20…">release
+notes</a> for more details.
+ <ul>
+ <li> ASDF2 updated to version 2.010.</li>
+ <li> On x86, <code>REALPART</code> and <code>IMAGPART</code> no longer incorrectly returns 0
+ instead of the correct part of a complex number in some
+ situations.</li>
+ <li> The command line parser now correctly handles the case where
+ "--" is the first command option.</li>
+ <li> <code>build.sh</code> was accidenally loading the site-init file, but it
+ shouldn't. </li>
+ <li> On sparc, the vops to add a float to a complex were broken,
+ resulting in a complex number with the float as realpart and
+ garbage for the imaginary part. This is now fixed.</li>
+ <li> <code>XLIB::GET-BEST-AUTHORIZATION</code> will now return authorization data
+ if the protocol is :local, if the xauth file contains just
+ "localhost/unix:0". Previously, no authorization data was
+ returned because <code>GET-BEST-AUTHORIZATION</code> was looking for the
+ hostname.</li>
+ <li> <code>FORMAT</code> signals an warning if <code>~:;</code> is used inside <code>~:[.</code></li>
+ <li> <code>SET-SYSTEM-EXTERNAL-FORMAT</code> was not actually setting the filename
+ encoding if given.</li>
+ </ul>
+</dd>
<dt><strong>20b patch 000</strong>
<dd>
A critical bug in <code>REALPART</code> and <code>IMAGPART</code> has
[View Less]
Date: Sunday, December 5, 2010 @ 09:28:49
Author: rtoy
Path: /project/cmucl/cvsroot/src/tools/cross-scripts
Modified: cross-x86-sparc.lisp
Minor change to allow the script to work for cross-compiling
non-unicode sparc from x86 OSX.
----------------------+
cross-x86-sparc.lisp | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
Index: src/tools/cross-scripts/cross-x86-sparc.lisp
diff -u src/tools/cross-scripts/cross-x86-sparc.lisp:1.2 src/tools/cross-scripts/cross-x86-sparc.…
[View More]lisp:1.3
--- src/tools/cross-scripts/cross-x86-sparc.lisp:1.2 Sat Dec 4 12:32:35 2010
+++ src/tools/cross-scripts/cross-x86-sparc.lisp Sun Dec 5 09:28:49 2010
@@ -65,6 +65,7 @@
;; big-endian order for sparc. When we read in a string, we need to
;; convert the big-endian string to little-endian for x86 so we can
;; process the symbols and such as expected.
+#+unicode
(progn
(defun maybe-swap-string (f name &optional (len (length name)))
(declare (ignorable f))
@@ -90,7 +91,7 @@
(when (> ,n-size *load-symbol-buffer-size*)
(setq *load-symbol-buffer*
(make-string (setq *load-symbol-buffer-size*
- (* ,n-size 2)))))
+ (* ,n-size vm:char-bytes)))))
(done-with-fast-read-byte)
(let ((,n-buffer *load-symbol-buffer*))
(read-n-bytes *fasl-file* ,n-buffer 0
[View Less]
Date: Thursday, December 2, 2010 @ 09:26:46
Author: rtoy
Path: /project/cmucl/cvsroot/src/general-info
Modified: release-20c.txt
Update from logs.
-----------------+
release-20c.txt | 1 +
1 file changed, 1 insertion(+)
Index: src/general-info/release-20c.txt
diff -u src/general-info/release-20c.txt:1.12 src/general-info/release-20c.txt:1.13
--- src/general-info/release-20c.txt:1.12 Tue Nov 30 08:51:29 2010
+++ src/general-info/release-20c.txt Thu Dec 2 09:26:45 2010
@@ -26,6 +…
[View More]26,7 @@
Slime to do character name completion.
* Changes
+ - ASDF2 updated to version 2.010.
- COMPILE-FILE now accepts a :DECODING-ERROR argument that
indicates how to handle decoding errors when reading the file.
It has the same meaning and effect as the :DECODING-ERROR
[View Less]