[Openmcl-cvs-notifications] r13535 - in /release/1.4/source: ./ compiler/ level-0/PPC/ppc-numbers.lisp level-0/X86/ level-0/X86/X8632/x8632-numbers.lisp level-0/X86/x86-numbers.lisp level-0/l0-numbers.lisp level-1/l1-init.lisp lisp-kernel/ scripts/
rme at clozure.com
rme at clozure.com
Tue Mar 16 19:33:28 UTC 2010
Author: rme
Date: Tue Mar 16 13:33:28 2010
New Revision: 13535
Log:
Merge r13529 through r13532 (special-case divisor of -1 in %fixnum-truncate)
from trunk to 1.4 branch. Fixes ticket:666.
Modified:
release/1.4/source/ (props changed)
release/1.4/source/compiler/ (props changed)
release/1.4/source/level-0/PPC/ppc-numbers.lisp
release/1.4/source/level-0/X86/ (props changed)
release/1.4/source/level-0/X86/X8632/x8632-numbers.lisp
release/1.4/source/level-0/X86/x86-numbers.lisp
release/1.4/source/level-0/l0-numbers.lisp
release/1.4/source/level-1/l1-init.lisp
release/1.4/source/lisp-kernel/ (props changed)
release/1.4/source/scripts/ (props changed)
Propchange: release/1.4/source/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Tue Mar 16 13:33:28 2010
@@ -1,1 +1,1 @@
-/trunk/source:13414-13415,13488
+/trunk/source:13414-13415,13488,13529-13532
Propchange: release/1.4/source/compiler/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Tue Mar 16 13:33:28 2010
@@ -1,1 +1,1 @@
-/trunk/source/compiler:13221,13414-13415,13488
+/trunk/source/compiler:13221,13414-13415,13488,13529-13532
Modified: release/1.4/source/level-0/PPC/ppc-numbers.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/level-0/PPC/ppc-numbers.lisp (original)
+++ release/1.4/source/level-0/PPC/ppc-numbers.lisp Tue Mar 16 13:33:28 2010
@@ -206,7 +206,8 @@
=
=
=
-;;;; maybe this could be smarter but frankly scarlett I dont give a damn
+;;; maybe this could be smarter but frankly scarlett I dont give a damn
+;;; ticket:666 describes one reason to give a damn.
#+ppc32-target
(defppclapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
(let ((unboxed-quotient imm0)
@@ -216,8 +217,10 @@
(product temp0)
(boxed-quotient temp1)
(remainder temp2))
+ (cmpwi divisor '-1) =
(unbox-fixnum unboxed-dividend dividend)
(unbox-fixnum unboxed-divisor divisor)
+ (beq @neg)
(divwo. unboxed-quotient unboxed-dividend unboxed-divisor) ; =
set OV if divisor =3D 0
(box-fixnum boxed-quotient unboxed-quotient)
(mullw unboxed-product unboxed-quotient unboxed-divisor)
@@ -235,6 +238,18 @@
(vpush remainder)
(set-nargs 2)
(la temp0 8 vsp)
+ (ba .SPvalues)
+ @neg
+ (nego. dividend dividend)
+ (lwz arg_z '*least-positive-bignum* nfn)
+ (bns @ret)
+ (mtxer rzero)
+ (lwz dividend ppc32::symbol.vcell arg_z)
+ @ret
+ (mr temp0 vsp)
+ (vpush dividend)
+ (vpush rzero)
+ (set-nargs 2)
(ba .SPvalues)))
=
#+ppc64-target
@@ -246,8 +261,10 @@
(product temp0)
(boxed-quotient temp1)
(remainder temp2))
+ (cmpdi divisor '-1)
(unbox-fixnum unboxed-dividend dividend)
(unbox-fixnum unboxed-divisor divisor)
+ (beq @neg)
(divdo. unboxed-quotient unboxed-dividend unboxed-divisor) ; =
set OV if divisor =3D 0
(box-fixnum boxed-quotient unboxed-quotient)
(mulld unboxed-product unboxed-quotient unboxed-divisor)
@@ -265,7 +282,20 @@
(vpush remainder)
(set-nargs 2)
(la temp0 '2 vsp)
- (ba .SPvalues)))
+ (ba .SPvalues)
+ @neg
+ (nego. dividend dividend)
+ (ld arg_z '*least-positive-bignum* nfn)
+ (bns @ret)
+ (mtxer rzero)
+ (ld dividend ppc64::symbol.vcell arg_z)
+ @ret
+ (mr temp0 vsp)
+ (vpush dividend)
+ (vpush rzero)
+ (set-nargs 2)
+ (ba .SPvalues) =
+ ))
=
=
(defppclapfunction called-for-mv-p ()
Propchange: release/1.4/source/level-0/X86/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Tue Mar 16 13:33:28 2010
@@ -1,1 +1,1 @@
-/trunk/source/level-0/X86:13371,13414-13415,13488
+/trunk/source/level-0/X86:13371,13414-13415,13488,13529-13532
Modified: release/1.4/source/level-0/X86/X8632/x8632-numbers.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/level-0/X86/X8632/x8632-numbers.lisp (original)
+++ release/1.4/source/level-0/X86/X8632/x8632-numbers.lisp Tue Mar 16 13:3=
3:28 2010
@@ -113,8 +113,12 @@
(box-fixnum imm0 arg_z) =
(single-value-return))
=
+
+
;;; We'll get a SIGFPE if divisor is 0.
(defx8632lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
+ (cmpl ($ '-1) (% divisor))
+ (je @neg)
(mark-as-imm temp0)
(mark-as-imm temp1)
(let ((imm2 temp0)
@@ -130,6 +134,15 @@
(movl (% esp) (% temp0))
(push (% arg_z))
(push (% arg_y))
+ (set-nargs 2)
+ (jmp-subprim .SPvalues)
+ @neg
+ (negl (% dividend))
+ (load-constant *least-positive-bignum* arg_z)
+ (cmovol (@ x8632::symbol.vcell (% arg_z)) (% dividend))
+ (movl (% esp) (% temp0))
+ (pushl (% dividend))
+ (pushl ($ 0))
(set-nargs 2)
(jmp-subprim .SPvalues))
=
Modified: release/1.4/source/level-0/X86/x86-numbers.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/level-0/X86/x86-numbers.lisp (original)
+++ release/1.4/source/level-0/X86/x86-numbers.lisp Tue Mar 16 13:33:28 2010
@@ -111,11 +111,14 @@
(single-value-return))
=
=
+
;;; We'll get a SIGFPE if divisor is 0.
;;; Don't use %rbp. Trust callback_for_interrupt() to preserve
;;; the word below the stack pointer
(defx86lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
(save-simple-frame)
+ (cmpq ($ '-1) (% divisor))
+ (je @neg)
(unbox-fixnum divisor imm0)
(movq (% imm0) (% imm2))
(unbox-fixnum dividend imm0)
@@ -128,7 +131,18 @@
(pushq (% arg_z))
(pushq (% arg_y))
(set-nargs 2)
+ (jmp-subprim .SPvalues)
+ @neg
+ (negq (% dividend))
+ (load-constant *least-positive-bignum* arg_z)
+ (cmovoq (@ x8664::symbol.vcell (% arg_z)) (% dividend))
+ (pop (% rbp))
+ (movq (% rsp) (% temp0))
+ (pushq (% dividend))
+ (pushq ($ 0))
+ (set-nargs 2)
(jmp-subprim .SPvalues))
+ =
=
(defx86lapfunction called-for-mv-p ()
(ref-global ret1valaddr imm0)
Modified: release/1.4/source/level-0/l0-numbers.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/level-0/l0-numbers.lisp (original)
+++ release/1.4/source/level-0/l0-numbers.lisp Tue Mar 16 13:33:28 2010
@@ -1139,11 +1139,11 @@
(truncate-rat-sfloat (number divisor)
#+32-bit-target
`(target::with-stack-short-floats ((fnum ,number)
- (f2))
+ (f2))
(let ((res (%unary-truncate (%short-float/-2! fnum ,divisor f2)=
)))
(values res =
(%short-float--2 fnum (%short-float*-2! (%short-float=
res f2) ,divisor f2)))))
- #+64-bit-target
+ #+64-bit-target
`(let* ((temp (%short-float ,number))
(res (%unary-truncate (/ (the short-float temp)
(the short-float ,divisor)))))
@@ -1151,25 +1151,17 @@
(- (the short-float temp)
(the short-float (* (the short-float (%short-float res))
(the short-float ,divisor)))))))
- )
+ )
(number-case number
(fixnum
- (if (eql number target::target-most-negative-fixnum)
- (if (zerop divisor)
- (error 'division-by-zero :operation 'truncate :operands (list n=
umber divisor))
- (with-small-bignum-buffers ((bn number))
- (multiple-value-bind (quo rem) (truncate bn divisor)
- (if (eq quo bn)
- (values number rem)
- (values quo rem)))))
- (number-case divisor
- (fixnum (if (eq divisor 1) (values number 0) (%fixnum-truncate =
number divisor)))
- (bignum (values 0 number))
- (double-float (truncate-rat-dfloat number divisor))
- (short-float (truncate-rat-sfloat number divisor))
- (ratio (let ((q (truncate (* number (%denominator divisor)) ; t=
his was wrong
- (%numerator divisor))))
- (values q (- number (* q divisor))))))))
+ (number-case divisor
+ (fixnum (if (eq divisor 1) (values number 0) (%fixnum-truncate nu=
mber divisor)))
+ (bignum (values 0 number))
+ (double-float (truncate-rat-dfloat number divisor))
+ (short-float (truncate-rat-sfloat number divisor))
+ (ratio (let ((q (truncate (* number (%denominator divisor)) ; thi=
s was wrong
+ (%numerator divisor))))
+ (values q (- number (* q divisor)))))))
(bignum (number-case divisor
(fixnum (if (eq divisor 1) (values number 0)
(if (eq divisor target::target-most-negative-fix=
num);; << aargh
@@ -1198,14 +1190,14 @@
(let ((res (%unary-truncate
(/ (the short-float number)
(the short-float divisor)))))
- (values res
- (- (the short-float number)
- (* (the short-float (%short-float r=
es))
- (the short-float divisor))))))
+ (values res
+ (- (the short-float number)
+ (* (the short-float (%short-float res=
))
+ (the short-float divisor))))))
((fixnum bignum ratio)
#+32-bit-target
(target::with-stack-short-floats ((fdiv divisor)
- (f2))
+ (f2))
(let ((res (%unary-truncate (%short-float/-2! nu=
mber fdiv f2))))
(values res =
(%short-float--2 =
Modified: release/1.4/source/level-1/l1-init.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/level-1/l1-init.lisp (original)
+++ release/1.4/source/level-1/l1-init.lisp Tue Mar 16 13:33:28 2010
@@ -160,6 +160,9 @@
(defconstant most-negative-fixnum target::target-most-negative-fixnum
"the fixnum closest in value to negative infinity")
=
+(defstatic *least-positive-bignum* (1+ target::target-most-positive-fixnum)
+ "used internally; value should be treated as a constant")
+
=
(defconstant lambda-list-keywords =
'(&OPTIONAL &REST &AUX &KEY &ALLOW-OTHER-KEYS &BODY &ENVIRONMENT &WHOLE)
Propchange: release/1.4/source/lisp-kernel/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Tue Mar 16 13:33:28 2010
@@ -1,1 +1,1 @@
-/trunk/source/lisp-kernel:13230,13414-13415,13488
+/trunk/source/lisp-kernel:13230,13414-13415,13488,13529-13532
Propchange: release/1.4/source/scripts/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Tue Mar 16 13:33:28 2010
@@ -1,1 +1,1 @@
-/trunk/source/scripts:13416,13488
+/trunk/source/scripts:13416,13488,13529-13532
More information about the Openmcl-cvs-notifications
mailing list