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

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-10-g3db9313
by Raymond Toy 18 Jul '12

18 Jul '12

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 3db9313fc2da525dcc3923dd7ec20f015e9a5f79 (commit) from 6180b3963ea5a38ef9f2f82bc53995e6dba349c1 (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 3db9313fc2da525dcc3923dd7ec20f015e9a5f79 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 17 23:09:21 2012 -0700 Update to asdf 2.23. diff --git a/src/contrib/asdf/asdf.lisp b/src/contrib/asdf/asdf.lisp index 5981f67..263bb5e 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.22: Another System Definition Facility. +;;; This is ASDF 2.23: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel(a)common-lisp.net>. @@ -116,7 +116,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.22") + (asdf-version "2.23") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -371,7 +371,8 @@ #:coerce-name #:directory-pathname-p #:ensure-directory-pathname #:absolute-pathname-p #:ensure-pathname-absolute #:pathname-root - #:getenv + #:getenv #:getenv-pathname #:getenv-pathname + #:getenv-absolute-directory #:getenv-absolute-directories #:probe-file* #:find-symbol* #:strcat #:make-pathname-component-logical #:make-pathname-logical @@ -2464,11 +2465,11 @@ recursive calls to traverse.") (*compile-file-failure-behaviour* (operation-on-failure operation))) (multiple-value-bind (output warnings-p failure-p) (call-with-around-compile-hook - c #'(lambda () + c #'(lambda (&rest flags) (apply *compile-op-compile-file-function* source-file :output-file output-file :external-format (component-external-format c) - (compile-op-flags operation)))) + (append flags (compile-op-flags operation))))) (unless output (error 'compile-error :component c :operation operation)) (when failure-p @@ -3290,37 +3291,44 @@ located." #+mcl (current-user-homedir-pathname) #-mcl (user-homedir-pathname)))) -(defun* ensure-absolute-pathname* (x fmt &rest args) - (and (plusp (length x)) - (or (absolute-pathname-p x) - (cerror "ignore relative pathname" - "Invalid relative pathname ~A~@[ ~?~]" x fmt args)) - x)) -(defun* split-absolute-pathnames (x fmt &rest args) +(defun* ensure-pathname* (x want-absolute want-directory fmt &rest args) + (when (plusp (length x)) + (let ((p (if want-directory (ensure-directory-pathname x) (pathname x)))) + (when want-absolute + (unless (absolute-pathname-p p) + (cerror "ignore relative pathname" + "Invalid relative pathname ~A~@[ ~?~]" x fmt args) + (return-from ensure-pathname* nil))) + p))) +(defun* split-pathnames* (x want-absolute want-directory fmt &rest args) (loop :for dir :in (split-string x :separator (string (inter-directory-separator))) - :do (apply 'ensure-absolute-pathname* dir fmt args) - :collect dir)) -(defun getenv-absolute-pathname (x &aux (s (getenv x))) - (ensure-absolute-pathname* s "from (getenv ~S)" x)) -(defun getenv-absolute-pathnames (x &aux (s (getenv x))) + :collect (apply 'ensure-pathname* dir want-absolute want-directory fmt args))) +(defun getenv-pathname (x &key want-absolute want-directory &aux (s (getenv x))) + (ensure-pathname* s want-absolute want-directory "from (getenv ~S)" x)) +(defun getenv-pathnames (x &key want-absolute want-directory &aux (s (getenv x))) (and (plusp (length s)) - (split-absolute-pathnames s "from (getenv ~S) = ~S" x s))) + (split-pathnames* s want-absolute want-directory "from (getenv ~S) = ~S" x s))) +(defun getenv-absolute-directory (x) + (getenv-pathname x :want-absolute t :want-directory t)) +(defun getenv-absolute-directories (x) + (getenv-pathnames x :want-absolute t :want-directory t)) + (defun* user-configuration-directories () (let ((dirs `(,@(when (os-unix-p) (cons - (subpathname* (getenv-absolute-pathname "XDG_CONFIG_HOME") "common-lisp/") - (loop :for dir :in (getenv-absolute-pathnames "XDG_CONFIG_DIRS") + (subpathname* (getenv-absolute-directory "XDG_CONFIG_HOME") "common-lisp/") + (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) - (getenv-absolute-pathname "LOCALAPPDATA")) + (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) - (getenv-absolute-pathname "APPDATA")) + (getenv-absolute-directory "APPDATA")) "common-lisp/config/"))) ,(subpathname (user-homedir) ".config/common-lisp/")))) (remove-duplicates (remove-if-not #'absolute-pathname-p dirs) @@ -3333,8 +3341,8 @@ located." (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) - (getenv-absolute-pathname "ALLUSERSAPPDATA") - (subpathname* (getenv-absolute-pathname "ALLUSERSPROFILE") "Application Data/")) + (getenv-absolute-directory "ALLUSERSAPPDATA") + (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/")) "common-lisp/config/") (list it))))) @@ -3458,12 +3466,12 @@ and the order is by decreasing length of namestring of the source pathname.") (defvar *user-cache* (flet ((try (x &rest sub) (and x `(,x ,@sub)))) (or - (try (getenv-absolute-pathname "XDG_CACHE_HOME") "common-lisp" :implementation) + (try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation) (when (os-windows-p) (try (or #+lispworks (sys:get-folder-path :local-appdata) - (getenv-absolute-pathname "LOCALAPPDATA") + (getenv-absolute-directory "LOCALAPPDATA") #+lispworks (sys:get-folder-path :appdata) - (getenv-absolute-pathname "APPDATA")) + (getenv-absolute-directory "APPDATA")) "common-lisp" "cache" :implementation)) '(:home ".cache" "common-lisp" :implementation)))) @@ -3687,8 +3695,8 @@ Please remove it from your ASDF configuration")) `(:output-translations ;; Some implementations have precompiled ASDF systems, ;; so we must disable translations for implementation paths. - #+sbcl ,(let ((h (getenv "SBCL_HOME"))) - (when (plusp (length h)) `((,(truenamize h) ,*wild-inferiors*) ()))) + #+sbcl ,(let ((h (getenv-pathname "SBCL_HOME" :want-directory t))) + (when h `((,(truenamize h) ,*wild-inferiors*) ()))) ;; The below two are not needed: no precompiled ASDF system there #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ;; #+clozure ,(ignore-errors (list (wilden (let ((*default-pathname-defaults* #p"")) (truename #p"ccl:"))) ())) @@ -3882,12 +3890,13 @@ effectively disabling the output translation facility." (when (and x (probe-file* x)) (delete-file x))) -(defun* compile-file* (input-file &rest keys &key output-file &allow-other-keys) - (let* ((output-file (apply 'compile-file-pathname* input-file :output-file output-file keys)) +(defun* compile-file* (input-file &rest keys &key compile-check output-file &allow-other-keys) + (let* ((keywords (remove-keyword :compile-check keys)) + (output-file (apply 'compile-file-pathname* input-file :output-file output-file keywords)) (tmp-file (tmpize-pathname output-file)) (status :error)) (multiple-value-bind (output-truename warnings-p failure-p) - (apply 'compile-file input-file :output-file tmp-file keys) + (apply 'compile-file input-file :output-file tmp-file keywords) (cond (failure-p (setf status *compile-file-failure-behaviour*)) @@ -3895,15 +3904,19 @@ effectively disabling the output translation facility." (setf status *compile-file-warnings-behaviour*)) (t (setf status :success))) - (ecase status - ((:success :warn :ignore) + (cond + ((and (ecase status + ((:success :warn :ignore) t) + ((:error nil))) + (or (not compile-check) + (apply compile-check input-file :output-file tmp-file keywords))) (delete-file-if-exists output-file) (when output-truename (rename-file output-truename output-file) (setf output-truename output-file))) - (:error + (t ;; error or failed check (delete-file-if-exists output-truename) - (setf output-truename nil))) + (setf output-truename nil failure-p t))) (values output-truename warnings-p failure-p)))) #+abcl @@ -4179,7 +4192,7 @@ with a different configuration, so the configuration would be re-read then." (defun* wrapping-source-registry () `(:source-registry - #+sbcl (:tree ,(truenamize (getenv "SBCL_HOME"))) + #+sbcl (:tree ,(truenamize (getenv-pathname "SBCL_HOME" :want-directory t))) :inherit-configuration #+cmu (:tree #p"modules:") #+scl (:tree #p"file://modules/"))) @@ -4189,18 +4202,18 @@ with a different configuration, so the configuration would be re-read then." (:directory ,(default-directory)) ,@(loop :for dir :in `(,@(when (os-unix-p) - `(,(or (getenv-absolute-pathname "XDG_DATA_HOME") + `(,(or (getenv-absolute-directory "XDG_DATA_HOME") (subpathname (user-homedir) ".local/share/")) - ,@(or (getenv-absolute-pathnames "XDG_DATA_DIRS") + ,@(or (getenv-absolute-directories "XDG_DATA_DIRS") '("/usr/local/share" "/usr/share")))) ,@(when (os-windows-p) `(,(or #+lispworks (sys:get-folder-path :local-appdata) - (getenv-absolute-pathname "LOCALAPPDATA")) + (getenv-absolute-directory "LOCALAPPDATA")) ,(or #+lispworks (sys:get-folder-path :appdata) - (getenv-absolute-pathname "APPDATA")) + (getenv-absolute-directory "APPDATA")) ,(or #+lispworks (sys:get-folder-path :common-appdata) - (getenv-absolute-pathname "ALLUSERSAPPDATA") - (subpathname* (getenv-absolute-pathname "ALLUSERSPROFILE") "Application Data/"))))) + (getenv-absolute-directory "ALLUSERSAPPDATA") + (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))))) :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) :inherit-configuration)) diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 5444383..3b21f1a 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -30,7 +30,7 @@ New in this release: * Added external format for EUC-KR. * Changes - * ASDF2 updated to version 2.22. + * ASDF2 updated to version 2.23. * 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 ----------------------------------------------------------------------- Summary of changes: src/contrib/asdf/asdf.lisp | 99 +++++++++++++++++++++---------------- src/general-info/release-20d.txt | 2 +- 2 files changed, 57 insertions(+), 44 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-9-g6180b39
by Raymond Toy 18 Jul '12

18 Jul '12

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 6180b3963ea5a38ef9f2f82bc53995e6dba349c1 (commit) via 40b532c59cd9ff6d48588ed8c36880a625009142 (commit) from ebb2b74c4b31d9e28432993958657c67bef50f0d (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 6180b3963ea5a38ef9f2f82bc53995e6dba349c1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 17 20:13:39 2012 -0700 Remove comment about compiling with clang, which now works fine. diff --git a/src/lisp/Config.x86_common b/src/lisp/Config.x86_common index edf4476..ea52b94 100644 --- a/src/lisp/Config.x86_common +++ b/src/lisp/Config.x86_common @@ -45,23 +45,9 @@ ifdef FEATURE_UNICODE CPP_DEFINE_OPTIONS += -DUNICODE endif -# Default to using gcc +# Default to using gcc. But clang also works. CC = gcc -# But we can use clang. -# -# However, clang seems to want to use SSE instructions in various -# places, but we DON'T want that because we need a lisp that will run -# on chips without sse. -# -# But on Mac, every machine has SSE2 so we can use SSE2. However, -# there's some code path through GC or allocation where we aren't -# saving the FPU state so after GC or allocation, some XMM FP -# registers are corrupted. -# -# Got that? - -#CC = clang -mno-sse LD = ld commit 40b532c59cd9ff6d48588ed8c36880a625009142 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 17 20:11:13 2012 -0700 Fix ticket:61, using option 2. src/lisp/gencgc.c: o Save and restore the FPU state in alloc(). src/compiler/x86/alloc.lisp src/compiler/x86/array.lisp src/compiler/x86/call.lisp src/compiler/x86/float-sse2.lisp src/compiler/x86/float.lisp src/compiler/x86/move.lisp src/compiler/x86/sap.lisp: o Don't need to use :save-p anymore because the allocation routine saves an live registers anyway. This improves code generation as well. src/general-info/release-20d.txt: o Update. diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index bff6d0b..85d95d1 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -53,7 +53,6 @@ (:variant-vars star) (:policy :safe) (:node-var node) - (:save-p t) (:generator 0 (cond ((zerop num) ;; (move result nil-value) @@ -142,7 +141,6 @@ (:temporary (:sc unsigned-reg :from (:argument 0)) boxed) (:temporary (:sc unsigned-reg :from (:argument 1)) unboxed) (:node-var node) - (:save-p t) (:generator 100 (move boxed boxed-arg) (inst add boxed (fixnumize (1+ code-trace-table-offset-slot))) @@ -171,7 +169,6 @@ (:args (name :scs (descriptor-reg) :to :eval)) (:results (result :scs (descriptor-reg) :from :argument)) (:node-var node) - (:save-p t) (:generator 37 (with-fixed-allocation (result fdefn-type fdefn-size node) (storew name result fdefn-name-slot other-pointer-type) @@ -185,7 +182,6 @@ (:args (name :scs (descriptor-reg) :to :eval)) (:results (result :scs (descriptor-reg) :from :argument)) (:node-var node) - (:save-p t) (:generator 37 (with-fixed-allocation (result fdefn-type fdefn-size node) (storew name result fdefn-name-slot other-pointer-type) @@ -200,7 +196,6 @@ (:temporary (:sc any-reg) temp) (:results (result :scs (descriptor-reg))) (:node-var node) - (:save-p t) (:generator 10 (let ((*enable-pseudo-atomic* (unless dynamic-extent *enable-pseudo-atomic*))) @@ -220,7 +215,6 @@ (:args (value :scs (descriptor-reg any-reg) :to :result)) (:results (result :scs (descriptor-reg) :from :eval)) (:node-var node) - (:save-p t) (:generator 10 (with-fixed-allocation (result value-cell-header-type value-cell-size node) @@ -242,7 +236,6 @@ (:ignore name) (:results (result :scs (descriptor-reg))) (:node-var node) - (:save-p t) (:generator 50 (let ((*enable-pseudo-atomic* (unless dynamic-extent *enable-pseudo-atomic*))) @@ -261,7 +254,6 @@ (:temporary (:sc any-reg :from :eval :to (:eval 1)) bytes) (:temporary (:sc any-reg :from :eval :to :result) header) (:node-var node) - (:save-p t) (:generator 50 (inst lea bytes (make-ea :dword :base extra :disp (* (1+ words) word-bytes))) @@ -287,7 +279,6 @@ (:temporary (:sc unsigned-reg :from :eval) state-addr) (:results (result :scs (descriptor-reg) :from :argument)) (:node-var node) - (:save-p t) (:generator 37 (with-fixed-allocation (result symbol-header-type symbol-size node) (storew name result symbol-name-slot other-pointer-type) diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp index 79b3ad1..ae86e43 100644 --- a/src/compiler/x86/array.lisp +++ b/src/compiler/x86/array.lisp @@ -35,7 +35,6 @@ (:temporary (:sc any-reg :to :result) header) (:results (result :scs (descriptor-reg) :from :eval)) (:node-var node) - (:save-p t) (:generator 13 (inst lea bytes (make-ea :dword :base rank diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index d0188c9..63104de 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -1365,7 +1365,6 @@ (:temporary (:sc unsigned-reg) dst) (:results (result :scs (descriptor-reg))) (:node-var node) - (:save-p t) (:generator 20 (let ((enter (gen-label)) (loop (gen-label)) diff --git a/src/compiler/x86/float-sse2.lisp b/src/compiler/x86/float-sse2.lisp index 9fe6d5d..f54f072 100644 --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -413,7 +413,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:single-float-type vm:single-float-size node) (inst movss (ea-for-sf-desc y) x)))) @@ -425,7 +424,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:double-float-type vm:double-float-size node) (inst movsd (ea-for-df-desc y) x)))) @@ -438,7 +436,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:long-float-type vm:long-float-size node) (with-tn@fp-top(x) @@ -501,7 +498,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:complex-single-float-type vm:complex-single-float-size node) @@ -514,7 +510,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:complex-double-float-type vm:complex-double-float-size node) @@ -529,7 +524,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:complex-long-float-type vm:complex-long-float-size node) @@ -549,7 +543,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex double-double float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm::complex-double-double-float-type vm::complex-double-double-float-size node) @@ -1570,7 +1563,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"double double float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:double-double-float-type vm:double-double-float-size node) diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index e0e90b0..e4d5952 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -498,7 +498,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:single-float-type vm:single-float-size node) (with-tn@fp-top(x) @@ -511,7 +510,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:double-float-type vm:double-float-size node) (with-tn@fp-top(x) @@ -525,7 +523,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:long-float-type vm:long-float-size node) (with-tn@fp-top(x) @@ -604,7 +601,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:complex-single-float-type vm:complex-single-float-size node) @@ -622,7 +618,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:complex-double-float-type vm:complex-double-float-size node) @@ -641,7 +636,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:complex-long-float-type vm:complex-long-float-size node) @@ -661,7 +655,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"complex double-double float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm::complex-double-double-float-type vm::complex-double-double-float-size node) @@ -5061,7 +5054,6 @@ (:results (y :scs (descriptor-reg))) (:node-var node) (:note _N"double double float to pointer coercion") - (:save-p t) (:generator 13 (with-fixed-allocation (y vm:double-double-float-type vm:double-double-float-size node) diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 7c6f0b9..2ff54ee 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -300,7 +300,6 @@ (:results (y :scs (any-reg descriptor-reg) :from :argument)) (:note _N"signed word to integer coercion") (:node-var node) - (:save-p t) (:generator 20 (assert (not (location= x y))) (let ((bignum (gen-label)) @@ -349,7 +348,6 @@ (:results (y :scs (any-reg descriptor-reg))) (:node-var node) (:note _N"unsigned word to integer coercion") - (:save-p t) (:generator 20 (assert (not (location= x y))) (assert (not (location= x alloc))) diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index 43e1a0e..a01112e 100644 --- a/src/compiler/x86/sap.lisp +++ b/src/compiler/x86/sap.lisp @@ -44,7 +44,6 @@ (:results (res :scs (descriptor-reg) :from :argument)) (:note "SAP to pointer coercion") (:node-var node) - (:save-p t) (:generator 20 (with-fixed-allocation (res sap-type sap-size node) (storew sap res sap-pointer-slot other-pointer-type)))) diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 4f9637e..5444383 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -94,6 +94,7 @@ New in this release: * #55: blocked signals. * #58: UTF-16 buffering problem. * #60: compile-file and export problem + * #61: Darwin+clang doesn't produce a working lisp * Other changes: * The layout of the cmucl directories has been changed. diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index fc095f8..cab6a0c 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -8027,6 +8027,7 @@ void do_pending_interrupt(void); char * alloc(int nbytes) { + void *new_obj; #if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__))) /* * *current-region-free-pointer* is the same as alloc-tn (= @@ -8041,24 +8042,44 @@ alloc(int nbytes) bytes_allocated_sum += nbytes; for (;;) { - void *new_obj; char *new_free_pointer = (void *) (get_current_region_free() + nbytes); if (new_free_pointer <= boxed_region.end_addr) { /* Allocate from the current region. */ new_obj = (void *) get_current_region_free(); set_current_region_free((lispobj) new_free_pointer); - return new_obj; + break; } else if (bytes_allocated <= auto_gc_trigger) { +#if defined(i386) || defined(__x86_64) + /* + * Need to save and restore the FPU registers on x86, but only for + * sse2. See Ticket #61. + * + * Not needed by sparc or ppc because we never call alloc from + * Lisp directly to do allocation. + */ + FPU_STATE(fpu_state); + + if (fpu_mode == SSE2) { + save_fpu_state(fpu_state); + } +#endif /* Call gc_alloc. */ boxed_region.free_pointer = (void *) get_current_region_free(); boxed_region.end_addr = (void *) SymbolValue(CURRENT_REGION_END_ADDR); new_obj = gc_alloc(nbytes); + set_current_region_free((lispobj) boxed_region.free_pointer); set_current_region_end((lispobj) boxed_region.end_addr); - return new_obj; + +#if defined(i386) || defined(__x86_64) + if (fpu_mode == SSE2) { + restore_fpu_state(fpu_state); + } +#endif + break; } else { /* Run GC and try again. */ auto_gc_trigger *= 2; @@ -8070,6 +8091,8 @@ alloc(int nbytes) set_pseudo_atomic_atomic(); } } + + return new_obj; } char * ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/alloc.lisp | 9 --------- src/compiler/x86/array.lisp | 1 - src/compiler/x86/call.lisp | 1 - src/compiler/x86/float-sse2.lisp | 8 -------- src/compiler/x86/float.lisp | 8 -------- src/compiler/x86/move.lisp | 2 -- src/compiler/x86/sap.lisp | 1 - src/general-info/release-20d.txt | 1 + src/lisp/Config.x86_common | 16 +--------------- src/lisp/gencgc.c | 29 ++++++++++++++++++++++++++--- 10 files changed, 28 insertions(+), 48 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-7-gebb2b74
by Raymond Toy 18 Jul '12

18 Jul '12

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 ebb2b74c4b31d9e28432993958657c67bef50f0d (commit) from 5e57578ad6f1d02d86379986f79755e993ce2c72 (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 ebb2b74c4b31d9e28432993958657c67bef50f0d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 17 19:51:28 2012 -0700 Add -R option to force recompilation of C runtime. diff --git a/bin/build-all.sh b/bin/build-all.sh index 8455de6..4585f37 100755 --- a/bin/build-all.sh +++ b/bin/build-all.sh @@ -34,12 +34,13 @@ usage () echo " -U Update and overwite the translations files." echo " -P On the last build, (re)generate cmucl.pot and the" echo " translations" + echo " -R Force recompilation of C runtime" } CREATE_OPT="" UPDATE_POT="-P" -while getopts "PUB:b:v:C:o:8:?" arg +while getopts "PRUB:b:v:C:o:8:?" arg do case $arg in b) BASE="$OPTARG" ;; @@ -50,6 +51,7 @@ do v) VERSION="$OPTARG"; VERSION_SET=true ;; U) UPDATE_TRANS="-U" ;; P) UPDATE_POT="" ;; + R) RECOMPILEC="-R" ;; \?) usage; exit 1 ;; esac done @@ -81,15 +83,15 @@ buildx86 () if [ -n "$OLD8" ]; then # Build non-unicode versions set -x - $BINDIR/build.sh -f x87 -b ${BASE}-8bit $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} -o "$OLD8" - $BINDIR/build.sh -f sse2 -b ${BASE}-8bit $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} -o "$OLD8" + $BINDIR/build.sh -f x87 -b ${BASE}-8bit $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} ${RECOMPILEC} -o "$OLD8" + $BINDIR/build.sh -f sse2 -b ${BASE}-8bit $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} ${RECOMPILEC} -o "$OLD8" set +x fi # Build the unicode versions if [ -n "$OLDLISP" ]; then set -x - $BINDIR/build.sh -f x87 -b ${BASE} $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} -o "$OLDLISP" - $BINDIR/build.sh -f sse2 -b ${BASE} $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} -o "$OLDLISP" + $BINDIR/build.sh -f x87 -b ${BASE} $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} ${RECOMPILEC} -o "$OLDLISP" + $BINDIR/build.sh -f sse2 -b ${BASE} $bootfiles ${VERSION:+-v "$VERSION"} -C "${CREATE_OPT}" ${UPDATE_TRANS} ${UPDATE_POT} ${RECOMPILEC} -o "$OLDLISP" set +x fi } @@ -102,13 +104,13 @@ buildsun4 () # Build non-unicode versions if [ -n "$OLD8" ]; then set -x - $BINDIR/build.sh -b ${BASE}-8bit $bootfiles ${VERS} -C "$CREATE_OPT" ${UPDATE_TRANS} ${UPDATE_POT} -o "$OLD8" + $BINDIR/build.sh -b ${BASE}-8bit $bootfiles ${VERS} -C "$CREATE_OPT" ${UPDATE_TRANS} ${UPDATE_POT} ${RECOMPILEC} -o "$OLD8" set +x fi # Build the unicode version. if [ -n "$OLDLISP" ]; then set -x - $BINDIR/build.sh -b ${BASE} $bootfiles ${VERS} -C "$CREATE_OPT" ${UPDATE_TRANS} ${UPDATE_POT} -o "$OLDLISP" + $BINDIR/build.sh -b ${BASE} $bootfiles ${VERS} -C "$CREATE_OPT" ${UPDATE_TRANS} ${UPDATE_POT} ${RECOMPILEC} -o "$OLDLISP" set +x fi } diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 631fcca..4f9637e 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -102,6 +102,8 @@ New in this release: in Xcode 4. * Add -R option to build.sh to force recompiling the C runtime. (Default it to compile only what is changed.) + * Add -R option to build-all.sh to force recompiling the C + runtime. * Improvements to the PCL implementation of CLOS: ----------------------------------------------------------------------- Summary of changes: bin/build-all.sh | 16 +++++++++------- src/general-info/release-20d.txt | 2 ++ 2 files changed, 11 insertions(+), 7 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-6-g5e57578
by Raymond Toy 18 Jul '12

