[Pkg] The Trunk: Kernel-nice.445.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Apr 20 22:01:23 UTC 2010


Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.445.mcz

==================== Summary ====================

Name: Kernel-nice.445
Author: nice
Time: 21 April 2010, 12:00:42.462 am
UUID: 89933404-89fd-4dc7-838f-67300383b0b1
Ancestors: Kernel-ul.444

1) Avoid overflow when (1.7976931348623157e308 printStringBase: 16.) - http://bugs.squeak.org/view.php?id=3493.
2) cosmetic: use #bitShift:  because faster than #<< #>> and remove unecessary temps from #absPrintExactlyOn:base:

=============== Diff against Kernel-ul.444 ===============

Item was changed:
  ----- Method: Float>>absPrintExactlyOn:base: (in category 'printing') -----
  absPrintExactlyOn: aStream base: base
  	"Print my value on a stream in the given base.  Assumes that my value is strictly
  	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
  	Based upon the algorithm outlined in:
  	Robert G. Burger and R. Kent Dybvig
  	Printing Floating Point Numbers Quickly and Accurately
  	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
  	June 1996.
  	This version guarantees that the printed representation exactly represents my value
  	by using exact integer arithmetic."
  
+ 	| significand exp baseExpEstimate r s mPlus mMinus scale roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit shead |
- 	| fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit shead |
  	self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
- 	fBase := base asFloat.
  	significand := self significandAsInteger.
  	roundingIncludesLimits := significand even.
  	exp := (self exponent - 52) max: MinValLogBase2.
+ 	baseExpEstimate := (self exponent * base asFloat reciprocalLogBase2 - 1.0e-10) ceiling.
- 	baseExpEstimate := (self exponent * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
  	exp >= 0
  		ifTrue:
+ 			[significand ~= 16r10000000000000
- 			[be := 1 << exp.
- 			significand ~= 16r10000000000000
  				ifTrue:
+ 					[r := significand bitShift: 1 + exp.
- 					[r := significand * be * 2.
  					s := 2.
+ 					mPlus := mMinus := 1 bitShift: exp]
- 					mPlus := be.
- 					mMinus := be]
  				ifFalse:
+ 					[r := significand bitShift: 2 + exp.
- 					[be1 := be * 2.
- 					r := significand * be1 * 2.
  					s := 4.
+ 					mPlus := 2 * (mMinus := 1 bitShift: exp)]]
- 					mPlus := be1.
- 					mMinus := be]]
  		ifFalse:
  			[(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])
  				ifTrue:
+ 					[r := significand bitShift: 1.
+ 					s := 1 bitShift: 1 - exp.
+ 					mPlus := mMinus := 1]
- 					[r := significand * 2.
- 					s := (1 << (exp negated)) * 2.
- 					mPlus := 1.
- 					mMinus := 1]
  				ifFalse:
+ 					[r := significand bitShift: 2.
+ 					s := 1 bitShift: 2 - exp.
- 					[r := significand * 4.
- 					s := (1 << (exp negated + 1)) * 2.
  					mPlus := 2.
  					mMinus := 1]].
  	baseExpEstimate >= 0
  		ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]
  		ifFalse:
  			[scale := base raisedToInteger: baseExpEstimate negated.
  			r := r * scale.
  			mPlus := mPlus * scale.
  			mMinus := mMinus * scale].
  	((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]])
  		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
  		ifFalse:
  			[r := r * base.
  			mPlus := mPlus * base.
  			mMinus := mMinus * base].
  	(fixedFormat := baseExpEstimate between: -3 and: 6)
  		ifTrue:
  			[decPointCount := baseExpEstimate.
  			baseExpEstimate <= 0
  				ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
  		ifFalse:
  			[decPointCount := 1].
+ 	slowbit := 1 - s lowBit .
+ 	shead := s bitShift: slowbit.
+ 	[d := (r bitShift: slowbit) // shead.
+ 	r := r - (d * s).
- 	slowbit := s lowBit - 1.
- 	shead := s >> slowbit.
- 	[d := (r >> slowbit) // shead.
- 	r := r - (d*s).
  	(tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r < mMinus]]) |
  	(tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]])] whileFalse:
  		[aStream nextPut: (Character digitValue: d).
  		r := r * base.
  		mPlus := mPlus * base.
  		mMinus := mMinus * base.
  		decPointCount := decPointCount - 1.
  		decPointCount = 0 ifTrue: [aStream nextPut: $.]].
  	tc2 ifTrue:
