[cmucl-commit] [git] CMU Common Lisp branch master updated. 20d-8-gae86266

Raymond Toy rtoy at common-lisp.net
Sun Nov 18 22:33:02 UTC 2012


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  ae862666db52263be094586fb68e61364ea5b359 (commit)
       via  09afca189e07f3355b4486a29d0b4142b240e0c8 (commit)
       via  8a26586362de29ffb376b146d16a4da312ee8a34 (commit)
       via  4911f79a89763f609dce82fd112bbd728d44d464 (commit)
       via  efd259685b7525a8ffc9d33c2ea4b9e358359a37 (commit)
       via  a48f47b65118a12f9c40b899d8b20ee93da55a83 (commit)
       via  6633ddde3093d1146a160e48dd40a2fbf7e74bf9 (commit)
       via  b55fd57bd8260f7f6277d579a0775711d916c3cf (commit)
      from  02fc6d02d6973e4061729bf9308beca23baaff2a (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 ae862666db52263be094586fb68e61364ea5b359
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sun Nov 18 14:31:48 2012 -0800

    Revert changes to unicode-complete; can't complete #\Hangul_syllable_
    but the old version could.  This unfixes Trac #52.

diff --git a/src/code/unidata.lisp b/src/code/unidata.lisp
index 981e2a7..45e8804 100644
--- a/src/code/unidata.lisp
+++ b/src/code/unidata.lisp
@@ -1231,65 +1231,98 @@
   Three values are returned: (1) The best match of prefix, (2) a list
   of possible completions, (3) a boolean indicating whether the best
   match is a complete unicode name. "
+
   (unless dict
-    (load-names)
+    ;; Load the names dictionary, if needed.
+    (unless (unidata-name+ *unicode-data*)
+      (load-names))
     (setf dict (unidata-name+ *unicode-data*)))
-  (let* ((prefix (nsubstitute #\Space #\_ (string-upcase prefix)))
-	 (result nil))
-    (labels ((keybase (node)
-	       (ash (aref (dictionary-nextv dict) node) -18))
-	     (keylen (base)
-	       (aref (dictionary-keyl dict) base))
-	     (keystr (base offset)
-	       (aref (dictionary-cdbk dict)
-		     (aref (dictionary-keyv dict) (+ base offset))))
-	     (next (node keypos)
-	       (+ (logand (aref (dictionary-nextv dict) node) #x3FFFF)
-		  keypos))
-	     (completep (node)
-	       (> (aref (dictionary-codev dict) node) -1))
-	     (match (part prefix posn)
-	       (let ((s1 (search part prefix :start2 posn))
-		     (s2 (search prefix part :start1 posn)))
-		 (or (and s1 (= s1 posn))
-		     (and s2 (zerop s2)))))
-	     (rec (node posn)
-	       (let ((keyv (keybase node)))
-		 (dotimes (i (keylen keyv))
-		   (let* ((str (keystr keyv i)) (len (length str)))
-		     (when (match str prefix posn)
-		       (cond ((<= (+ len posn) (length prefix))
-			      (rec (next node i) (+ posn len)))
-			     (t
-			      (push (fillout (concatenate 'string (subseq prefix 0 posn)
-							  str)
-					     (next node i))
-				    result))))))))
-	     (fillout (string node)
-	       (let ((keyv (keybase node)))
-		 (if (and (= (keylen keyv) 1) (not (completep node)))
-		     (fillout (concatenate 'string string (keystr keyv 0))
-			      (next node 0))
-		     string)))
-	     (mip (strings)
-	       (let* ((first (first strings))
-		      (posn (length first)))
-		 (dolist (string (rest strings))
-		   (let ((n (mismatch first string :end1 posn)))
-		     (when n (setq posn n))))
-		 (subseq first 0 posn)))
-	     (str (x) (nsubstitute #\_ #\Space (string-capitalize x))))
-      (rec 0 0)
-      (unless (cdr result)
-	(setq prefix (car result))
-	(rec 0 0))
-      (let* ((base (mip result))
-	     (node (search-dictionary base dict)))
-	(values (str base)
-		(sort (mapcar (lambda (x) (subseq (str x) (length base)))
-			      (delete base result :test #'string=))
-		      #'string<)
-		(and node (completep node)))))))
+  (let ((prefix (nsubstitute #\Space #\_ (string-upcase prefix)))
+	completep)
+    (multiple-value-bind (n p)
+	(search-dictionary prefix dict)
+      (when n
+	(setq completep (> (aref (dictionary-codev dict) n) -1)))
+      #+(or debug-uc)
+      (progn
+	(format t "n,p,complete = ~S ~S ~S~%" n p completep)
+	(when n (format t "match = ~S~%" (subseq prefix 0 p))))
+      (cond ((not p)
+	     (values (%str prefix) nil nil))
+	    ((= p (length prefix))
+	     ;; The prefix is an exact match to something in the code
+	     ;; book.  Try to find possible completions of this
+	     ;; prefix.
+	     (let ((x (node-next n dict))
+		   (suffix ""))
+	       #+(or debug-uc)
+	       (format t "init x = ~S~%" x)
+	       (when (= (length x) 1)
+		 ;; There was only one possible extension.  Try to
+		 ;; extend from there.
+		 #+(or debug-uc)
+		 (format t "extending~%")
+		 (setq suffix (caar x)
+		       n (cdar x)
+		       x (node-next (cdar x) dict)))
+	       #+(or debug-uc)
+	       (progn
+		 (format t "x = ~S~%" x)
+		 (format t "suffix = ~S~%" suffix))
+	       (when (<= (length x) 1)
+		 (setq prefix (concatenate 'string prefix suffix))
+		 (setf suffix ""))
+	       (values (%str prefix)
+		       (sort (mapcar #'(lambda (e)
+					 (%str (concatenate 'string suffix (car e))))
+				     x)
+			     #'string<)
+		       (or (> (aref (dictionary-codev dict) n) -1)
+			   completep))))
+	    (t
+	     ;; The prefix was not an exact match of some entry in the
+	     ;; codebook. Try to find some completions from there.
+	     (let* ((nodex (node-next n dict))
+		    (x (remove-if-not (lambda (x)
+					(%match (car x) prefix p))
+				      nodex)))
+	       #+(or debug-uc)
+	       (progn
+		 (format t "nodex = ~S~%" nodex)
+		 (format t "x = ~S~%" x))
+	       (setq prefix (subseq prefix 0 p))
+	       (cond ((= (length x) 1)
+		      ;; Only one possible completion.  Try to extend
+		      ;; the completions from there.
+		      (setq prefix (concatenate 'string prefix (caar x))
+			    n (cdar x)
+			    x (node-next (cdar x) dict))
+		      (values (%str prefix)
+			      (sort (mapcar #'%strx x) #'string<)
+			      (> (aref (dictionary-codev dict) n) -1)))
+		     (t
+		      ;; There's more than one possible completion.
+		      ;; Try to extend each of those completions one
+		      ;; more step, but we still want to keep the
+		      ;; original completions.
+		      (let* ((p (append (mapcar #'car x)
+					(mapcan #'(lambda (ex)
+						    (let ((next (node-next (cdr ex) dict)))
+						      (if next
+							  (mapcar #'(lambda (n)
+								      (concatenate 'string (car ex) (car n)))
+								  (node-next (cdr ex) dict))
+							  (list (car ex)))))
+						x)))
+			     (q (%mip p)))
+			(setq prefix (concatenate 'string prefix q))
+			
+			(do ((tmp p (cdr tmp)))
+			    ((endp tmp))
+			  (setf (car tmp) (subseq (car tmp) (length q))))
+			(values (%str prefix)
+				(sort (mapcar #'%str p) #'string<)
+				nil))))))))))
 
 ;; Like unicode-complete-name, but we also try to handle the names
 ;; that can be computed algorithmically like the Hangul syllables and
@@ -1306,9 +1339,6 @@
 	 do (push (concatenate 'string prefix-match x) names))
       (when completep
 	(push prefix-match names))
-      (when (zerop (length prefix-match))
-	;; The prefix isn't a prefix for anything, so return nil
-	(return-from unicode-complete nil))
       (flet ((han-or-cjk-completion (prefix-match prefix dictionary)
 	       (let* ((prefix-tail (subseq prefix-match
 					   (min (length prefix)

commit 09afca189e07f3355b4486a29d0b4142b240e0c8
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sun Nov 18 14:27:50 2012 -0800

    Deprecate the -8 option since we don't support 8-bit builds anymore.

diff --git a/bin/build-all.sh b/bin/build-all.sh
index 4585f37..7cf7c88 100755
--- a/bin/build-all.sh
+++ b/bin/build-all.sh
@@ -29,7 +29,7 @@ usage ()
     echo '    -v v      Use the given string as the version.'
     echo "    -o x      Use specified Lisp to build unicode version."
     echo "               (only applicable for build 1)"
-    echo "    -8 x      Use specified Lisp to build 8-bit version."
+    echo "    -8 x      DEPRECATED: Use specified Lisp to build 8-bit version."
     echo "               (only applicable for build 1)"
     echo "    -U        Update and overwite the translations files."
     echo "    -P        On the last build, (re)generate cmucl.pot and the"
@@ -47,7 +47,8 @@ do
       B) bootfiles="$bootfiles -B $OPTARG" ;;
       C) CREATE_OPT="$OPTARG" ;;
       o) OLDLISP="$OPTARG" ;;
-      8) OLD8="$OPTARG" ;;
+      8) OLD8="$OPTARG" 
+	  echo "WARNING: -8 is deprecated";;
       v) VERSION="$OPTARG"; VERSION_SET=true ;;
       U) UPDATE_TRANS="-U" ;;
       P) UPDATE_POT="" ;;

commit 8a26586362de29ffb376b146d16a4da312ee8a34
Merge: 4911f79 02fc6d0
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sun Nov 18 09:19:07 2012 -0800

    Merge branch 'master' of ssh://common-lisp.net/var/git/projects/cmucl/cmucl


commit 4911f79a89763f609dce82fd112bbd728d44d464
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Nov 17 14:37:12 2012 -0800

    o Update to asdf 2.26
    o Add release-20e.txt.

diff --git a/src/contrib/asdf/asdf.lisp b/src/contrib/asdf/asdf.lisp
index 13061c3..283ad86 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 ; coding: utf-8 -*-
-;;; This is ASDF 2.25: Another System Definition Facility.
+;;; This is ASDF 2.26: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel at common-lisp.net>.
@@ -118,7 +118,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.25")
+         (asdf-version "2.26")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -230,7 +230,6 @@
                    :redefined-functions ',redefined-functions)))
           (pkgdcl
            :asdf
-           :nicknames (:asdf-utilities) ;; DEPRECATED! Do not use, for backward compatibility only.
            :use (:common-lisp)
            :redefined-functions
            (#:perform #:explain #:output-files #:operation-done-p
@@ -3350,6 +3349,15 @@ located."
 (defun* getenv-absolute-directories (x)
   (getenv-pathnames x :want-absolute t :want-directory t))
 
+(defun* get-folder-path (folder)
+  (or ;; this semi-portably implements a subset of the functionality of lispworks' sys:get-folder-path
+   #+(and lispworks mswindows) (sys:get-folder-path folder)
+   ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
+   (ecase folder
+    (:local-appdata (getenv-absolute-directory "LOCALAPPDATA"))
+    (:appdata (getenv-absolute-directory "APPDATA"))
+    (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA")
+			 (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))))))
 
 (defun* user-configuration-directories ()
   (let ((dirs
@@ -3359,15 +3367,8 @@ located."
                 (loop :for dir :in (getenv-absolute-directories "XDG_CONFIG_DIRS")
                   :collect (subpathname* dir "common-lisp/"))))
            ,@(when (os-windows-p)
-               `(,(subpathname* (or #+(and lispworks (not lispworks-personal-edition))
-                                    (sys:get-folder-path :local-appdata)
-                                    (getenv-absolute-directory "LOCALAPPDATA"))
-                               "common-lisp/config/")
-                 ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
-                 ,(subpathname* (or #+(and lispworks (not lispworks-personal-edition))
-                                    (sys:get-folder-path :appdata)
-                                    (getenv-absolute-directory "APPDATA"))
-                                "common-lisp/config/")))
+               `(,(subpathname* (get-folder-path :local-appdata) "common-lisp/config/")
+                 ,(subpathname* (get-folder-path :appdata) "common-lisp/config/")))
            ,(subpathname (user-homedir) ".config/common-lisp/"))))
     (remove-duplicates (remove-if-not #'absolute-pathname-p dirs)
                        :from-end t :test 'equal)))
@@ -3378,11 +3379,7 @@ located."
     ((os-windows-p)
      (aif
       ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData
-      (subpathname* (or #+(and lispworks (not lispworks-personal-edition))
-                        (sys:get-folder-path :common-appdata)
-                        (getenv-absolute-directory "ALLUSERSAPPDATA")
-                        (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))
-                    "common-lisp/config/")
+      (subpathname* (get-folder-path :common-appdata) "common-lisp/config/")
       (list it)))))
 
 (defun* in-first-directory (dirs x &key (direction :input))
@@ -3507,12 +3504,8 @@ and the order is by decreasing length of namestring of the source pathname.")
     (or
      (try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation)
      (when (os-windows-p)
-       (try (or #+(and lispworks (not lispworks-personal-edition))
-                (sys:get-folder-path :local-appdata)
-                (getenv-absolute-directory "LOCALAPPDATA")
-                #+(and lispworks (not lispworks-personal-edition))
-                (sys:get-folder-path :appdata)
-                (getenv-absolute-directory "APPDATA"))
+       (try (or (get-folder-path :local-appdata)
+                (get-folder-path :appdata))
             "common-lisp" "cache" :implementation))
      '(:home ".cache" "common-lisp" :implementation))))
 
@@ -3917,11 +3910,12 @@ effectively disabling the output translation facility."
   (if (absolute-pathname-p output-file)
       ;; what cfp should be doing, w/ mp* instead of mp
       (let* ((type (pathname-type (apply 'compile-file-pathname "x.lisp" keys)))
-             (defaults (make-pathname
-                        :type type :defaults (merge-pathnames* input-file))))
-        (merge-pathnames* output-file defaults))
+	     (defaults (make-pathname
+			:type type :defaults (merge-pathnames* input-file))))
+	(merge-pathnames* output-file defaults))
       (apply-output-translations
-       (apply 'compile-file-pathname input-file keys))))
+       (apply 'compile-file-pathname input-file
+	      (if output-file keys (remove-keyword :output-file keys))))))
 
 (defun* tmpize-pathname (x)
   (make-pathname
@@ -4234,6 +4228,7 @@ with a different configuration, so the configuration would be re-read then."
 
 (defun* wrapping-source-registry ()
   `(:source-registry
+    #+ecl (:tree ,(translate-logical-pathname "SYS:"))
     #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
     #+sbcl (:tree ,(truenamize (getenv-pathname "SBCL_HOME" :want-directory t)))
     :inherit-configuration
@@ -4250,16 +4245,7 @@ with a different configuration, so the configuration would be re-read then."
                 ,@(or (getenv-absolute-directories "XDG_DATA_DIRS")
                       '("/usr/local/share" "/usr/share"))))
           ,@(when (os-windows-p)
-              `(,(or #+(and lispworks (not lispworks-personal-edition))
-                     (sys:get-folder-path :local-appdata)
-                     (getenv-absolute-directory "LOCALAPPDATA"))
-                ,(or #+(and lispworks (not lispworks-personal-edition))
-                     (sys:get-folder-path :appdata)
-                     (getenv-absolute-directory "APPDATA"))
-                ,(or #+(and lispworks (not lispworks-personal-edition))
-                     (sys:get-folder-path :common-appdata)
-                     (getenv-absolute-directory "ALLUSERSAPPDATA")
-                     (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/")))))
+              (mapcar 'get-folder-path '(:local-appdata :appdata :common-appdata))))
         :collect `(:directory ,(subpathname* dir "common-lisp/systems/"))
         :collect `(:tree ,(subpathname* dir "common-lisp/source/")))
     :inherit-configuration))
diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt
new file mode 100644
index 0000000..52eee31
--- /dev/null
+++ b/src/general-info/release-20e.txt
@@ -0,0 +1,48 @@
+========================== C M U C L  20 e =============================
+
+[In Progress]
+
+The CMUCL project is pleased to announce the release of CMUCL 20e.
+This is a major release which contains numerous enhancements and
+bug fixes from the 20c release.
+
+CMUCL is a free, high performance implementation of the Common Lisp
+programming language which runs on most major Unix platforms. It
+mainly conforms to the ANSI Common Lisp standard. CMUCL provides a
+sophisticated native code compiler; a powerful foreign function
+interface; an implementation of CLOS, the Common Lisp Object System,
+which includes multi-methods and a meta-object protocol; a source-level
+debugger and code profiler; and an Emacs-like editor implemented in
+Common Lisp. CMUCL is maintained by a team of volunteers collaborating
+over the Internet, and is mostly in the public domain.
+
+New in this release:
+
+  * Known issues:
+
+  * Feature enhancements
+ 
+  * Changes
+    * ASDF2 updated to version 2.26.
+
+  * ANSI compliance fixes:
+
+  * Bugfixes:
+
+  * Trac Tickets:
+
+  * Other changes:
+
+  * Improvements to the PCL implementation of CLOS:
+
+  * Changes to building procedure:
+
+This release is not binary compatible with code compiled using CMUCL
+20d; you will need to recompile FASL files. 
+
+See <URL:http://www.cmucl.org> or
+<URL:http://trac.common-lisp.net/cmucl> for download information,
+guidelines on reporting bugs, and mailing list details.
+
+
+We hope you enjoy using this release of CMUCL!

commit efd259685b7525a8ffc9d33c2ea4b9e358359a37
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Wed Oct 10 22:36:53 2012 -0700

    Update asdf to version 2.25.

diff --git a/src/contrib/asdf/asdf.lisp b/src/contrib/asdf/asdf.lisp
index a97632d..13061c3 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 ; coding: utf-8 -*-
-;;; This is ASDF 2.24: Another System Definition Facility.
+;;; This is ASDF 2.25: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel at common-lisp.net>.
@@ -118,7 +118,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.24")
+         (asdf-version "2.25")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -364,9 +364,10 @@
             #:user-source-registry-directory
             #:system-source-registry-directory
 
-            ;; Utilities
+            ;; Utilities: please use asdf-utils instead
+            #|
             ;; #:aif #:it
-            #:appendf #:orf
+            ;; #:appendf #:orf
             #:length=n-p
             #:remove-keys #:remove-keyword
             #:first-char #:last-char #:string-suffix-p
@@ -389,7 +390,7 @@
             #:while-collecting
             #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors*
             #:*wild-path* #:wilden
-            #:directorize-pathname-host-device
+            #:directorize-pathname-host-device|#
             )))
         #+genera (import 'scl:boolean :asdf)
         (setf *asdf-version* asdf-version
@@ -462,6 +463,7 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.")
 (progn
   (deftype logical-pathname () nil)
   (defun make-broadcast-stream () *error-output*)
+  (defun translate-logical-pathname (x) x)
   (defun file-namestring (p)
     (setf p (pathname p))
     (format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p))))
@@ -3321,8 +3323,9 @@ located."
 (defun* user-homedir ()
   (truenamize
    (pathname-directory-pathname
+    #+cormanlisp (ensure-directory-pathname (user-homedir-pathname))
     #+mcl (current-user-homedir-pathname)
-    #-mcl (user-homedir-pathname))))
+    #-(or cormanlisp mcl) (user-homedir-pathname))))
 
 (defun* ensure-pathname* (x want-absolute want-directory fmt &rest args)
   (when (plusp (length x))
@@ -3356,11 +3359,13 @@ located."
                 (loop :for dir :in (getenv-absolute-directories "XDG_CONFIG_DIRS")
                   :collect (subpathname* dir "common-lisp/"))))
            ,@(when (os-windows-p)
-               `(,(subpathname* (or #+lispworks (sys:get-folder-path :local-appdata)
+               `(,(subpathname* (or #+(and lispworks (not lispworks-personal-edition))
+                                    (sys:get-folder-path :local-appdata)
                                     (getenv-absolute-directory "LOCALAPPDATA"))
                                "common-lisp/config/")
                  ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
-                 ,(subpathname* (or #+lispworks (sys:get-folder-path :appdata)
+                 ,(subpathname* (or #+(and lispworks (not lispworks-personal-edition))
+                                    (sys:get-folder-path :appdata)
                                     (getenv-absolute-directory "APPDATA"))
                                 "common-lisp/config/")))
            ,(subpathname (user-homedir) ".config/common-lisp/"))))
@@ -3373,7 +3378,8 @@ located."
     ((os-windows-p)
      (aif
       ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData
-      (subpathname* (or #+lispworks (sys:get-folder-path :common-appdata)
+      (subpathname* (or #+(and lispworks (not lispworks-personal-edition))
+                        (sys:get-folder-path :common-appdata)
                         (getenv-absolute-directory "ALLUSERSAPPDATA")
                         (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))
                     "common-lisp/config/")
@@ -3501,9 +3507,11 @@ and the order is by decreasing length of namestring of the source pathname.")
     (or
      (try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation)
      (when (os-windows-p)
-       (try (or #+lispworks (sys:get-folder-path :local-appdata)
+       (try (or #+(and lispworks (not lispworks-personal-edition))
+                (sys:get-folder-path :local-appdata)
                 (getenv-absolute-directory "LOCALAPPDATA")
-                #+lispworks (sys:get-folder-path :appdata)
+                #+(and lispworks (not lispworks-personal-edition))
+                (sys:get-folder-path :appdata)
                 (getenv-absolute-directory "APPDATA"))
             "common-lisp" "cache" :implementation))
      '(:home ".cache" "common-lisp" :implementation))))
@@ -4242,11 +4250,14 @@ with a different configuration, so the configuration would be re-read then."
                 ,@(or (getenv-absolute-directories "XDG_DATA_DIRS")
                       '("/usr/local/share" "/usr/share"))))
           ,@(when (os-windows-p)
-              `(,(or #+lispworks (sys:get-folder-path :local-appdata)
+              `(,(or #+(and lispworks (not lispworks-personal-edition))
+                     (sys:get-folder-path :local-appdata)
                      (getenv-absolute-directory "LOCALAPPDATA"))
-                ,(or #+lispworks (sys:get-folder-path :appdata)
+                ,(or #+(and lispworks (not lispworks-personal-edition))
+                     (sys:get-folder-path :appdata)
                      (getenv-absolute-directory "APPDATA"))
-                ,(or #+lispworks (sys:get-folder-path :common-appdata)
+                ,(or #+(and lispworks (not lispworks-personal-edition))
+                     (sys:get-folder-path :common-appdata)
                      (getenv-absolute-directory "ALLUSERSAPPDATA")
                      (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/")))))
         :collect `(:directory ,(subpathname* dir "common-lisp/systems/"))
diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt
index 6cfb978..591d0d8 100644
--- a/src/general-info/release-20d.txt
+++ b/src/general-info/release-20d.txt
@@ -28,7 +28,7 @@ New in this release:
     * Added external format for EUC-KR.
  
   * Changes
-    * ASDF2 updated to version 2.24.
+    * ASDF2 updated to version 2.25.
     * 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

commit a48f47b65118a12f9c40b899d8b20ee93da55a83
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Oct 27 09:06:18 2012 -0700

    Oops. expr should not have a "^" character in the regexp.  (Sparc
    complains about this.)

diff --git a/bin/load-world.sh b/bin/load-world.sh
index 1ca3779..8b8c2eb 100755
--- a/bin/load-world.sh
+++ b/bin/load-world.sh
@@ -16,11 +16,11 @@ GIT_HASH="`(cd src; git describe --dirty 2>/dev/null)`"
 
 # If the git hash looks like a snapshot tag or release, don't add the date.
 VERSION="`date '+%Y-%m-%d %H:%M:%S'`${GIT_HASH:+ $GIT_HASH}"
-if expr "X${GIT_HASH}" : '^Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then
+if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then
     VERSION="${GIT_HASH}"
 fi
 
-if expr "X${GIT_HASH}" : '^X[0-9][0-9][a-f]' > /dev/null; then
+if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then
     VERSION="${GIT_HASH}"
 fi
 echo $VERSION

commit 6633ddde3093d1146a160e48dd40a2fbf7e74bf9
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Oct 27 08:56:52 2012 -0700

    Check the git hash for a release tag too.

diff --git a/bin/load-world.sh b/bin/load-world.sh
index b2fcb2e..1ca3779 100755
--- a/bin/load-world.sh
+++ b/bin/load-world.sh
@@ -14,11 +14,14 @@ NO_PCL_FEATURE=
 # Default version is the date with the git hash.
 GIT_HASH="`(cd src; git describe --dirty 2>/dev/null)`"
 
-# If the git hash looks like a snapshot tag, don't add the date.
+# If the git hash looks like a snapshot tag or release, don't add the date.
+VERSION="`date '+%Y-%m-%d %H:%M:%S'`${GIT_HASH:+ $GIT_HASH}"
 if expr "X${GIT_HASH}" : '^Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then
     VERSION="${GIT_HASH}"
-else
-    VERSION="`date '+%Y-%m-%d %H:%M:%S'`${GIT_HASH:+ $GIT_HASH}"
+fi
+
+if expr "X${GIT_HASH}" : '^X[0-9][0-9][a-f]' > /dev/null; then
+    VERSION="${GIT_HASH}"
 fi
 echo $VERSION
 

commit b55fd57bd8260f7f6277d579a0775711d916c3cf
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Oct 27 08:42:26 2012 -0700

     * src/compiler/byte-comp.lisp
       * Bump fasl version for release
     * src/bootfiles/20c/boot-20d.lisp
       * Boot file for building the release with a new fasl version.

diff --git a/src/bootfiles/20c/boot-20d.lisp b/src/bootfiles/20c/boot-20d.lisp
new file mode 100644
index 0000000..21f86d1
--- /dev/null
+++ b/src/bootfiles/20c/boot-20d.lisp
@@ -0,0 +1,68 @@
+;;;;
+;;;; Boot file for changing the fasl file version numbers to 20d.
+;;;;
+
+(in-package :c)
+
+(setf lisp::*enable-package-locked-errors* nil)
+
+;;;
+;;; Note that BYTE-FASL-FILE-VERSION is a constant.
+;;;
+;;; (Be sure to change BYTE-FASL-FILE-VERSION in
+;;; compiler/byte-comp.lisp to the correct value too!)
+;;;
+#-cmu20d
+(setf (symbol-value 'byte-fasl-file-version)       #x20d)
+#-cmu20d
+(setf (backend-fasl-file-version *target-backend*) #x20d)
+
+;;;
+;;; Don't check fasl versions in the compiling Lisp because we'll
+;;; load files compiled with the new version numbers.
+;;;
+#-cmu20d
+(setq lisp::*skip-fasl-file-version-check* t)
+
+;;;
+;;; This is here because BYTE-FASL-FILE-VERSION is constant-folded in
+;;; OPEN-FASL-FILE.  To make the new version number take effect, we
+;;; have to redefine the function.
+;;;
+#-cmu20d
+(defun open-fasl-file (name where &optional byte-p)
+  (declare (type pathname name))
+  (let* ((stream (open name :direction :output
+			    :if-exists :new-version
+			    :element-type '(unsigned-byte 8)
+			    :class 'binary-text-stream))
+	 (res (make-fasl-file :stream stream)))
+    (multiple-value-bind
+	(version f-vers f-imp)
+	(if byte-p
+	    (values "Byte code"
+		    byte-fasl-file-version
+		    (backend-byte-fasl-file-implementation *backend*))
+	    (values (backend-version *backend*)
+		    (backend-fasl-file-version *backend*)
+		    (backend-fasl-file-implementation *backend*)))
+      (format stream
+	      "FASL FILE output from ~A.~@
+	       Compiled ~A on ~A~@
+	       Compiler ~A, Lisp ~A~@
+	       Targeted for ~A, FASL version ~X~%"
+	      where
+	      (ext:format-universal-time nil (get-universal-time))
+	      (machine-instance) compiler-version
+	      (lisp-implementation-version)
+	      version f-vers)
+      ;;
+      ;; Terminate header.
+      (dump-byte 255 res)
+      ;;
+      ;; Specify code format.
+      (dump-fop 'lisp::fop-long-code-format res)
+      (dump-byte f-imp res)
+      (dump-unsigned-32 f-vers res))
+    res))
+
diff --git a/src/compiler/byte-comp.lisp b/src/compiler/byte-comp.lisp
index ad16162..b89c70b 100644
--- a/src/compiler/byte-comp.lisp
+++ b/src/compiler/byte-comp.lisp
@@ -38,7 +38,7 @@
 ;; 0-9 followed by a single hex digit in the range a-f.  Then the
 ;; version looks like a decimal number followed by a minor release
 ;; letter of a to f.
-(defconstant byte-fasl-file-version #x20c)
+(defconstant byte-fasl-file-version #x20d)
 
 (let* ((version-string (format nil "~X" byte-fasl-file-version)))
   ;; Add :cmu<n> to *features*

-----------------------------------------------------------------------

Summary of changes:
 bin/build-all.sh                                   |    5 +-
 bin/load-world.sh                                  |   11 +-
 .../{20b/boot-20c.lisp => 20c/boot-20d.lisp}       |   14 +-
 src/code/unidata.lisp                              |  150 ++++++++++++--------
 src/compiler/byte-comp.lisp                        |    2 +-
 5 files changed, 108 insertions(+), 74 deletions(-)
 copy src/bootfiles/{20b/boot-20c.lisp => 20c/boot-20d.lisp} (89%)


hooks/post-receive
-- 
CMU Common Lisp


More information about the cmucl-commit mailing list