18 Jul '12

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 5e57578ad6f1d02d86379986f79755e993ce2c72 (commit) via ea2dae80bcc9be55607ce8d9b62c268db53e98c5 (commit) from 5a06638f9d7e8309d4bb8eee49436489d5ce525f (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 5e57578ad6f1d02d86379986f79755e993ce2c72 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 17 19:35:23 2012 -0700 Fix possible stack corruption caused by possibly not allocating enough stack space to hold the SSE2 state. (Forgot to add extra bytes for 16-byte alignment!) diff --git a/src/lisp/x86-assem.S b/src/lisp/x86-assem.S index 34c1ef0..57b69c0 100644 --- a/src/lisp/x86-assem.S +++ b/src/lisp/x86-assem.S @@ -172,7 +172,11 @@ FUNCDEF(call_into_lisp) cmp $2, %eax # SSE2 mode? jne x87_save movl %esp, %eax # Remember the current stack pointer - subl $512,%esp # Make room for the SSE state + /* + * The SSE state is 512 bytes, but we need 16 more because we + * need 16-byte alignment. + */ + subl $512+16,%esp andl $-16, %esp # fxsave needs 16-byte alignment fxsave (%esp) pushl %eax # Save the old stack pointer @@ -194,7 +198,7 @@ x87_save: fldcw (%esp) # Recover modes popl %eax npx_save_done: - + /* Is this still necessary with sse2? */ fldz # insure no FP regs are empty fldz fldz commit ea2dae80bcc9be55607ce8d9b62c268db53e98c5 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 17 19:32:17 2012 -0700 Clean up and correct some comments. diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 21b68e4..ca2c267 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -140,22 +140,25 @@ (defun inline-allocation (alloc-tn size) (let ((ok (gen-label)) (done (gen-label))) - ;; + ;; Load the size first so that the size can be in the same ;; register as alloc-tn. (load-size alloc-tn alloc-tn size) - ;; + + ;; Try inline allocation, incrementing the + ;; current-region-free-pointer by the size. If we didn't pass the + ;; end of the region, then inline allocation succeeded, and we're + ;; done. (inst add alloc-tn (make-symbol-value-ea '*current-region-free-pointer*)) (inst cmp alloc-tn (make-symbol-value-ea '*current-region-end-addr*)) (inst jmp :be OK) - ;; Inline allocation didn't work so we need to call alloc, carefully. - - ;; Recompute the size. Can't just reload size because it might - ;; have already been destroyed if size = alloc-tn (which does - ;; happen). + ;; Inline allocation didn't work so we need to call alloc, + ;; carefully. Need to recompute the size because we can't just + ;; reload size because it might have already been destroyed if + ;; size = alloc-tn (which does happen). (inst sub alloc-tn (make-symbol-value-ea '*current-region-free-pointer*)) (case (tn-offset alloc-tn) (#.eax-offset @@ -169,7 +172,7 @@ (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" #+sse2 "alloc_overflow_sse2") :foreign)) - (inst mov alloc-tn eax-tn) ; Save allocated address in alloc-tn + (inst mov alloc-tn eax-tn) ; Put allocated address in alloc-tn (inst pop eax-tn) ; Restore old value of eax (inst jmp done))) @@ -181,8 +184,7 @@ (values)) (defun not-inline-allocation (alloc-tn size) - ;; C call to allocate via dispatch routines. Each destination has a - ;; special entry point. The size may be a register or a constant. + ;; C call to allocate. The size may be a register or a constant. (load-size alloc-tn alloc-tn size) (case (tn-offset alloc-tn) (#.eax-offset diff --git a/src/lisp/x86-assem.S b/src/lisp/x86-assem.S index 9583e84..34c1ef0 100644 --- a/src/lisp/x86-assem.S +++ b/src/lisp/x86-assem.S @@ -484,7 +484,7 @@ FUNCDEF(alloc_overflow_sse2) movl %ecx, 8(%esp) # Save ecx and edx registers movl %edx, 4(%esp) stmxcsr 12(%esp) # Save MXCSR - /* Clear the exceptions that might occurred */ + /* Clear the exceptions that might have occurred */ movl 12(%esp), %edx and $-64, %edx # Clear the exceptions movl %edx, 16(%esp) ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/macros.lisp | 22 ++++++++++++---------- src/lisp/x86-assem.S | 10 +++++++--- 2 files changed, 19 insertions(+), 13 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-4-g5a06638
by Raymond Toy 17 Jul '12

17 Jul '12

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 5a06638f9d7e8309d4bb8eee49436489d5ce525f (commit) from 99020b36cd96dae59ba3638d01c69d18ee9edcd1 (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 5a06638f9d7e8309d4bb8eee49436489d5ce525f Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Jul 16 22:21:18 2012 -0700 Change url to www.cmucl.org. diff --git a/src/code/save.lisp b/src/code/save.lisp index 69d91fc..f06461f 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -357,7 +357,7 @@ (setf (getf *herald-items* :bugs) `(,#'(lambda (stream) - (write-string (intl:gettext "See <http://www.cons.org/cmucl/> for support information.") stream)) + (write-string (intl:gettext "See <http://www.cmucl.org/> for support information.") stream)) terpri ,#'(lambda (stream) (write-string (intl:gettext "Loaded subsystems:") stream)))) ----------------------------------------------------------------------- Summary of changes: src/code/save.lisp | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-3-g99020b3
by Raymond Toy 17 Jul '12

17 Jul '12

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 99020b36cd96dae59ba3638d01c69d18ee9edcd1 (commit) from f9f78a47c59d5cbe762a8a571b66b788b27e45ff (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 99020b36cd96dae59ba3638d01c69d18ee9edcd1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Jul 16 19:43:14 2012 -0700 Clean up not-inline-allocation. src/lisp/x86-assem.S: o Remove the (now) unused alloc_to_<reg> functions. src/compiler/x86/macros.lisp: o Simplify the not-inline-allocation to use the same routines as inline allocation. diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 9d955f4..21b68e4 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -183,31 +183,20 @@ (defun not-inline-allocation (alloc-tn size) ;; C call to allocate via dispatch routines. Each destination has a ;; special entry point. The size may be a register or a constant. - (ecase (tn-offset alloc-tn) + (load-size alloc-tn alloc-tn size) + (case (tn-offset alloc-tn) (#.eax-offset - (load-size alloc-tn eax-tn size) - (inst call (make-fixup (extern-alien-name "alloc_to_eax") + (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" + #+sse2 "alloc_overflow_sse2") :foreign))) - (#.ecx-offset - (load-size alloc-tn ecx-tn size) - (inst call (make-fixup (extern-alien-name "alloc_to_ecx") - :foreign))) - (#.edx-offset - (load-size alloc-tn edx-tn size) - (inst call (make-fixup (extern-alien-name "alloc_to_edx") - :foreign))) - (#.ebx-offset - (load-size alloc-tn ebx-tn size) - (inst call (make-fixup (extern-alien-name "alloc_to_ebx") - :foreign))) - (#.esi-offset - (load-size alloc-tn esi-tn size) - (inst call (make-fixup (extern-alien-name "alloc_to_esi") - :foreign))) - (#.edi-offset - (load-size alloc-tn edi-tn size) - (inst call (make-fixup (extern-alien-name "alloc_to_edi") - :foreign)))) + (t + (inst push eax-tn) ; Save any value in eax + (inst mov eax-tn alloc-tn) + (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" + #+sse2 "alloc_overflow_sse2") + :foreign)) + (inst mov alloc-tn eax-tn) ; Save allocated address in alloc-tn + (inst pop eax-tn))) (values)) ;;; diff --git a/src/lisp/x86-assem.S b/src/lisp/x86-assem.S index 46640fa..9583e84 100644 --- a/src/lisp/x86-assem.S +++ b/src/lisp/x86-assem.S @@ -459,101 +459,6 @@ ENDFUNC(fastcopy16) /* - Allocate bytes and return the start of the allocated space - in the specified destination register. - - In the general case the size will be in the destination register. - - All registers must be preserved except the destination. - The C conventions will preserve ebx, esi, edi, and ebp. - So only eax, ecx, and edx need special care here. */ - -FUNCDEF(alloc_to_eax) - STACK_PROLOGUE(12) - movl %ecx, 8(%esp) # Save ecx and edx as C could destroy them. - movl %edx, 4(%esp) - movl %eax, (%esp) # Push the size - call GNAME(alloc) - movl 4(%esp), %edx # Restore ecx and edx. - movl 8(%esp), %ecx - STACK_EPILOGUE - ret -ENDFUNC(alloc_to_eax) - -FUNCDEF(alloc_to_ecx) - STACK_PROLOGUE(12) - movl %eax, 8(%esp) # Save eax and edx as C could destroy them. - movl %edx, 4(%esp) - movl %ecx, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%ecx # setup the destination. - movl 4(%esp), %edx # Restore eax and edx. - movl 8(%esp), %eax - STACK_EPILOGUE - ret -ENDFUNC(alloc_to_ecx) - -FUNCDEF(alloc_to_edx) - STACK_PROLOGUE(12) - movl %eax, 8(%esp) # Save eax and ecx as C could destroy them. - movl %ecx, 4(%esp) - movl %edx, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%edx # setup the destination. - movl 4(%esp), %ecx # Restore eax and ecx. - movl 8(%esp), %eax - STACK_EPILOGUE - ret -ENDFUNC(alloc_to_edx) - -FUNCDEF(alloc_to_ebx) - STACK_PROLOGUE(16) - movl %eax, 12(%esp) # Save eax, ecx, and edx as C could destroy them. - movl %ecx, 8(%esp) - movl %edx, 4(%esp) - movl %ebx, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%ebx # setup the destination. - movl 4(%esp), %edx # Restore eax, ecx and edx. - movl 8(%esp), %ecx - movl 12(%esp), %eax - STACK_EPILOGUE - ret -ENDFUNC(alloc_to_ebx) - -FUNCDEF(alloc_to_esi) - STACK_PROLOGUE(16) - movl %eax, 12(%esp) # Save eax, ecx, and edx as C could destroy them. - movl %ecx, 8(%esp) - movl %edx, 4(%esp) - movl %esi, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%esi # setup the destination. - movl 4(%esp), %edx # Restore eax, ecx and edx. - movl 8(%esp), %ecx - movl 12(%esp), %eax - STACK_EPILOGUE - ret -ENDFUNC(alloc_to_esi) - -FUNCDEF(alloc_to_edi) - STACK_PROLOGUE(16) - movl %eax, 12(%esp) # Save eax, ecx, and edx as C could destroy them. - movl %ecx, 8(%esp) - movl %edx, 4(%esp) - movl %edi, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%edi # setup the destination. - movl 4(%esp), %edx # Restore eax, ecx and edx. - movl 8(%esp), %ecx - movl 12(%esp), %eax - STACK_EPILOGUE - ret -ENDFUNC(alloc_to_edi) - -#ifdef GENCGC - -/* * alloc_overflow_x87 and alloc_overflow_sse2 must not be called from * C because it doesn't follow C conventions. * @@ -595,8 +500,6 @@ FUNCDEF(alloc_overflow_sse2) ret ENDFUNC(alloc_overflow_sse2) -#endif /* GENCGC */ - #ifdef LINKAGE_TABLE /* Call into C code to resolve a linkage entry. The initial code in the ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/macros.lisp | 35 +++++---------- src/lisp/x86-assem.S | 97 ------------------------------------------ 2 files changed, 12 insertions(+), 120 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-2-gf9f78a4
by Raymond Toy 13 Jul '12

13 Jul '12

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 f9f78a47c59d5cbe762a8a571b66b788b27e45ff (commit) via 2e95a0bb1011de96626271d6c4e367a6a8e7a6a4 (commit) from 7933ebf6d092f5172db350473629155ff622c888 (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 f9f78a47c59d5cbe762a8a571b66b788b27e45ff Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Jul 12 20:49:43 2012 -0700 Remove old inline allocation function and corresponding assembly routines. diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 5f7c397..9d955f4 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -137,47 +137,6 @@ (unless (and (tn-p size) (location= alloc-tn size)) (inst mov dst-tn size))) -#+nil -(defun inline-allocation (alloc-tn size) - (let ((ok (gen-label))) - ;; - ;; Load the size first so that the size can be in the same - ;; register as alloc-tn. - (load-size alloc-tn alloc-tn size) - ;; - (inst add alloc-tn - (make-symbol-value-ea '*current-region-free-pointer*)) - (inst cmp alloc-tn - (make-symbol-value-ea '*current-region-end-addr*)) - (inst jmp :be OK) - ;; - ;; Dispatch to the appropriate overflow routine. There is a - ;; routine for each destination. - (ecase (tn-offset alloc-tn) - (#.eax-offset - (inst call (make-fixup (extern-alien-name "alloc_overflow_eax") - :foreign))) - (#.ecx-offset - (inst call (make-fixup (extern-alien-name "alloc_overflow_ecx") - :foreign))) - (#.edx-offset - (inst call (make-fixup (extern-alien-name "alloc_overflow_edx") - :foreign))) - (#.ebx-offset - (inst call (make-fixup (extern-alien-name "alloc_overflow_ebx") - :foreign))) - (#.esi-offset - (inst call (make-fixup (extern-alien-name "alloc_overflow_esi") - :foreign))) - (#.edi-offset - (inst call (make-fixup (extern-alien-name "alloc_overflow_edi") - :foreign)))) - (emit-label ok) - (inst xchg (make-symbol-value-ea '*current-region-free-pointer*) - alloc-tn)) - (values)) - -;;#+nil (defun inline-allocation (alloc-tn size) (let ((ok (gen-label)) (done (gen-label))) diff --git a/src/lisp/x86-assem.S b/src/lisp/x86-assem.S index 465ab39..46640fa 100644 --- a/src/lisp/x86-assem.S +++ b/src/lisp/x86-assem.S @@ -553,124 +553,6 @@ ENDFUNC(alloc_to_edi) #ifdef GENCGC -/* Called from lisp when an inline allocation overflows. - Every register except the result needs to be preserved. - We depend on C to preserve ebx, esi, edi, and ebp. - But where necessary must save eax, ecx, edx. */ - -/* This routine handles an overflow with eax=crfp+size. So the - size=eax-crfp. */ -FUNCDEF(alloc_overflow_eax) - STACK_PROLOGUE(12) - movl %ecx, 8(%esp) # Save ecx - movl %edx, 4(%esp) # Save edx - /* Calculate the size for the allocation. */ - subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%eax - movl %eax, (%esp) # Push the size - call GNAME(alloc) - movl 4(%esp), %edx # Restore edx. - movl 8(%esp), %ecx # Restore ecx. - STACK_EPILOGUE - addl $6,(%esp) # Adjust the return address to skip the next inst. - ret -ENDFUNC(alloc_overflow_eax) - -/* This routine handles an overflow with ecx=crfp+size. So the - size=ecx-crfp. */ -FUNCDEF(alloc_overflow_ecx) - STACK_PROLOGUE(12) - movl %eax, 8(%esp) # Save eax - movl %edx, 4(%esp) # Save edx - /* Calculate the size for the allocation. */ - subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%ecx - movl %ecx, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%ecx # setup the destination. - movl 4(%esp), %edx # Restore edx. - movl 8(%esp), %eax # Restore eax. - STACK_EPILOGUE - addl $6,(%esp) # Adjust the return address to skip the next inst. - ret -ENDFUNC(alloc_overflow_ecx) - -/* This routine handles an overflow with edx=crfp+size. So the - size=edx-crfp. */ -FUNCDEF(alloc_overflow_edx) - STACK_PROLOGUE(12) - movl %eax, 8(%esp) # Save eax - movl %ecx, 4(%esp) # Save ecx - /* Calculate the size for the allocation. */ - subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%edx - movl %edx, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%edx # setup the destination. - movl 4(%esp), %ecx # Restore ecx. - movl 8(%esp), %eax # Restore eax. - STACK_EPILOGUE - addl $6,(%esp) # Adjust the return address to skip the next inst. - ret -ENDFUNC(alloc_overflow_edx) - -/* This routine handles an overflow with ebx=crfp+size. So the - size=ebx-crfp. */ -FUNCDEF(alloc_overflow_ebx) - STACK_PROLOGUE(16) - movl %eax, 12(%esp) # Save eax - movl %ecx, 8(%esp) # Save ecx - movl %edx, 4(%esp) # Save edx - /* Calculate the size for the allocation. */ - subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%ebx - movl %ebx, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%ebx # setup the destination. - movl 4(%esp), %edx # Restore edx. - movl 8(%esp), %ecx # Restore ecx. - movl 12(%esp), %eax # Restore eax. - STACK_EPILOGUE - addl $6,(%esp) # Adjust the return address to skip the next inst. - ret -ENDFUNC(alloc_overflow_ebx) - -/* This routine handles an overflow with esi=crfp+size. So the - size=esi-crfp. */ -FUNCDEF(alloc_overflow_esi) - STACK_PROLOGUE(16) - movl %eax, 12(%esp) # Save eax - movl %ecx, 8(%esp) # Save ecx - movl %edx, 4(%esp) # Save edx - /* Calculate the size for the allocation. */ - subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%esi - movl %esi, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%esi # setup the destination. - movl 4(%esp), %edx # Restore edx. - movl 8(%esp), %ecx # Restore ecx. - movl 12(%esp), %eax # Restore eax. - STACK_EPILOGUE - addl $6,(%esp) # Adjust the return address to skip the next inst. - ret -ENDFUNC(alloc_overflow_esi) - -/* This routine handles an overflow with edi=crfp+size. So the - size=edi-crfp. */ -FUNCDEF(alloc_overflow_edi) - STACK_PROLOGUE(16) - movl %eax, 12(%esp) # Save eax - movl %ecx, 8(%esp) # Save ecx - movl %edx, 4(%esp) # Save edx - /* Calculate the size for the allocation. */ - subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%edi - movl %edi, (%esp) # Push the size - call GNAME(alloc) - movl %eax,%edi # setup the destination. - movl 4(%esp), %edx # Restore edx. - movl 8(%esp), %ecx # Restore ecx. - movl 12(%esp), %eax # Restore eax. - STACK_EPILOGUE - addl $6,(%esp) # Adjust the return address to skip the next inst. - ret -ENDFUNC(alloc_overflow_edi) - /* * alloc_overflow_x87 and alloc_overflow_sse2 must not be called from * C because it doesn't follow C conventions. @@ -703,7 +585,9 @@ FUNCDEF(alloc_overflow_sse2) movl %edx, 16(%esp) ldmxcsr 16(%esp) # Get new mxcsr value movl %eax, (%esp) # Put size on stack for first arg to alloc() + call GNAME(alloc) + movl 4(%esp), %edx # Restore edx and ecx registers. eax has the return value. movl 8(%esp), %ecx ldmxcsr 12(%esp) commit 2e95a0bb1011de96626271d6c4e367a6a8e7a6a4 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Jul 11 22:00:07 2012 -0700 Clean up alloc overflow routine. Cross-compile needed. src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp: o X86 cross-compile script src/compiler/x86/macros.lisp: o New inline-allocation to call our new overflow routine. src/lisp/x86-assem.S: o New alloc_overflow routine. src/tools/cross-scripts/cross-x86-x86.lisp: o Export all symbols in VM that are external symbols in OLD-VM with the corresponding symbol name. diff --git a/src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp b/src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp new file mode 100644 index 0000000..d9a5a3e --- /dev/null +++ b/src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp @@ -0,0 +1,8 @@ +;;; Bootstrap for building the 2012-08 snapshot from the 2012-07 +;;; snapshot. The inline allocation routines are changing. + +;;; Nothing fancy needed; just use do a simple cross-build-world using +;;; this as the script. +#+x86 +(load "target:tools/cross-scripts/cross-x86-x86") + diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 731bcf4..5f7c397 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -137,6 +137,7 @@ (unless (and (tn-p size) (location= alloc-tn size)) (inst mov dst-tn size))) +#+nil (defun inline-allocation (alloc-tn size) (let ((ok (gen-label))) ;; @@ -176,6 +177,50 @@ alloc-tn)) (values)) +;;#+nil +(defun inline-allocation (alloc-tn size) + (let ((ok (gen-label)) + (done (gen-label))) + ;; + ;; Load the size first so that the size can be in the same + ;; register as alloc-tn. + (load-size alloc-tn alloc-tn size) + ;; + (inst add alloc-tn + (make-symbol-value-ea '*current-region-free-pointer*)) + (inst cmp alloc-tn + (make-symbol-value-ea '*current-region-end-addr*)) + (inst jmp :be OK) + + ;; Inline allocation didn't work so we need to call alloc, carefully. + + ;; Recompute the size. Can't just reload size because it might + ;; have already been destroyed if size = alloc-tn (which does + ;; happen). + (inst sub alloc-tn (make-symbol-value-ea '*current-region-free-pointer*)) + (case (tn-offset alloc-tn) + (#.eax-offset + (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" + #+sse2 "alloc_overflow_sse2") + :foreign)) + (inst jmp done)) + (t + (inst push eax-tn) ; Save any value in eax + (inst mov eax-tn alloc-tn) + (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" + #+sse2 "alloc_overflow_sse2") + :foreign)) + (inst mov alloc-tn eax-tn) ; Save allocated address in alloc-tn + (inst pop eax-tn) ; Restore old value of eax + (inst jmp done))) + + (emit-label ok) + (inst xchg (make-symbol-value-ea '*current-region-free-pointer*) + alloc-tn) + (emit-label done)) + + (values)) + (defun not-inline-allocation (alloc-tn size) ;; C call to allocate via dispatch routines. Each destination has a ;; special entry point. The size may be a register or a constant. @@ -240,7 +285,7 @@ Result-TN." `(pseudo-atomic (allocation ,result-tn (pad-data-block ,size) ,inline) - (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,result-tn) + (storew (logior (ash (1- ,size) vm::type-bits) ,type-code) ,result-tn) (inst lea ,result-tn (make-ea :byte :base ,result-tn :disp other-pointer-type)) ,@forms)) diff --git a/src/lisp/x86-assem.S b/src/lisp/x86-assem.S index 19be973..465ab39 100644 --- a/src/lisp/x86-assem.S +++ b/src/lisp/x86-assem.S @@ -671,7 +671,47 @@ FUNCDEF(alloc_overflow_edi) ret ENDFUNC(alloc_overflow_edi) -#endif +/* + * alloc_overflow_x87 and alloc_overflow_sse2 must not be called from + * C because it doesn't follow C conventions. + * + * On entry: + * %eax = bytes to allocate + * On exit: + * %eax = address + */ +FUNCDEF(alloc_overflow_x87) + STACK_PROLOGUE(12) + movl %ecx, 8(%esp) # Save ecx and edx registers + movl %edx, 4(%esp) + movl %eax, (%esp) # Put size on stack for first arg to alloc() + call GNAME(alloc) + movl 4(%esp), %edx # Restore edx and ecx registers. eax has the return value. + movl 8(%esp), %ecx + STACK_EPILOGUE + ret +ENDFUNC(alloc_overflow_x87) + +FUNCDEF(alloc_overflow_sse2) + STACK_PROLOGUE(20) + movl %ecx, 8(%esp) # Save ecx and edx registers + movl %edx, 4(%esp) + stmxcsr 12(%esp) # Save MXCSR + /* Clear the exceptions that might occurred */ + movl 12(%esp), %edx + and $-64, %edx # Clear the exceptions + movl %edx, 16(%esp) + ldmxcsr 16(%esp) # Get new mxcsr value + movl %eax, (%esp) # Put size on stack for first arg to alloc() + call GNAME(alloc) + movl 4(%esp), %edx # Restore edx and ecx registers. eax has the return value. + movl 8(%esp), %ecx + ldmxcsr 12(%esp) + STACK_EPILOGUE + ret +ENDFUNC(alloc_overflow_sse2) + +#endif /* GENCGC */ #ifdef LINKAGE_TABLE diff --git a/src/tools/cross-scripts/cross-x86-x86.lisp b/src/tools/cross-scripts/cross-x86-x86.lisp index aa4d84d..fa4e31c 100644 --- a/src/tools/cross-scripts/cross-x86-x86.lisp +++ b/src/tools/cross-scripts/cross-x86-x86.lisp @@ -46,6 +46,9 @@ (export 'vm::fixup-code-object "VM") (export 'vm::sanctify-for-execution "VM") +(do-external-symbols (sym "OLD-VM") + (export (intern (symbol-name sym) "VM") "VM")) + (load "target:tools/comcom") ;;; Load the new backend. ----------------------------------------------------------------------- Summary of changes: src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp | 8 ++ src/compiler/x86/macros.lisp | 52 +++++---- src/lisp/x86-assem.S | 142 +++++----------------- src/tools/cross-scripts/cross-x86-x86.lisp | 3 + 4 files changed, 72 insertions(+), 133 deletions(-) create mode 100644 src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp annotated tag snapshot-2012-07 created. snapshot-2012-07
by Raymond Toy 08 Jul '12

08 Jul '12

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-2012-07 has been created at e8c658f4cd3321c2deb738b5d29d8897b25feba7 (tag) tagging 7933ebf6d092f5172db350473629155ff622c888 (commit) replaces snapshot-2012-06 tagged by Raymond Toy on Sun Jul 8 10:34:28 2012 -0700 - Log ----------------------------------------------------------------- Snapshot 2012-07 -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.11 (Darwin) iEYEABECAAYFAk/5xKsACgkQJ5IjUmgZO7K3yACePfl/sKMu1D6J7sEzFkBiJjqz WRsAnjPTrR+VI01LIuiYHpX6W/bmadvH =+zkg -----END PGP SIGNATURE----- Raymond Toy (5): Update to asdf 2.22. Testsuite for asdf, using 2012-06, passes fine. Change min_av_mem_age to be an int instead of double. No floating All VOPs that call allocation should save any live registers. Rearrange the fpu save/restore stuff to make it a bit simpler. Oops. Need to use long long's to compute the age in gen_av_mem_age(). ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-06-5-g7933ebf
by Raymond Toy 06 Jul '12

06 Jul '12

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 7933ebf6d092f5172db350473629155ff622c888 (commit) from 2daa0e7c547d718b19b8b7d5408d8cf0be35a861 (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 7933ebf6d092f5172db350473629155ff622c888 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Jul 5 15:24:18 2012 -0700 Oops. Need to use long long's to compute the age in gen_av_mem_age(). diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index a14b714..fc095f8 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -659,7 +659,7 @@ gen_av_mem_age(int gen) if (generations[gen].bytes_allocated == 0) return 0; - return (((long) generations[gen].cum_sum_bytes_allocated) << MEM_AGE_SHIFT) / + return (((long long) generations[gen].cum_sum_bytes_allocated) << MEM_AGE_SHIFT) / generations[gen].bytes_allocated; } ----------------------------------------------------------------------- Summary of changes: src/lisp/gencgc.c | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-06-4-g2daa0e7
by Raymond Toy 05 Jul '12

05 Jul '12

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 2daa0e7c547d718b19b8b7d5408d8cf0be35a861 (commit) from f61034ab9eadb5f0e86c1d93930c2cc7e04835c3 (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 2daa0e7c547d718b19b8b7d5408d8cf0be35a861 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Jul 5 08:48:31 2012 -0700 Rearrange the fpu save/restore stuff to make it a bit simpler. diff --git a/src/lisp/arch.h b/src/lisp/arch.h index 7de6665..b8ebf3f 100644 --- a/src/lisp/arch.h +++ b/src/lisp/arch.h @@ -32,6 +32,8 @@ extern lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, extern void fpu_save(void *); extern void fpu_restore(void *); +extern void sse_save(void *); +extern void sse_restore(void *); extern void arch_make_linkage_entry(long, void *, long); extern long arch_linkage_entry(unsigned long); diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index 1e20421..a14b714 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -664,14 +664,9 @@ gen_av_mem_age(int gen) } /* - * The verbose argument controls how much to print out: - * 0 for normal level of detail; 1 for debugging. + * Define macro to allocate a local array of the appropriate size + * where the fpu state can be stored. */ -void -print_generation_stats(int verbose) -{ - int i, gens; - #if defined(i386) || defined(__x86_64) #define FPU_STATE_SIZE 27 /* @@ -680,36 +675,73 @@ print_generation_stats(int verbose) * appropriate alignment. */ #define SSE_STATE_SIZE ((512+16)/4) - int fpu_state[FPU_STATE_SIZE]; - int sse_state[SSE_STATE_SIZE]; - extern void sse_save(void *); - extern void sse_restore(void *); +/* + * Just use the SSE size for both x87 and sse2 since the SSE size is + * enough for either. + */ +#define FPU_STATE(name) int name[SSE_STATE_SIZE]; + #elif defined(sparc) - /* - * 32 (single-precision) FP registers, and the FP state register. - * But Sparc V9 has 32 double-precision registers (equivalent to 64 - * single-precision, but can't be accessed), so we leave enough room - * for that. - */ +/* + * 32 (single-precision) FP registers, and the FP state register. + * But Sparc V9 has 32 double-precision registers (equivalent to 64 + * single-precision, but can't be accessed), so we leave enough room + * for that. + */ #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2) - long long fpu_state[FPU_STATE_SIZE]; +#define FPU_STATE(name) long long name[FPU_STATE_SIZE]; #elif defined(DARWIN) && defined(__ppc__) #define FPU_STATE_SIZE 32 - long long fpu_state[FPU_STATE_SIZE]; +#define FPU_STATE(name0 long long name[FPU_STATE_SIZE]; #endif +void +save_fpu_state(void* state) +{ +#if defined(i386) || defined(__x86_64) + if (fpu_mode == SSE2) { + sse_save(state); + } else { + fpu_save(state); + } +#else + fpu_save(state); +#endif +} + +void +restore_fpu_state(void* state) +{ +#if defined(i386) || defined(__x86_64) + if (fpu_mode == SSE2) { + sse_restore(state); + } else { + fpu_restore(state); + } +#else + fpu_restore(state); +#endif +} + + +/* + * The verbose argument controls how much to print out: + * 0 for normal level of detail; 1 for debugging. + */ +void +print_generation_stats(int verbose) +{ + int i, gens; + + FPU_STATE(fpu_state); + /* * This code uses the FP instructions which may be setup for Lisp so * they need to the saved and reset for C. */ - fpu_save(fpu_state); -#if defined(i386) || defined(__x86_64) - if (fpu_mode == SSE2) { - sse_save(sse_state); - } -#endif + save_fpu_state(fpu_state); /* Number of generations to print out. */ if (verbose) @@ -763,12 +795,7 @@ print_generation_stats(int verbose) } fprintf(stderr, " Total bytes alloc=%ld\n", bytes_allocated); - fpu_restore(fpu_state); -#if defined(i386) || defined(__x86_64) - if (fpu_mode == SSE2) { - sse_restore(sse_state); - } -#endif + restore_fpu_state(fpu_state); } /* Get statistics that are kept "on the fly" out of the generation ----------------------------------------------------------------------- Summary of changes: src/lisp/arch.h | 2 + src/lisp/gencgc.c | 89 ++++++++++++++++++++++++++++++++++------------------ 2 files changed, 60 insertions(+), 31 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0