cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

Start a nNew thread

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

23 Feb '13

1 0

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

23 Feb '13

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

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

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

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

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

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

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs