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

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-12-g6a9fd11
by Raymond Toy 22 Feb '13

22 Feb '13

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 6a9fd11d55bd794a02ec3686f3811d794aa8ac6d (commit) from 17e30810393e36b3530b47420cd66b06dfb47332 (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 6a9fd11d55bd794a02ec3686f3811d794aa8ac6d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Feb 21 21:46:40 2013 -0800 Update from commit logs. diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt index 8d14c58..aa6e6ee 100644 --- a/src/general-info/release-20e.txt +++ b/src/general-info/release-20e.txt @@ -34,6 +34,10 @@ New in this release: this GC. * For x86, optimize TRUNCATE when the second arg is a compile-time constant. (Sparc and ppc already had this optimization) + * The following *FEATURES* have been removed: + * :COMMON (not used) + * :CONSERVATIVE-FLOAT-TYPE (Always default to this in type + derivation.) * ANSI compliance fixes: ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20e.txt | 4 ++++ 1 files changed, 4 insertions(+), 0 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-11-g17e3081
by Raymond Toy 22 Feb '13

22 Feb '13

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 17e30810393e36b3530b47420cd66b06dfb47332 (commit) from 0ecc7f4cbf55f877f2d2fa65c31f2e6665cc68ba (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 17e30810393e36b3530b47420cd66b06dfb47332 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Feb 21 21:43:50 2013 -0800 Clean up one- and two-arg-derive-type. srctran.lisp:: * The optional convert-type arg is always true, so remove it and update the local functions to convert always. * Clean up some comments as well. float-tran.lisp:: * Fix up one place where we were supplying a value for the optional convert-type arg. diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 3a663a8..639ac8a 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -553,7 +553,7 @@ ;;; (defoptimizer (scale-float derive-type) ((f ex)) (two-arg-derive-type f ex #'scale-float-derive-type-aux - #'scale-float t)) + #'scale-float)) ;;; toy(a)rtp.ericsson.se: ;;; diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 8f5c134..7888eba 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1189,11 +1189,9 @@ ;;; compute the result otherwise the member type is first converted to a ;;; numeric type and the derive-fcn is call. ;;; -(defun one-arg-derive-type (arg derive-fcn member-fcn - &optional (convert-type t)) +(defun one-arg-derive-type (arg derive-fcn member-fcn) (declare (type function derive-fcn) - (type (or null function) member-fcn) - ) + (type (or null function) member-fcn)) (let ((arg-list (prepare-arg-for-derive-type (continuation-type arg)))) (when arg-list (flet ((deriver (x) @@ -1203,18 +1201,14 @@ (with-float-traps-masked (:underflow :overflow :divide-by-zero) (specifier-type `(eql ,(funcall member-fcn - (first (member-type-members x)))))) + (first (member-type-members x)))))) ;; Otherwise convert to a numeric type. (let ((result-type-list (funcall derive-fcn (convert-member-type x)))) - (if convert-type - (convert-back-numeric-type-list result-type-list) - result-type-list)))) + (convert-back-numeric-type-list result-type-list)))) (numeric-type - (if convert-type - (convert-back-numeric-type-list - (funcall derive-fcn (convert-numeric-type x))) - (funcall derive-fcn x))) + (convert-back-numeric-type-list + (funcall derive-fcn (convert-numeric-type x)))) (t *universal-type*)))) ;; Run down the list of args and derive the type of each one, saving @@ -1238,63 +1232,53 @@ ;;; (* x x), which should always be positive. If we didn't do this, we ;;; wouldn't be able to tell. ;;; -;;; Without the negative-zero-is-not-zero feature, numeric types are first -;;; converted to the negative-zero-is-not-zero conventions as expected by the -;;; deriver function. -;;; -;;; For the case of two member types, the result may be derived by calling the -;;; given function FCN but if a NaN is generated then an unbounded type is -;;; returned. Alternatively a tighter, less conservative, type can often be -;;; returned by converting to numeric types and calling the deriver function, -;;; which is the default behavior without the conservative-float-type feature. -;;; -(defun two-arg-derive-type (arg1 arg2 derive-fcn fcn - &optional (convert-type t)) - (labels ((maybe-convert-numeric-type (type) - (if convert-type (convert-numeric-type type) type)) - (maybe-convert-back-type-list (type) - (if convert-type (convert-back-numeric-type-list type) type)) - (deriver (x y same-arg) - (cond ((and (member-type-p x) (member-type-p y)) - (let* ((x (first (member-type-members x))) - (y (first (member-type-members y))) - (result (with-float-traps-masked - (:underflow :overflow :divide-by-zero - :invalid) - (funcall fcn x y)))) - (cond ((null result)) - ((and (floatp result) (float-nan-p result)) - (make-numeric-type :class 'float - :format (type-of result) - :complexp :real)) - (t - (specifier-type `(eql ,result)))))) - ((and (member-type-p x) (numeric-type-p y)) - (let* ((x (convert-member-type x)) - (y (maybe-convert-numeric-type y)) - (result (funcall derive-fcn x y same-arg))) - (maybe-convert-back-type-list result))) - ((and (numeric-type-p x) (member-type-p y)) - (let* ((x (maybe-convert-numeric-type x)) - (y (convert-member-type y)) - (result (funcall derive-fcn x y same-arg))) - (maybe-convert-back-type-list result))) - ((and (numeric-type-p x) (numeric-type-p y)) - (let* ((x (maybe-convert-numeric-type x)) - (y (maybe-convert-numeric-type y)) - (result (funcall derive-fcn x y same-arg))) - (maybe-convert-back-type-list result))) - (t - *universal-type*))) - (non-const-same-leaf-ref-p (x y) - ;; Just like same-leaf-ref-p, but we don't care if the - ;; value of the leaf is constant or not. - (declare (type continuation x y)) - (let ((x-use (continuation-use x)) - (y-use (continuation-use y))) - (and (ref-p x-use) - (ref-p y-use) - (eq (ref-leaf x-use) (ref-leaf y-use)))))) +;;; Numeric types are first converted to the negative-zero-is-not-zero +;;; conventions as expected by the deriver function. See +;;; CONVERT-NUMERIC-TYPE for the negative-zero-is-not-zero convention. +;;; +(defun two-arg-derive-type (arg1 arg2 derive-fcn fcn) + (flet + ((deriver (x y same-arg) + (cond ((and (member-type-p x) (member-type-p y)) + (let* ((x (first (member-type-members x))) + (y (first (member-type-members y))) + (result (with-float-traps-masked + (:underflow :overflow :divide-by-zero + :invalid) + (funcall fcn x y)))) + (cond ((null result)) + ((and (floatp result) (float-nan-p result)) + (make-numeric-type :class 'float + :format (type-of result) + :complexp :real)) + (t + (specifier-type `(eql ,result)))))) + ((and (member-type-p x) (numeric-type-p y)) + (let* ((x (convert-member-type x)) + (y (convert-numeric-type y)) + (result (funcall derive-fcn x y same-arg))) + (convert-back-numeric-type-list result))) + ((and (numeric-type-p x) (member-type-p y)) + (let* ((x (convert-numeric-type x)) + (y (convert-member-type y)) + (result (funcall derive-fcn x y same-arg))) + (convert-back-numeric-type-list result))) + ((and (numeric-type-p x) (numeric-type-p y)) + (let* ((x (convert-numeric-type x)) + (y (convert-numeric-type y)) + (result (funcall derive-fcn x y same-arg))) + (convert-back-numeric-type-list result))) + (t + *universal-type*))) + (non-const-same-leaf-ref-p (x y) + ;; Just like same-leaf-ref-p, but we don't care if the + ;; value of the leaf is constant or not. + (declare (type continuation x y)) + (let ((x-use (continuation-use x)) + (y-use (continuation-use y))) + (and (ref-p x-use) + (ref-p y-use) + (eq (ref-leaf x-use) (ref-leaf y-use)))))) (let ((same-arg (non-const-same-leaf-ref-p arg1 arg2)) (a1 (prepare-arg-for-derive-type (continuation-type arg1))) ----------------------------------------------------------------------- Summary of changes: src/compiler/float-tran.lisp | 2 +- src/compiler/srctran.lisp | 122 ++++++++++++++++++------------------------ 2 files changed, 54 insertions(+), 70 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-10-g0ecc7f4
by Raymond Toy 22 Feb '13

22 Feb '13

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 0ecc7f4cbf55f877f2d2fa65c31f2e6665cc68ba (commit) from 3e1b21d485864fb5f783153170c8a8365815b326 (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 0ecc7f4cbf55f877f2d2fa65c31f2e6665cc68ba Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Feb 21 20:28:37 2013 -0800 Remove :conservative-float-type from *features* and update code accordingly. diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 4b6f0ff..8f5c134 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -21,9 +21,6 @@ (in-package "C") (intl:textdomain "cmucl") -#+conservative-float-type -(sys:register-lisp-feature :conservative-float-type) - ;;; Source transform for Not, Null -- Internal ;;; ;;; Convert into an IF so that IF optimizations will eliminate redundant @@ -1253,15 +1250,12 @@ ;;; (defun two-arg-derive-type (arg1 arg2 derive-fcn fcn &optional (convert-type t)) - #-conservative-float-type - (declare (ignore fcn)) (labels ((maybe-convert-numeric-type (type) (if convert-type (convert-numeric-type type) type)) (maybe-convert-back-type-list (type) (if convert-type (convert-back-numeric-type-list type) type)) (deriver (x y same-arg) - (cond #+conservative-float-type - ((and (member-type-p x) (member-type-p y)) + (cond ((and (member-type-p x) (member-type-p y)) (let* ((x (first (member-type-members x))) (y (first (member-type-members y))) (result (with-float-traps-masked @@ -1275,12 +1269,6 @@ :complexp :real)) (t (specifier-type `(eql ,result)))))) - #-conservative-float-type - ((and (member-type-p x) (member-type-p y)) - (let* ((x (convert-member-type x)) - (y (convert-member-type y)) - (result (funcall derive-fcn x y same-arg))) - (maybe-convert-back-type-list result))) ((and (member-type-p x) (numeric-type-p y)) (let* ((x (convert-member-type x)) (y (maybe-convert-numeric-type y)) ----------------------------------------------------------------------- Summary of changes: src/compiler/srctran.lisp | 14 +------------- 1 files changed, 1 insertions(+), 13 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-9-g3e1b21d
by Raymond Toy 22 Feb '13

22 Feb '13

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 3e1b21d485864fb5f783153170c8a8365815b326 (commit) from f1e5d9fb70fa9697a66ccce443b0a338d60d05d5 (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 3e1b21d485864fb5f783153170c8a8365815b326 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Feb 21 19:26:15 2013 -0800 Remove :COMMON from *FEATURES* lispinit.lisp:: * Remove :COMMON from *FEATURES* misc.lisp:: * Remove unused defvar of *features*. diff --git a/src/code/lispinit.lisp b/src/code/lispinit.lisp index 81a6e20..d77f29a 100644 --- a/src/code/lispinit.lisp +++ b/src/code/lispinit.lisp @@ -20,7 +20,7 @@ (export '(most-positive-fixnum most-negative-fixnum sleep ++ +++ ** *** // ///)) -(defvar *features* '(:common :common-lisp :ansi-cl :ieee-floating-point :cmu) +(defvar *features* '(:common-lisp :ansi-cl :ieee-floating-point :cmu) "Holds a list of symbols that describe features provided by the implementation.") diff --git a/src/code/misc.lisp b/src/code/misc.lisp index 3942689..7c83587 100644 --- a/src/code/misc.lisp +++ b/src/code/misc.lisp @@ -133,11 +133,6 @@ string) -#+nil -(defvar *features* '(:common :common-lisp :ansi-cl :ieee-floating-point :cmu) - "Holds a list of symbols that describe features provided by the - implementation.") - ;;; Register various Lisp features #+i486 (sys:register-lisp-runtime-feature :i486) ----------------------------------------------------------------------- Summary of changes: src/code/lispinit.lisp | 2 +- src/code/misc.lisp | 5 ----- 2 files changed, 1 insertions(+), 6 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-8-gf1e5d9f
by Raymond Toy 20 Feb '13

20 Feb '13

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 f1e5d9fb70fa9697a66ccce443b0a338d60d05d5 (commit) from 3e2634dc2b7784630db92afc1fefa1cd82407356 (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 f1e5d9fb70fa9697a66ccce443b0a338d60d05d5 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Feb 19 20:25:04 2013 -0800 Remove old fast-truncate-c vops; the new ones work. diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 37fc816..ccd865c 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -528,31 +528,6 @@ (move quo eax) (move rem edx))) -#+nil -(define-vop (fast-truncate-c/unsigned=>unsigned fast-safe-arith-op) - (:translate truncate) - (:args (x :scs (unsigned-reg) :target eax)) - (:info y) - (:arg-types unsigned-num (:constant (unsigned-byte 32))) - (:temporary (:sc unsigned-reg :offset eax-offset :target quo - :from :argument :to (:result 0)) eax) - (:temporary (:sc unsigned-reg :offset edx-offset :target rem - :from :eval :to (:result 1)) edx) - (:temporary (:sc unsigned-reg :from :eval :to :result) y-arg) - (:results (quo :scs (unsigned-reg)) - (rem :scs (unsigned-reg))) - (:result-types unsigned-num unsigned-num) - (:note _N"inline (unsigned-byte 32) arithmetic") - (:vop-var vop) - (:save-p :compute-only) - (:generator 32 - (move eax x) - (inst xor edx edx) - (inst mov y-arg y) - (inst div eax y-arg) - (move quo eax) - (move rem edx))) - (define-vop (fast-truncate-c/unsigned=>unsigned fast-unsigned-binop-c) (:translate truncate) (:args (x :scs (unsigned-reg))) @@ -618,31 +593,6 @@ (move quo eax) (move rem edx))) -#+nil -(define-vop (fast-truncate-c/signed=>signed fast-safe-arith-op) - (:translate truncate) - (:args (x :scs (signed-reg) :target eax)) - (:info y) - (:arg-types signed-num (:constant (signed-byte 32))) - (:temporary (:sc signed-reg :offset eax-offset :target quo - :from :argument :to (:result 0)) eax) - (:temporary (:sc signed-reg :offset edx-offset :target rem - :from :eval :to (:result 1)) edx) - (:temporary (:sc signed-reg :from :eval :to :result) y-arg) - (:results (quo :scs (signed-reg)) - (rem :scs (signed-reg))) - (:result-types signed-num signed-num) - (:note _N"inline (signed-byte 32) arithmetic") - (:vop-var vop) - (:save-p :compute-only) - (:generator 32 - (move eax x) - (inst cdq) - (inst mov y-arg y) - (inst idiv eax y-arg) - (move quo eax) - (move rem edx))) - (define-vop (fast-truncate-c/signed=>signed fast-signed-binop-c) (:translate truncate) (:args (x :scs (signed-reg))) ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/arith.lisp | 50 ------------------------------------------- 1 files changed, 0 insertions(+), 50 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-7-g3e2634d
by Raymond Toy 20 Feb '13

20 Feb '13

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 3e2634dc2b7784630db92afc1fefa1cd82407356 (commit) from a31494bd9cb9c857903937cc2a5b310aa1184895 (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 3e2634dc2b7784630db92afc1fefa1cd82407356 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Feb 19 18:27:13 2013 -0800 Forgot to update this when x86/parms.lisp was updated with new constants. diff --git a/src/i18n/locale/cmucl-x86-vm.pot b/src/i18n/locale/cmucl-x86-vm.pot index 14dd9b1..3423da4 100644 --- a/src/i18n/locale/cmucl-x86-vm.pot +++ b/src/i18n/locale/cmucl-x86-vm.pot @@ -128,6 +128,32 @@ msgstr "" msgid "Number of bytes in a word." msgstr "" +#: src/compiler/x86/parms.lisp +msgid "Number of bits at the low end of a pointer used for type information." +msgstr "" + +#: src/compiler/x86/parms.lisp +msgid "Mask to extract the low tag bits from a pointer." +msgstr "" + +#: src/compiler/x86/parms.lisp +msgid "" +"Exclusive upper bound on the value of the low tag bits from a\n" +" pointer." +msgstr "" + +#: src/compiler/x86/parms.lisp +msgid "Number of tag bits used for a fixnum" +msgstr "" + +#: src/compiler/x86/parms.lisp +msgid "Mask to get the fixnum tag" +msgstr "" + +#: src/compiler/x86/parms.lisp +msgid "Maximum number of bits in a positive fixnum" +msgstr "" + #: src/compiler/x86/vm.lisp msgid "Redefining SC number ~D from ~S to ~S." msgstr "" @@ -308,6 +334,10 @@ msgstr "" msgid "SHIFT-TOWARDS-END" msgstr "" +#: src/compiler/x86/arith.lisp +msgid "inline right ASH" +msgstr "" + #: src/compiler/x86/c-call.lisp msgid "Too many result values from c-call." msgstr "" ----------------------------------------------------------------------- Summary of changes: src/i18n/locale/cmucl-x86-vm.pot | 30 ++++++++++++++++++++++++++++++ 1 files changed, 30 insertions(+), 0 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-6-ga31494b
by Raymond Toy 20 Feb '13

20 Feb '13

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 a31494bd9cb9c857903937cc2a5b310aa1184895 (commit) from b5237efc88c50577986563b7e8f126b95eb6a94e (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 a31494bd9cb9c857903937cc2a5b310aa1184895 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Feb 18 19:54:07 2013 -0800 Optimize shifts that are known to be right shifts. Without this, the general shift vop is used which has to test for the sign of the shift before shifting. This micro-optimization removes the test when we know the sign of the shift. diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 6739f9b..37fc816 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1713,3 +1713,115 @@ (cut-to-width integer width) 'vm::ash-left-mod32)) ) + +(in-package :x86) + +(defknown ash-right-signed ((signed-byte #.vm:word-bits) + (and fixnum unsigned-byte)) + (signed-byte #.vm:word-bits) + (movable foldable flushable)) + +(defknown ash-right-unsigned ((unsigned-byte #.vm:word-bits) + (and fixnum unsigned-byte)) + (unsigned-byte #.vm:word-bits) + (movable foldable flushable)) + +(macrolet + ((frob (trans name sc-type type shift-inst cost) + `(define-vop (,name) + (:note _N"inline right ASH") + (:translate ,trans) + (:args (number :scs (,sc-type)) + (amount :scs (signed-reg unsigned-reg immediate))) + (:arg-types ,type positive-fixnum) + (:results (result :scs (,sc-type))) + (:result-types ,type) + (:policy :fast-safe) + (:temporary (:sc unsigned-reg :offset ecx-offset) cl) + (:generator ,cost + (sc-case amount + ((signed-reg unsigned-reg) + (move cl amount) + (move result number) + (inst ,shift-inst result :cl)) + (immediate + (let ((amt (tn-value amount))) + (move result number) + (inst ,shift-inst result amt)))))))) + (frob ash-right-signed fast-ash-right/signed=>signed + signed-reg signed-num sar 4) + (frob ash-right-unsigned fast-ash-right/unsigned=>unsigned + unsigned-reg unsigned-num shr 4)) + +;; Constant right shift. +(macrolet + ((frob (trans name sc-type type shift-inst cost max-shift) + `(define-vop (,name) + (:note _N"inline right ASH") + (:translate ,trans) + (:args (number :target result :scs (,sc-type))) + (:info amount) + (:arg-types ,type + (:constant (integer 0 ,max-shift))) + (:results (result :scs (,sc-type))) + (:result-types ,type) + (:policy :fast-safe) + (:generator 4 + (cond ((zerop amount) + (move result number)) + (t + (move result number) + (inst ,shift-inst result amount))))))) + (frob ash-right-signed fast-ash-right-c/signed=>signed + signed-reg signed-num sar 1 31) + (frob ash-right-unsigned fast-ash-right-c/unsigned=>unsigned + unsigned-reg unsigned-num shr 1 31)) + +;; FIXME: The following stuff for right shifts should be moved to +;; vm-tran (or somewhere common), once we make it the same on sparc +;; and ppc. + +;; Need these so constant folding works with the deftransform. + +(defun ash-right-signed (num shift) + (declare (type (signed-byte #.vm:word-bits) num) + (type (integer 0 #.(1- vm:word-bits)) shift)) + (ash num (- shift))) + +(defun ash-right-unsigned (num shift) + (declare (type (unsigned-byte #.vm:word-bits) num) + (type (integer 0 #.(1- vm:word-bits)) shift)) + (ash num (- shift))) + +;; If we can prove that we have a right shift, just do the right shift +;; instead of calling the inline ASH which has to check for the +;; direction of the shift at run-time. +(in-package "C") + +(deftransform ash ((num shift) (integer integer)) + (let ((num-type (continuation-type num)) + (shift-type (continuation-type shift))) + ;; Can only handle right shifts + (unless (csubtypep shift-type (specifier-type '(integer * 0))) + (give-up)) + + ;; If we can prove the shift is so large that all bits are shifted + ;; out, return the appropriate constant. If the shift is small + ;; enough, call the VOP. Otherwise, check for the shift size and + ;; do the appropriate thing. (Hmm, could we just leave the IF + ;; s-expr and depend on other parts of the compiler to delete the + ;; unreachable parts, if any?) + (cond ((csubtypep num-type (specifier-type '(signed-byte #.vm:word-bits))) + ;; A right shift by 31 is the same as a right shift by + ;; larger amount. We get just the sign. + (if (csubtypep shift-type (specifier-type '(integer #.(- 1 vm:word-bits) 0))) + `(vm::ash-right-signed num (- shift)) + `(vm::ash-right-signed num (min (- shift) #.(1- vm:word-bits))))) + ((csubtypep num-type (specifier-type '(unsigned-byte #.vm:word-bits))) + (if (csubtypep shift-type (specifier-type '(integer #.(- 1 vm:word-bits) 0))) + `(vm::ash-right-unsigned num (- shift)) + `(if (<= shift #.(- vm:word-bits)) + 0 + (vm::ash-right-unsigned num (- shift))))) + (t + (give-up))))) ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/arith.lisp | 112 +++++++++++++++++++++++++++++++++++++++++++ 1 files changed, 112 insertions(+), 0 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-5-gb5237ef
by Raymond Toy 19 Feb '13

19 Feb '13

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 b5237efc88c50577986563b7e8f126b95eb6a94e (commit) from d1af0b85c857baaa7bab870b22590b7b44486a7f (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 b5237efc88c50577986563b7e8f126b95eb6a94e Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Feb 18 19:27:47 2013 -0800 Add some fixnum contants for x86, as was done for sparc. code/export.lisp:: * Export new symbols compiler/x86/parms.lisp:: * Define constants for useful the number of lowtag bits and masks and the number of fixnum tag bits and masks. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index b127c27..3e9631b 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1136,7 +1136,10 @@ "CHAR-BITS" "CHAR-BYTES" ) #+x86 - (:export "COMPATIBLE-FUNCTION-TYPES-P") + (:export "COMPATIBLE-FUNCTION-TYPES-P" + "POSITIVE-FIXNUM-BITS" + "FIXNUM-TAG-BITS" + "FIXNUM-TAG-MASK") #+sparc (:export "ALLOCATION-TRAP" "POSITIVE-FIXNUM-BITS" diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 77b04b3..6a643af 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -75,6 +75,7 @@ ;;;; Machine Architecture parameters: (export '(word-bits byte-bits char-bits word-shift word-bytes char-bytes + fixnum-tag-bits fixnum-tag-mask positive-fixnum-bits float-sign-shift single-float-bias single-float-exponent-byte @@ -119,6 +120,25 @@ (defconstant word-bytes (/ word-bits byte-bits) "Number of bytes in a word.") + +(defconstant lowtag-bits 3 + "Number of bits at the low end of a pointer used for type information.") + +(defconstant lowtag-mask (1- (ash 1 lowtag-bits)) + "Mask to extract the low tag bits from a pointer.") + +(defconstant lowtag-limit (ash 1 lowtag-bits) + "Exclusive upper bound on the value of the low tag bits from a + pointer.") + +(defconstant fixnum-tag-bits (1- lowtag-bits) + "Number of tag bits used for a fixnum") + +(defconstant fixnum-tag-mask (1- (ash 1 fixnum-tag-bits)) + "Mask to get the fixnum tag") + +(defconstant positive-fixnum-bits (- word-bits fixnum-tag-bits 1) + "Maximum number of bits in a positive fixnum") ) ; eval-when (eval-when (compile load eval) ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 5 ++++- src/compiler/x86/parms.lisp | 20 ++++++++++++++++++++ 2 files changed, 24 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-4-gd1af0b8
by Raymond Toy 19 Feb '13

19 Feb '13

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 d1af0b85c857baaa7bab870b22590b7b44486a7f (commit) from 089f104aa5fe1af71c8172a43a2330cc241479c2 (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 d1af0b85c857baaa7bab870b22590b7b44486a7f Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Feb 18 16:17:24 2013 -0800 Optimize TRUNCATE when the second arg is a compile-time constant. diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 5751abb..6739f9b 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -474,6 +474,7 @@ (inst lea quo (make-ea :dword :index eax :scale 4))) (move rem edx))) +#+nil (define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op) (:translate truncate) (:args (x :scs (any-reg) :target eax)) @@ -527,6 +528,7 @@ (move quo eax) (move rem edx))) +#+nil (define-vop (fast-truncate-c/unsigned=>unsigned fast-safe-arith-op) (:translate truncate) (:args (x :scs (unsigned-reg) :target eax)) @@ -551,6 +553,44 @@ (move quo eax) (move rem edx))) +(define-vop (fast-truncate-c/unsigned=>unsigned fast-unsigned-binop-c) + (:translate truncate) + (:args (x :scs (unsigned-reg))) + (:info y) + (:arg-types unsigned-num (:constant (integer 2 #.(1- (ash 1 vm:word-bits))))) + (:results (r :scs (unsigned-reg)) + (rem :scs (unsigned-reg))) + (:result-types unsigned-num unsigned-num) + (:note "inline (unsigned-byte 32) arithmetic") + (:temporary (:sc unsigned-reg :offset edx-offset) edx) + (:temporary (:sc unsigned-reg :offset eax-offset) eax) + (:generator 6 + (multiple-value-bind (recip shift overflowp) + (c::find-unsigned-reciprocal y vm:word-bits) + ;; q = floor(M*x/2^32) + (inst mov eax recip) + (inst mul eax x) ; edx:eax = x*recip + (cond (overflowp + ;; The case where the sum overflows. X86 has a rotate + ;; with carry instruction so use that to get the MSB of + ;; the sum and then a regular shift to get the correct + ;; number of shifts. + (inst add edx x) + (inst rcr edx 1) + (when (> shift 1) + (inst shr edx (1- shift)))) + (t + ;; The easy case + (unless (zerop shift) + (inst shr edx shift)))) + ;; Compute the remainder + (move rem x) ; Save x in case r is the same tn + (move r edx) + (move eax edx) + (inst mov edx y) + (inst mul eax edx) + (inst sub rem eax)))) + (define-vop (fast-truncate/signed=>signed fast-safe-arith-op) (:translate truncate) (:args (x :scs (signed-reg) :target eax) @@ -578,6 +618,7 @@ (move quo eax) (move rem edx))) +#+nil (define-vop (fast-truncate-c/signed=>signed fast-safe-arith-op) (:translate truncate) (:args (x :scs (signed-reg) :target eax)) @@ -602,6 +643,43 @@ (move quo eax) (move rem edx))) +(define-vop (fast-truncate-c/signed=>signed fast-signed-binop-c) + (:translate truncate) + (:args (x :scs (signed-reg))) + (:info y) + (:arg-types signed-num (:constant (integer 2 #.(1- (ash 1 vm:word-bits))))) + (:results (r :scs (signed-reg)) + (rem :scs (signed-reg))) + (:result-types signed-num signed-num) + (:note "inline (signed-byte 32) arithmetic") + (:temporary (:sc signed-reg :offset edx-offset) edx) + (:temporary (:sc signed-reg :offset eax-offset) eax) + (:generator 13 + (multiple-value-bind (recip shift) + (c::find-signed-reciprocal y vm:word-bits) + ;; Compute q = floor(M*n/2^32). That is, the high half of the + ;; product. + (inst mov eax recip) + (inst imul x) ; edx:eax = x * recip + ;; Adjust if the M is negative. + (when (minusp recip) + (inst add edx x)) + ;; Shift quotient as needed. + (unless (zerop shift) + (inst sar edx shift)) + ;; Add one to quotient if X is negative. This is done by right + ;; shifting X to give either -1 or 0. Then subtract this from + ;; the quotient. (NOTE: in the book, the sample code has this + ;; wrong and ADDS instead of SUBTRACTS.) + (move eax x) + (inst sar eax 31) + (inst sub edx eax) + + ;; Now compute the remainder. + (move rem x) + (move r edx) ; Save quotient for return + (inst imul edx y) ; edx = q * y + (inst sub rem edx)))) ;;;; Shifting diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt index e5b7331..8d14c58 100644 --- a/src/general-info/release-20e.txt +++ b/src/general-info/release-20e.txt @@ -31,7 +31,9 @@ New in this release: * The sparc port can be built using gcc once again. * The old Cheney stop-and-copy GC supported on sparc once again. However, there are no plans on supplying sparc binaries with - this GC. + this GC. + * For x86, optimize TRUNCATE when the second arg is a compile-time + constant. (Sparc and ppc already had this optimization) * ANSI compliance fixes: ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/arith.lisp | 78 ++++++++++++++++++++++++++++++++++++++ src/general-info/release-20e.txt | 4 +- 2 files changed, 81 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-2-g878cb88
by Raymond Toy 02 Feb '13

02 Feb '13

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 878cb8828beb357b9cbfdd392ceb714cc903f185 (commit) via e7999980594850508d3a0f223fd62ba230cf7857 (commit) from 9f423c672ba470c71c7d8e4164d3283e4f4b1044 (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 878cb8828beb357b9cbfdd392ceb714cc903f185 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Feb 2 10:50:45 2013 -0800 Update. diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt index c10a25c..84e4b8b 100644 --- a/src/general-info/release-20e.txt +++ b/src/general-info/release-20e.txt @@ -60,6 +60,9 @@ New in this release: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: + * In make-dist.sh, the version is now optional. If not given, a + version is derived from the git hash returned by "git + describe". This release is not binary compatible with code compiled using CMUCL 20d; you will need to recompile FASL files. commit e7999980594850508d3a0f223fd62ba230cf7857 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Feb 2 10:49:53 2013 -0800 Make the version arg optional. If the version is not specified, determine a default version based on the git hash returned by git describe. Thus, for tagged snapshot builds, the version will automatically be chosen from the tag, with "snapshot-" removed. diff --git a/bin/make-dist.sh b/bin/make-dist.sh index feb47a4..c79a06a 100755 --- a/bin/make-dist.sh +++ b/bin/make-dist.sh @@ -12,7 +12,7 @@ # $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/make-dist.sh,v 1.20 2011/04/11 16:34:49 rtoy Exp $ usage() { - echo "make-dist.sh: [-hbg] [-G group] [-O owner] [-I destdir] [-M mandir] dir version [arch os]" + echo "make-dist.sh: [-hbg] [-G group] [-O owner] [-I destdir] [-M mandir] dir [version arch os]" echo " -h This help" echo " -b Use bzip2 compression" echo " -g Use gzip compression" @@ -40,6 +40,9 @@ usage() { echo "<arch>, and <os> are given values, and <c> is gz or bz2 depending" echo "on the selected compression method." echo "" + echo "If version is not given, then a version is determined automatically" + echo "based on the result of git describe." + echo "" echo "If arch and os are not given, the script will attempt to figure an" echo "appropriate value for arch and os from the running system." echo "" @@ -100,13 +103,17 @@ do h | \?) usage; exit 1 ;; esac done - + +echo $@ shift `expr $OPTIND - 1` # Figure out the architecture and OS ARCH= OS= +# Figure out the architecture and OS +def_arch_os + if [ -n "${INSTALL_DIR}" ]; then # Doing direct installation if [ $# -lt 1 ]; then @@ -115,10 +122,20 @@ if [ -n "${INSTALL_DIR}" ]; then def_arch_os fi elif [ $# -lt 2 ]; then - usage + # Version not specified so choose a version based on the git hash. + GIT_HASH="`(cd src; git describe --dirty 2>/dev/null)`" + + if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then + VERSION=`expr "${GIT_HASH}" : "snapshot-$.*$"` + fi + + if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then + VERSION="${GIT_HASH}" + fi + + echo "Defaulting version to $VERSION" else - # Figure out the architecture and OS - def_arch_os + VERSION="$2" if [ $# -eq 3 ]; then ARCH=$3 elif [ $# -eq 4 ]; then @@ -147,9 +164,7 @@ fi TARGET="`echo $1 | sed 's:/*$::'`" -if [ -z "$INSTALL_DIR" ]; then - VERSION=$2 -else +if [ -n "$INSTALL_DIR" ]; then VERSION="today" fi ----------------------------------------------------------------------- Summary of changes: bin/make-dist.sh | 31 +++++++++++++++++++++++-------- src/general-info/release-20e.txt | 3 +++ 2 files changed, 26 insertions(+), 8 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0