+ 		[(tc1 not or: [r * 2 >= s]) ifTrue: [d := d + 1]].
- 		[(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].
  	aStream nextPut: (Character digitValue: d).
  	decPointCount > 0
  		ifTrue:
  		[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
  		aStream nextPutAll: '.0'].
  	fixedFormat ifFalse:
  		[aStream nextPut: $e.
  		aStream nextPutAll: (baseExpEstimate - 1) printString]!

Item was changed:
  ----- Method: Float>>absPrintOn:base: (in category 'printing') -----
  absPrintOn: aStream base: base
  	"Print my value on a stream in the given base.  Assumes that my value is strictly
  	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
  	Based upon the algorithm outlined in:
  	Robert G. Burger and R. Kent Dybvig
  	Printing Floating Point Numbers Quickly and Accurately
  	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
  	June 1996.
  	This version performs all calculations with Floats instead of LargeIntegers, and loses
  	about 3 lsbs of accuracy compared to an exact conversion."
  
  	| significantBits fBase exp baseExpEstimate r s mPlus mMinus scale d tc1 tc2 fixedFormat decPointCount |
  	self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
  	significantBits := 50.  "approximately 3 lsb's of accuracy loss during conversion"
  	fBase := base asFloat.
  	exp := self exponent.
  	baseExpEstimate := (exp * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
  	exp >= 0
  		ifTrue:
  			[r := self.
  			s := 1.0.
  			mPlus := 1.0 timesTwoPower: exp - significantBits.
  			mMinus := self significand ~= 1.0 ifTrue: [mPlus] ifFalse: [mPlus / 2.0]]
  		ifFalse:
  			[r := self timesTwoPower: significantBits.
  			s := 1.0 timesTwoPower:  significantBits.
  			mMinus := 1.0 timesTwoPower: (exp max: -1024).
  			mPlus :=
  				(exp = MinValLogBase2) | (self significand ~= 1.0)
  					ifTrue: [mMinus]
  					ifFalse: [mMinus * 2.0]].
  	baseExpEstimate >= 0
  		ifTrue:
+ 			[exp = 1023
- 			[s := s * (fBase raisedToInteger: baseExpEstimate).
- 			exp = 1023
  				ifTrue:   "scale down to prevent overflow to Infinity during conversion"
  					[r := r / fBase.
+ 					s := s * (fBase raisedToInteger: baseExpEstimate - 1).
- 					s := s / fBase.
  					mPlus := mPlus / fBase.
+ 					mMinus := mMinus / fBase]
+ 				ifFalse:
+ 					[s := s * (fBase raisedToInteger: baseExpEstimate)]]
- 					mMinus := mMinus / fBase]]
  		ifFalse:
  			[exp < -1023
  				ifTrue:   "scale up to prevent denorm reciprocals overflowing to Infinity"
  					[d := (53 * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
  					scale := fBase raisedToInteger: d.
  					r := r * scale.
  					mPlus := mPlus * scale.
  					mMinus := mMinus * scale.
  					scale := fBase raisedToInteger: (baseExpEstimate + d) negated]
  				ifFalse:
  				[scale := fBase raisedToInteger: baseExpEstimate negated].
  			s := s / scale].
  	(r + mPlus >= s)
  		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
  		ifFalse:
  			[s := s / fBase].
  	(fixedFormat := baseExpEstimate between: -3 and: 6)
  		ifTrue:
  			[decPointCount := baseExpEstimate.
  			baseExpEstimate <= 0
  				ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
  		ifFalse:
  			[decPointCount := 1].
  	[d := (r / s) truncated.
  	r := r - (d * s).
  	(tc1 := r <= mMinus) | (tc2 := r + mPlus >= s)] whileFalse:
  		[aStream nextPut: (Character digitValue: d).
  		r := r * fBase.
  		mPlus := mPlus * fBase.
  		mMinus := mMinus * fBase.
  		decPointCount := decPointCount - 1.
  		decPointCount = 0 ifTrue: [aStream nextPut: $.]].
  	tc2 ifTrue:
  		[tc1 not | (tc1 & (r*2.0 >= s)) ifTrue: [d := d + 1]].
  	aStream nextPut: (Character digitValue: d).
  	decPointCount > 0
  		ifTrue:
  		[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
  		aStream nextPutAll: '.0'].
  	fixedFormat ifFalse:
  		[aStream nextPut: $e.
  		aStream nextPutAll: (baseExpEstimate - 1) printString]!



More information about the Packages mailing list