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

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

23 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 8e1b40b35592720147dac16cfef2431b43ccbe5a (commit) from 3c88c09556da4e0f797dc90beba16c76ac972c26 (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 8e1b40b35592720147dac16cfef2431b43ccbe5a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Feb 23 08:31:57 2013 -0800 Remove old stuff. * Remove support for :athlon in fp-pop. * Remove all of the enhanced pentium pro fp comparison code. Use the non ppro everywhere. diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index f8f57e6..a515e40 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -33,9 +33,7 @@ ;;; For the AMD Athlon, using ffreep fr0 is faster. ;;; (defun fp-pop () - (if (backend-featurep :athlon) - (inst ffreep fr0-tn) - (inst fstp fr0-tn))) + (inst fstp fr0-tn)) (macrolet ((ea-for-xf-desc (tn slot) @@ -1482,7 +1480,6 @@ (:conditional) (:info target not-p) (:policy :fast-safe) - (:guard (not (backend-featurep :ppro))) (:note _N"inline float comparison") (:ignore temp fr0) (:generator 3 @@ -1571,7 +1568,6 @@ (:conditional) (:info target not-p) (:policy :fast-safe) - (:guard (not (backend-featurep :ppro))) (:note _N"inline float comparison") (:ignore temp fr0) (:generator 3 @@ -1659,7 +1655,6 @@ (:conditional) (:info target not-p) (:policy :fast-safe) - (:guard (not (backend-featurep :ppro))) (:note _N"inline float comparison") (:ignore temp) (:generator 3 @@ -1768,99 +1763,6 @@ (frob = #x40)) - -;;;; Enhanced Pentium Pro floating point comparisons. - -;;; These comparisions use the faster sequences bases upon FCOMI and FUCOMI, -;;; which write to the condition codes. However, correct IEEE handling of -;;; unordered arguments requires the comparision of multiple flags which is -;;; only possible for the comparison (> ST0 operand) in which case the :b and -;;; :be tests can check that both ZF and CF are zero, or either is one -;;; respectively. For the opposite comparision (< ST0 operand), the arguments -;;; may be swapped and the > comparision used, but for equality the slower -;;; FNSTSW variation must be used. - -(define-vop (ppro-</float) - (:args (x) (y)) - (:conditional) - (:info target not-p) - (:policy :fast-safe) - (:guard (backend-featurep :ppro)) - (:note _N"inline float comparison") - (:generator 3 - ;; Handle a few special cases - (cond - ;; x is in ST0; y is in any reg. - ((zerop (tn-offset x)) - (inst fxch y) - (inst fcomi y) - (inst fxch y)) - ;; y is in ST0; x is in another reg. - ((zerop (tn-offset y)) - (inst fcomi x)) - ;; x and y are the same register, not ST0. - ((location= x y) - (inst fxch x) - (inst fcomi fr0-tn) - (inst fxch x)) - ;; x and y are different registers, neither ST0. - (t - (inst fxch y) - (inst fcomi x) - (inst fxch y))) - (inst jmp (if not-p :be :nbe) target))) - -(macrolet ((frob (type sc) - `(define-vop (,(symbolicate "PPRO-</" type) ppro-</float) - (:translate <) - (:args (x :scs (,sc)) - (y :scs (,sc))) - (:arg-types ,type ,type)))) - (frob single-float single-reg) - (frob double-float double-reg) - #+long-float (frob long-float long-reg)) - -(define-vop (ppro->/float) - (:args (x) (y)) - (:conditional) - (:info target not-p) - (:policy :fast-safe) - (:guard (backend-featurep :ppro)) - (:note _N"inline float comparison") - (:generator 3 - ;; Handle a few special cases - (cond - ;; x is in ST0; y is in any reg. - ((zerop (tn-offset x)) - (inst fcomi y)) - ;; y is in ST0; x is in another reg. - ((zerop (tn-offset y)) - (inst fxch x) - (inst fcomi x) - (inst fxch x)) - ;; x and y are the same register, not ST0. - ((location= x y) - (inst fxch x) - (inst fcomi fr0-tn) - (inst fxch x)) - ;; x and y are different registers, neither ST0. - (t - (inst fxch x) - (inst fcomi y) - (inst fxch x))) - (inst jmp (if not-p :be :nbe) target))) - -(macrolet ((frob (type sc) - `(define-vop (,(symbolicate "PPRO->/" type) ppro->/float) - (:translate >) - (:args (x :scs (,sc)) - (y :scs (,sc))) - (:arg-types ,type ,type)))) - (frob single-float single-reg) - (frob double-float double-reg) - #+long-float (frob long-float long-reg)) - - ;;;; Conversion: (macrolet ((frob (name translate to-sc to-type) ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/float.lisp | 100 +------------------------------------------ 1 files changed, 1 insertions(+), 99 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

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

23 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 3c88c09556da4e0f797dc90beba16c76ac972c26 (commit) from ba036ec2f58f8bdd49a3807e32e9f48f72afb133 (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 3c88c09556da4e0f797dc90beba16c76ac972c26 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Feb 23 08:17:19 2013 -0800 Oops. Use the pentium version of the log1p vop and remove the other one. diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index 4d2ea5e..f8f57e6 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -3290,59 +3290,6 @@ (unless (zerop (tn-offset r)) (inst fstd r)))) -(define-vop (flog1p) - (:translate %log1p) - (:args (x :scs (double-reg) :to :result)) - (:temporary (:sc double-reg :offset fr0-offset - :from :argument :to :result) fr0) - (:temporary (:sc double-reg :offset fr1-offset - :from :argument :to :result) fr1) - (:temporary (:sc word-reg :offset eax-offset :from :eval) temp) - (:results (y :scs (double-reg))) - (:arg-types double-float) - (:result-types double-float) - (:policy :fast-safe) - (:guard (not (backend-featurep :sse2))) - (:note _N"inline log1p function") - (:ignore temp) - (:generator 5 - ;; x is in a FP reg, not fr0, fr1. - (fp-pop) - (fp-pop) - (inst fldd (make-random-tn :kind :normal - :sc (sc-or-lose 'double-reg *backend*) - :offset (- (tn-offset x) 2))) - ;; Check the range - (inst push #x3e947ae1) ; Constant 0.29 - (inst fabs) - (inst fld (make-ea :dword :base esp-tn)) - (inst fcompp) - (inst add esp-tn 4) - (inst fnstsw) ; status word to ax - (inst and ah-tn #x45) - (inst jmp :z WITHIN-RANGE) - ;; Out of range for fyl2xp1. - (inst fld1) - (inst faddd (make-random-tn :kind :normal - :sc (sc-or-lose 'double-reg *backend*) - :offset (- (tn-offset x) 1))) - (inst fldln2) - (inst fxch fr1) - (inst fyl2x) - (inst jmp DONE) - - WITHIN-RANGE - (inst fldln2) - (inst fldd (make-random-tn :kind :normal - :sc (sc-or-lose 'double-reg *backend*) - :offset (- (tn-offset x) 1))) - (inst fyl2xp1) - DONE - (inst fld fr0) - (case (tn-offset y) - ((0 1)) - (t (inst fstd y))))) - ;;; The Pentium has a less restricted implementation of the fyl2xp1 ;;; instruction and a range check can be avoided. (define-vop (flog1p-pentium) ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/float.lisp | 53 ------------------------------------------- 1 files changed, 0 insertions(+), 53 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

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

23 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 ba036ec2f58f8bdd49a3807e32e9f48f72afb133 (commit) from 6e4b411893ce81fd30f053f12474c2eeb986e5fa (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 ba036ec2f58f8bdd49a3807e32e9f48f72afb133 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Feb 23 07:38:18 2013 -0800 Remove :PENTIUM from *FEATURES* code/misc.lisp:: * Don't register :PENTIUM feature. code/time.lisp:: * Replace :pentium with :x86; we assume all x86's have the rdtsc instruction. compiler/x86/float.lisp:: compiler/x86/system.lisp:: * Remove the vop guard on :pentium; assume we're always running on a pentium or better. diff --git a/src/code/misc.lisp b/src/code/misc.lisp index 50639d2..788a912 100644 --- a/src/code/misc.lisp +++ b/src/code/misc.lisp @@ -134,9 +134,6 @@ ;;; Register various Lisp features -#+pentium -(sys:register-lisp-runtime-feature :pentium) - #+sparc-v7 (sys:register-lisp-runtime-feature :sparc-v7) diff --git a/src/code/time.lisp b/src/code/time.lisp index 999610a..e6fb0c0 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -283,11 +283,12 @@ (system:get-system-info) (values user sys faults (get-bytes-consed)))) -#+(or pentium sparc-v9) +#+(or x86 sparc-v9) (defun cycle-count/float () (multiple-value-bind (lo hi) (vm::read-cycle-counter) (+ (* hi (expt 2.0d0 32)) lo))) + #+ppc (progn (alien:def-alien-variable cycles-per-tick c-call:int) @@ -300,7 +301,7 @@ (* cycles-per-tick (+ (* hi (expt 2.0d0 32)) lo)))) ) -#-(or pentium sparc-v9 ppc) +#-(or x86 sparc-v9 ppc) (defun cycle-count/float () 0.0) (defvar *time-consing* nil) diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index e4d5952..4d2ea5e 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -3302,8 +3302,7 @@ (:arg-types double-float) (:result-types double-float) (:policy :fast-safe) - (:guard (or (not (backend-featurep :pentium)) - (not (backend-featurep :sse2)))) + (:guard (not (backend-featurep :sse2))) (:note _N"inline log1p function") (:ignore temp) (:generator 5 @@ -3357,8 +3356,7 @@ (:arg-types double-float) (:result-types double-float) (:policy :fast-safe) - (:guard (and (backend-featurep :pentium) - (not (backend-featurep :sse2)))) + (:guard (and (not (backend-featurep :sse2)))) (:note _N"inline log1p with limited x range function") (:vop-var vop) (:save-p :compute-only) diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index 93519d8..71f7bb2 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -590,7 +590,6 @@ (define-vop (read-cycle-counter) (:translate read-cycle-counter) - (:guard (backend-featurep :pentium)) (:args ) (:policy :fast-safe) (:results (lo :scs (unsigned-reg)) @@ -614,7 +613,6 @@ (move hi edx) (move lo eax))) -#+pentium (defun read-cycle-counter () (read-cycle-counter)) ----------------------------------------------------------------------- Summary of changes: src/code/misc.lisp | 3 --- src/code/time.lisp | 5 +++-- src/compiler/x86/float.lisp | 6 ++---- src/compiler/x86/system.lisp | 2 -- 4 files changed, 5 insertions(+), 11 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-13-g6e4b411
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 6e4b411893ce81fd30f053f12474c2eeb986e5fa (commit) from 6a9fd11d55bd794a02ec3686f3811d794aa8ac6d (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 6e4b411893ce81fd30f053f12474c2eeb986e5fa Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Feb 21 22:21:10 2013 -0800 Remove the :i486 feature. code/misc.lisp:: * Remove :i486 from *features* code/multi-proc.lisp:: * Change :i486 to :x86 on the off chance that multi-proc will be ported to other archs. compiler/x86/cell.lisp:: compiler/x86/macros.lisp:: compiler/x86/memory.lisp:: * Remove guard on backend-featurep :i486 since we got rid of :i486 and have it always enabled now. diff --git a/src/code/misc.lisp b/src/code/misc.lisp index 7c83587..50639d2 100644 --- a/src/code/misc.lisp +++ b/src/code/misc.lisp @@ -134,9 +134,6 @@ ;;; Register various Lisp features -#+i486 -(sys:register-lisp-runtime-feature :i486) - #+pentium (sys:register-lisp-runtime-feature :pentium) diff --git a/src/code/multi-proc.lisp b/src/code/multi-proc.lisp index 2aed7a3..8b2df04 100644 --- a/src/code/multi-proc.lisp +++ b/src/code/multi-proc.lisp @@ -1886,10 +1886,10 @@ (process-wait whostate #'(lambda () (declare (optimize (speed 3))) - #-i486 + #-x86 (unless (lock-process lock) (setf (lock-process lock) *current-process*)) - #+i486 + #+x86 (null (kernel:%instance-set-conditional lock 2 nil *current-process*))))) @@ -1904,10 +1904,10 @@ whostate timeout #'(lambda () (declare (optimize (speed 3))) - #-i486 + #-x86 (unless (lock-process lock) (setf (lock-process lock) *current-process*)) - #+i486 + #+x86 (null (kernel:%instance-set-conditional lock 2 nil *current-process*))))) @@ -1915,7 +1915,7 @@ ;;; ;;; Atomically seize a lock if it's free. ;;; -#-i486 +#-x86 (defun seize-lock (lock) (declare (type lock lock) (optimize (speed 3))) @@ -1943,9 +1943,9 @@ (when (and (error-check-lock-p ,lock) ,have-lock) (error "Dead lock")) (when (or ,have-lock - #+i486 (null (kernel:%instance-set-conditional + #+x86 (null (kernel:%instance-set-conditional ,lock 2 nil *current-process*)) - #-i486 (seize-lock ,lock) + #-x86 (seize-lock ,lock) (if ,timeout (lock-wait-with-timeout ,lock ,whostate ,timeout) @@ -1956,19 +1956,19 @@ (when (and (error-check-lock-p ,lock) ,have-lock) (error "Dead lock")) (unless (or ,have-lock - #+i486 (null (kernel:%instance-set-conditional + #+x86 (null (kernel:%instance-set-conditional ,lock 2 nil *current-process*)) - #-i486 (seize-lock ,lock)) + #-x86 (seize-lock ,lock)) (lock-wait ,lock ,whostate)) ,@body)) (t `(when (or (and (recursive-lock-p ,lock) ,have-lock) - #+i486 (null (kernel:%instance-set-conditional + #+x86 (null (kernel:%instance-set-conditional ,lock 2 nil *current-process*)) - #-i486 (seize-lock ,lock)) + #-x86 (seize-lock ,lock)) ,@body))) (unless ,have-lock - #+i486 (kernel:%instance-set-conditional + #+x86 (kernel:%instance-set-conditional ,lock 2 *current-process* nil) - #-i486 (when (eq (lock-process ,lock) *current-process*) + #-x86 (when (eq (lock-process ,lock) *current-process*) (setf (lock-process ,lock) nil))))))) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 2487149..9283a78 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -383,7 +383,6 @@ (:temporary (:sc descriptor-reg :offset eax-offset :from (:argument 2) :to :result :target result) eax) (:results (result :scs (descriptor-reg any-reg))) - (:guard (backend-featurep :i486)) (:policy :fast-safe) (:generator 5 (move eax old-value) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index ca2c267..d4659c2 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -517,7 +517,6 @@ :from (:argument 2) :to :result :target result) eax) (:results (result :scs ,scs)) (:result-types ,el-type) - (:guard (backend-featurep :i486)) (:generator 5 (move eax old-value) (inst cmpxchg (make-ea :dword :base object :index index :scale 1 @@ -537,7 +536,6 @@ :from (:argument 1) :to :result :target result) eax) (:results (result :scs ,scs)) (:result-types ,el-type) - (:guard (backend-featurep :i486)) (:generator 4 (move eax old-value) (inst cmpxchg (make-ea :dword :base object diff --git a/src/compiler/x86/memory.lisp b/src/compiler/x86/memory.lisp index 18d5f37..7fc1a10 100644 --- a/src/compiler/x86/memory.lisp +++ b/src/compiler/x86/memory.lisp @@ -93,7 +93,6 @@ :from (:argument 1) :to :result :target result) eax) (:variant-vars offset lowtag) (:results (result :scs (descriptor-reg any-reg))) - (:guard (backend-featurep :i486)) (:generator 4 (move eax old-value) (inst cmpxchg (make-ea :dword :base object @@ -163,7 +162,6 @@ (:variant-vars base lowtag) (:results (result :scs (descriptor-reg any-reg))) (:info offset) - (:guard (backend-featurep :i486)) (:generator 4 (move eax old-value) (inst cmpxchg (make-ea :dword :base object ----------------------------------------------------------------------- Summary of changes: src/code/misc.lisp | 3 --- src/code/multi-proc.lisp | 26 +++++++++++++------------- src/compiler/x86/cell.lisp | 1 - src/compiler/x86/macros.lisp | 2 -- src/compiler/x86/memory.lisp | 2 -- 5 files changed, 13 insertions(+), 21 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[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