[squeak-dev] The Trunk: Kernel-nice.272.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Oct 19 12:39:30 UTC 2009


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

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

Name: Kernel-nice.272
Author: nice
Time: 19 October 2009, 2:39:18 am
UUID: 6ad59bb1-c97b-ad4f-aa05-ae19f0921ca5
Ancestors: Kernel-ar.271

How to gain a factor x2 on speed of 
String streamContents: [:strm | Float pi absPrintExactlyOn: strm base: 10]

1) do not use d := r // s.  r := r \\ s. This will evaluate the quotient twice.
2) s generally has a lot of trailing bits = 0, so it is faster to evaluate:
d := (r >> (s lowBit - 1)) // (s >> (s lowBit - 1)).
especially s lowBit - 1 and (s >> (s lowBit - 1)) can go outside the while loop
3) revert the tests in tc1 and tc2: these tests are false but for the last digit.
Since Float usually have more than 2 digits, it is statistically faster to test for the false condition first.
4) use and: or: when due instead of & |


=============== Diff against Kernel-ar.271 ===============

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."
  
+ 	| fBase significand exp baseExpEstimate be be1 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 |
  	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 * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
  	exp >= 0
  		ifTrue:
  			[be := 1 << exp.
  			significand ~= 16r10000000000000
  				ifTrue:
  					[r := significand * be * 2.
  					s := 2.
  					mPlus := be.
  					mMinus := be]
  				ifFalse:
  					[be1 := be * 2.
  					r := significand * be1 * 2.
  					s := 4.
  					mPlus := be1.
  					mMinus := be]]
  		ifFalse:
+ 			[(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])
- 			[(exp = MinValLogBase2) | (significand ~= 16r10000000000000)
  				ifTrue:
  					[r := significand * 2.
  					s := (1 << (exp negated)) * 2.
  					mPlus := 1.
  					mMinus := 1]
  				ifFalse:
  					[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]])
- 	(r + mPlus > s) | (roundingIncludesLimits & (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 := 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:
- 			[decPointCount := 1]. 
- 	[d := r // s.
- 	r := r \\ s.
- 	(tc1 := (r < mMinus) | (roundingIncludesLimits & (r = mMinus))) |
- 	(tc2 := (r + mPlus > s) | (roundingIncludesLimits & (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 | (tc1 & (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]!




More information about the Squeak-dev mailing list