[Pkg] The Trunk: Kernel-cmm.539.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jan 7 16:15:23 UTC 2011


Chris Muller uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-cmm.539.mcz

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

Name: Kernel-cmm.539
Author: cmm
Time: 4 January 2011, 2:09:42.741 pm
UUID: 7f10543e-ecae-4c34-81d7-45deda9c409c
Ancestors: Kernel-mtf.538

Revert

 Kernel-mtf.527
 Kernel-ar.528
 Kernel-ar.529
 Kernel-ul.530
 Kernel-ar.531

until compatible VM's are released.

=============== Diff against Kernel-mtf.538 ===============

Item was changed:
  Number variableWordSubclass: #Float
  	instanceVariableNames: ''
+ 	classVariableNames: 'E Epsilon Halfpi Infinity Ln10 Ln2 MaxVal MaxValLn MinValLogBase2 NaN NegativeInfinity NegativeZero Pi RadiansPerDegree Sqrt2 ThreePi Twopi'
- 	classVariableNames: 'E Epsilon Halfpi Infinity Ln10 Ln2 MaxVal MaxValLn MinValLogBase2 NaN NegativeInfinity NegativeZero Pi RadiansPerDegree SignalNaN Sqrt2 ThreePi Twopi'
  	poolDictionaries: ''
  	category: 'Kernel-Numbers'!
  
  !Float commentStamp: '<historical>' prior: 0!
  My instances represent IEEE-754 floating-point double-precision numbers.  They have about 16 digits of accuracy and their range is between plus and minus 10^307. Some valid examples are:
  	
  	8.0 13.3 0.3 2.5e6 1.27e-30 1.27e-31 -12.987654e12
  
  Mainly: no embedded blanks, little e for tens power, and a digit on both sides of the decimal point.  It is actually possible to specify a radix for Squeak Float constants.  This is great for teaching about numbers, but may be confusing to the average reader:
  
  	3r20.2 --> 6.66666666666667
  	8r20.2 --> 16.25
  
  If you don't have access to the definition of IEEE-754, you can figure out what is going on by printing various simple values in Float hex.  It may help you to know that the basic format is...
  	sign		1 bit
  	exponent	11 bits with bias of 1023 (16r3FF) to produce an exponent
  						in the range -1023 .. +1024
  				- 16r000:
  					significand = 0: Float zero
  					significand ~= 0: Denormalized number (exp = -1024, no hidden '1' bit)
  				- 16r7FF:
  					significand = 0: Infinity
  					significand ~= 0: Not A Number (NaN) representation
  	mantissa	53 bits, but only 52 are stored (20 in the first word, 32 in the second).  This is because a normalized mantissa, by definition, has a 1 to the right of its floating point, and IEEE-754 omits this redundant bit to gain an extra bit of precision instead.  People talk about the mantissa without its leading one as the FRACTION, and with its leading 1 as the SIGNFICAND.
  
  The single-precision format is...
  	sign		1 bit
  	exponent	8 bits, with bias of 127, to represent -126 to +127
                      - 0x0 and 0xFF reserved for Float zero (mantissa is ignored)
                      - 16r7F reserved for Float underflow/overflow (mantissa is ignored)
  	mantissa	24 bits, but only 23 are stored
  This format is used in FloatArray (qv), and much can be learned from the conversion routines, Float asIEEE32BitWord, and Float class fromIEEE32Bit:.
  
  Thanks to Rich Harmon for asking many questions and to Tim Olson, Bruce Cohen, Rick Zaccone and others for the answers that I have collected here.!

Item was changed:
  ----- Method: Float class>>initialize (in category 'class initialization') -----
  initialize
  	"Float initialize"
  	"Constants from Computer Approximations, pp. 182-183:
  		Pi = 3.14159265358979323846264338327950288
  		Pi/2 = 1.57079632679489661923132169163975144
  		Pi*2 = 6.28318530717958647692528676655900576
  		Pi/180 = 0.01745329251994329576923690768488612
  		2.0 ln = 0.69314718055994530941723212145817657
  		2.0 sqrt = 1.41421356237309504880168872420969808"
  
  	Pi := 3.14159265358979323846264338327950288.
  	Halfpi := Pi / 2.0.
  	Twopi := Pi * 2.0.
  	ThreePi := Pi * 3.0.
  	RadiansPerDegree := Pi / 180.0.
  
  	Ln2 := 0.69314718055994530941723212145817657.
  	Ln10 := 10.0 ln.
  	Sqrt2 := 1.41421356237309504880168872420969808.
  	E := 2.718281828459045235360287471353.
  
  	Epsilon := 0.000000000001.  "Defines precision of mathematical functions"
  
  	MaxVal := 1.7976931348623157e308.
  	MaxValLn := 709.782712893384.
  	MinValLogBase2 := -1074.
  
  	Infinity := MaxVal * MaxVal.
  	NegativeInfinity := 0.0 - Infinity.
  	NaN := Infinity - Infinity.
  	NegativeZero := 1.0 / Infinity negated.
- 
- 	SignalNaN := true.
  !

Item was removed:
- ----- Method: Float class>>signalNaN (in category 'preferences') -----
- signalNaN
- 	<preference: 'Signal NaN'
- 		category: 'general' "since there is no math/arithmetic category"
- 		description: 'When enabled, generate NaNError when encountering NaN. When disabled, silently propagate NaN'
- 		type: #Boolean>
- 	^SignalNaN!

Item was removed:
- ----- Method: Float class>>signalNaN: (in category 'preferences') -----
- signalNaN: aBool
- 	"Preference accessor"
- 	SignalNaN := aBool.
- !

Item was changed:
  ----- Method: Float>>arcCos (in category 'mathematical functions') -----
  arcCos
  	"Answer the angle in radians."
+ 
- 	<primitive: 'primitiveArcCos' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
  	^ Halfpi - self arcSin!

Item was removed:
- ----- Method: Float>>arcCosH (in category 'mathematical functions') -----
- arcCosH
- 	<primitive: 'primitiveArcCosH' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	^self primitiveFailed
- !

Item was changed:
  ----- Method: Float>>arcSin (in category 'mathematical functions') -----
  arcSin
  	"Answer the angle in radians."
+ 
- 	<primitive: 'primitiveArcSin' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
  	((self < -1.0) or: [self > 1.0]) ifTrue: [self error: 'Value out of range'].
  	((self = -1.0) or: [self = 1.0])
  		ifTrue: [^ Halfpi * self]
  		ifFalse: [^ (self / (1.0 - (self * self)) sqrt) arcTan]!

Item was removed:
- ----- Method: Float>>arcSinH (in category 'mathematical functions') -----
- arcSinH
- 	<primitive: 'primitiveArcSinH' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	^self primitiveFailed
- !

Item was changed:
  ----- Method: Float>>arcTan (in category 'mathematical functions') -----
  arcTan
  	"Answer the angle in radians.
  	 Optional. See Object documentation whatIsAPrimitive."
+ 
+ 	| theta eps step sinTheta cosTheta |
+ 	<primitive: 57>
+ 
+ 	"Newton-Raphson"
- 	<primitive: 'primitiveArcTan' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
  	self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ].
+ 
+ 	"first guess"
+ 	theta := (self * Halfpi) / (self + 1.0).
+ 
+ 	"iterate"
+ 	eps := Halfpi * Epsilon.
+ 	step := theta.
+ 	[(step * step) > eps] whileTrue: [
+ 		sinTheta := theta sin.
+ 		cosTheta := theta cos.
+ 		step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta).
+ 		theta := theta - step].
+ 	^ theta!
- 	^self primitiveArcTan!

Item was changed:
  ----- Method: Float>>arcTan: (in category 'mathematical functions') -----
  arcTan: denominator
  	"Answer the angle in radians.
  	 Optional. See Object documentation whatIsAPrimitive.
  	Implementation note: use sign in order to catch cases of negativeZero"
  
- 	<primitive: 'primitiveArcTan2' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[
- 		SignalNaN ifTrue:[ NaNError signal ].
- 		^self].
- 	denominator isNaN ifTrue:[
- 		SignalNaN ifTrue: [ NaNError signal ].
- 		^denominator ].
  	^self = 0.0
  		ifTrue: [denominator sign >= 0
  			ifTrue: [ 0 ]
  			ifFalse: [ self sign >= 0
  				ifTrue: [ Pi ]
  				ifFalse: [ Pi negated ]]]
  		ifFalse: [denominator = 0.0
  			ifTrue: [self > 0.0
  				ifTrue: [ Halfpi ]
  				ifFalse: [ Halfpi negated ]]
  			ifFalse: [denominator > 0
  				ifTrue: [ (self / denominator) arcTan ]
  				ifFalse: [self > 0
  					ifTrue: [ ((self / denominator) arcTan) + Pi ]
  					ifFalse: [ ((self / denominator) arcTan) - Pi ]]]]!

Item was removed:
- ----- Method: Float>>arcTanH (in category 'mathematical functions') -----
- arcTanH
- 	<primitive: 'primitiveArcTanH' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	^self primitiveFailed
- !

Item was changed:
  ----- Method: Float>>cos (in category 'mathematical functions') -----
  cos
  	"Answer the cosine of the receiver taken as an angle in radians."
+ 
- 	<primitive: 'primitiveCos' module: 'FloatMathPlugin'>
- 	self isFinite ifFalse:[SignalNaN ifTrue:[NaNError signal]. ^NaN].
  	^ (self + Halfpi) sin!

Item was removed:
- ----- Method: Float>>cosH (in category 'mathematical functions') -----
- cosH
- 	"Answer the cosine of the receiver taken as an angle in radians."
- 	<primitive: 'primitiveCosH' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	^self primitiveFailed
- !

Item was changed:
  ----- Method: Float>>exp (in category 'mathematical functions') -----
  exp
  	"Answer E raised to the receiver power.
  	 Optional. See Object documentation whatIsAPrimitive." 
  
+ 	| base fract correction delta div |
+ 	<primitive: 59>
+ 
+ 	"Taylor series"
+ 	"check the special cases"
+ 	self < 0.0 ifTrue: [^ (self negated exp) reciprocal].
+ 	self = 0.0 ifTrue: [^ 1].
+ 	self abs > MaxValLn ifTrue: [self error: 'exp overflow'].
+ 
+ 	"get first approximation by raising e to integer power"
+ 	base := E raisedToInteger: (self truncated).
+ 
+ 	"now compute the correction with a short Taylor series"
+ 	"fract will be 0..1, so correction will be 1..E"
+ 	"in the worst case, convergance time is logarithmic with 1/Epsilon"
+ 	fract := self fractionPart.
+ 	fract = 0.0 ifTrue: [ ^ base ].  "no correction required"
+ 
+ 	correction := 1.0 + fract.
+ 	delta := fract * fract / 2.0.
+ 	div := 2.0.
+ 	[delta > Epsilon] whileTrue: [
+ 		correction := correction + delta.
+ 		div := div + 1.0.
+ 		delta := delta * fract / div].
+ 	correction := correction + delta.
+ 	^ base * correction!
- 	<primitive: 'primitiveExp' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	"For now, fall back to the Squeak version of exp if FloatMathPlugin is absent"
- 	^self primitiveExp!

Item was changed:
  ----- Method: Float>>fractionPart (in category 'truncation and round off') -----
  fractionPart
  	"Primitive. Answer a Float whose value is the difference between the 
  	receiver and the receiver's asInteger value. Optional. See Object 
  	documentation whatIsAPrimitive."
+ 
+ 	<primitive: 52>
- 	<primitive: 'primitiveFractionalPart' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
  	^self - self truncated asFloat!

Item was removed:
- ----- Method: Float>>hypot: (in category 'mathematical functions') -----
- hypot: arg
- 	"hypot(x,y) returns sqrt(x^2+y^2) with error less  than 1 ulps"
- 	<primitive: 'primitiveHypot' module: 'FloatMathPlugin'>
- 	arg isFloat ifFalse:[^self hypot: arg asFloat].
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	arg isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^arg].
- 	^self primitiveFailed
- !

Item was changed:
  ----- Method: Float>>ln (in category 'mathematical functions') -----
  ln
  	"Answer the natural logarithm of the receiver.
  	 Optional. See Object documentation whatIsAPrimitive."
+ 
+ 	| expt n mant x div pow delta sum eps |
+ 	<primitive: 58>
+ 
+ 	"Taylor series"
+ 	self <= 0.0 ifTrue: [self error: 'ln is only defined for x > 0.0'].
+ 
+ 	"get a rough estimate from binary exponent"
+ 	expt := self exponent.
+ 	n := Ln2 * expt.
+ 	mant := self timesTwoPower: 0 - expt.
+ 
+ 	"compute fine correction from mantinssa in Taylor series"
+ 	"mant is in the range [0..2]"
+ 	"we unroll the loop to avoid use of abs"
+ 	x := mant - 1.0.
+ 	div := 1.0.
+ 	pow := delta := sum := x.
+ 	x := x negated.  "x <= 0"
+ 	eps := Epsilon * (n abs + 1.0).
+ 	[delta > eps] whileTrue: [
+ 		"pass one: delta is positive"
+ 		div := div + 1.0.
+ 		pow := pow * x.
+ 		delta := pow / div.
+ 		sum := sum + delta.
+ 		"pass two: delta is negative"
+ 		div := div + 1.0.
+ 		pow := pow * x.
+ 		delta := pow / div.
+ 		sum := sum + delta].
+ 
+ 	^ n + sum
+ 
+ 	"2.718284 ln 1.0"!
- 	<primitive: 'primitiveLogN' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	self <= 0.0 ifTrue: [^self error: 'ln is only defined for x > 0.0'].
- 	^self primitiveLn!

Item was changed:
  ----- Method: Float>>log (in category 'mathematical functions') -----
  log
  	"Answer the base 10 logarithm of the receiver."
+ 
- 	<primitive: 'primitiveLog10' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
  	^ self ln / Ln10!

Item was removed:
- ----- Method: Float>>primitiveArcTan (in category 'primitives') -----
- primitiveArcTan
- 	"Answer the angle in radians.
- 	 Optional. See Object documentation whatIsAPrimitive."
- 
- 	| theta eps step sinTheta cosTheta |
- 	<primitive: 57>
- 
- 	"Newton-Raphson"
- 	self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ].
- 
- 	"first guess"
- 	theta := (self * Halfpi) / (self + 1.0).
- 
- 	"iterate"
- 	eps := Halfpi * Epsilon.
- 	step := theta.
- 	[(step * step) > eps] whileTrue: [
- 		sinTheta := theta sin.
- 		cosTheta := theta cos.
- 		step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta).
- 		theta := theta - step].
- 	^ theta!

Item was removed:
- ----- Method: Float>>primitiveExp (in category 'primitives') -----
- primitiveExp
- 	"Answer E raised to the receiver power.
- 	 Optional. See Object documentation whatIsAPrimitive." 
- 
- 	| base fract correction delta div |
- 	<primitive: 59>
- 
- 	"Taylor series"
- 	"check the special cases"
- 	self < 0.0 ifTrue: [^ (self negated exp) reciprocal].
- 	self = 0.0 ifTrue: [^ 1].
- 	self abs > MaxValLn ifTrue: [self error: 'exp overflow'].
- 
- 	"get first approximation by raising e to integer power"
- 	base := E raisedToInteger: (self truncated).
- 
- 	"now compute the correction with a short Taylor series"
- 	"fract will be 0..1, so correction will be 1..E"
- 	"in the worst case, convergance time is logarithmic with 1/Epsilon"
- 	fract := self fractionPart.
- 	fract = 0.0 ifTrue: [ ^ base ].  "no correction required"
- 
- 	correction := 1.0 + fract.
- 	delta := fract * fract / 2.0.
- 	div := 2.0.
- 	[delta > Epsilon] whileTrue: [
- 		correction := correction + delta.
- 		div := div + 1.0.
- 		delta := delta * fract / div].
- 	correction := correction + delta.
- 	^ base * correction!

Item was removed:
- ----- Method: Float>>primitiveFractionPart (in category 'primitives') -----
- primitiveFractionPart
- 	"Primitive. Answer a Float whose value is the difference between the 
- 	receiver and the receiver's asInteger value. Optional. See Object 
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 52>
- 	^self - self truncated asFloat!

Item was removed:
- ----- Method: Float>>primitiveLn (in category 'primitives') -----
- primitiveLn
- 	"Answer the natural logarithm of the receiver.
- 	 Optional. See Object documentation whatIsAPrimitive."
- 
- 	| expt n mant x div pow delta sum eps |
- 	<primitive: 58>
- 
- 	"Taylor series"
- 	self <= 0.0 ifTrue: [self error: 'ln is only defined for x > 0.0'].
- 
- 	"get a rough estimate from binary exponent"
- 	expt := self exponent.
- 	n := Ln2 * expt.
- 	mant := self timesTwoPower: 0 - expt.
- 
- 	"compute fine correction from mantinssa in Taylor series"
- 	"mant is in the range [0..2]"
- 	"we unroll the loop to avoid use of abs"
- 	x := mant - 1.0.
- 	div := 1.0.
- 	pow := delta := sum := x.
- 	x := x negated.  "x <= 0"
- 	eps := Epsilon * (n abs + 1.0).
- 	[delta > eps] whileTrue: [
- 		"pass one: delta is positive"
- 		div := div + 1.0.
- 		pow := pow * x.
- 		delta := pow / div.
- 		sum := sum + delta.
- 		"pass two: delta is negative"
- 		div := div + 1.0.
- 		pow := pow * x.
- 		delta := pow / div.
- 		sum := sum + delta].
- 
- 	^ n + sum
- 
- 	"2.718284 ln 1.0"!

Item was removed:
- ----- Method: Float>>primitiveSin (in category 'primitives') -----
- primitiveSin
- 	"Answer the sine of the receiver taken as an angle in radians.
- 	 Optional. See Object documentation whatIsAPrimitive."
- 
- 	| sum delta self2 i |
- 	<primitive: 56>
- 
- 	"Taylor series"
- 	"normalize to the range [0..Pi/2]"
- 	self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))].
- 	self > Twopi ifTrue: [^ (self \\ Twopi) sin].
- 	self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)].
- 	self > Halfpi ifTrue: [^ (Pi - self) sin].
- 
- 	"unroll loop to avoid use of abs"
- 	sum := delta := self.
- 	self2 := 0.0 - (self * self).
- 	i := 2.0.
- 	[delta > Epsilon] whileTrue: [
- 		"once"
- 		delta := (delta * self2) / (i * (i + 1.0)).
- 		i := i + 2.0.
- 		sum := sum + delta.
- 		"twice"
- 		delta := (delta * self2) / (i * (i + 1.0)).
- 		i := i + 2.0.
- 		sum := sum + delta].
- 	^ sum!

Item was removed:
- ----- Method: Float>>primitiveSqrt (in category 'primitives') -----
- primitiveSqrt
- 	"Answer the square root of the receiver. 
- 	 Optional. See Object documentation whatIsAPrimitive."
- 	| exp guess eps delta |
- 	<primitive: 55>
- 	#Numeric.
- 	"Changed 200/01/19 For ANSI <number> support."
- 	"Newton-Raphson"
- 	self <= 0.0
- 		ifTrue: [self = 0.0
- 				ifTrue: [^ 0.0]
- 				ifFalse: ["v Chg"
- 					^ FloatingPointException signal: 'undefined if less than zero.']].
- 	"first guess is half the exponent"
- 	exp := self exponent // 2.
- 	guess := self timesTwoPower: 0 - exp.
- 	"get eps value"
- 	eps := guess * Epsilon.
- 	eps := eps * eps.
- 	delta := self - (guess * guess) / (guess * 2.0).
- 	[delta * delta > eps]
- 		whileTrue: 
- 			[guess := guess + delta.
- 			delta := self - (guess * guess) / (guess * 2.0)].
- 	^ guess!

Item was removed:
- ----- Method: Float>>primitiveTimesTwoPower: (in category 'primitives') -----
- primitiveTimesTwoPower: anInteger 
- 	"Primitive. Answer with the receiver multiplied by 2.0 raised
- 	to the power of the argument.
- 	Optional. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 54>
- 
- 	anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)].
- 	anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat].
- 	anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat].
- 	^ self * (2.0 raisedToInteger: anInteger)!

Item was changed:
  ----- Method: Float>>sin (in category 'mathematical functions') -----
  sin
  	"Answer the sine of the receiver taken as an angle in radians.
  	 Optional. See Object documentation whatIsAPrimitive."
+ 
+ 	| sum delta self2 i |
+ 	<primitive: 56>
+ 
+ 	"Taylor series"
+ 	"normalize to the range [0..Pi/2]"
+ 	self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))].
+ 	self > Twopi ifTrue: [^ (self \\ Twopi) sin].
+ 	self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)].
+ 	self > Halfpi ifTrue: [^ (Pi - self) sin].
+ 
+ 	"unroll loop to avoid use of abs"
+ 	sum := delta := self.
+ 	self2 := 0.0 - (self * self).
+ 	i := 2.0.
+ 	[delta > Epsilon] whileTrue: [
+ 		"once"
+ 		delta := (delta * self2) / (i * (i + 1.0)).
+ 		i := i + 2.0.
+ 		sum := sum + delta.
+ 		"twice"
+ 		delta := (delta * self2) / (i * (i + 1.0)).
+ 		i := i + 2.0.
+ 		sum := sum + delta].
+ 	^ sum!
- 	<primitive: 'primitiveSin' module: 'FloatMathPlugin'>
- 	self isFinite ifFalse:[SignalNaN ifTrue:[NaNError signal]. ^NaN].
- 	^self primitiveSin!

Item was removed:
- ----- Method: Float>>sinH (in category 'mathematical functions') -----
- sinH
- 	<primitive: 'primitiveSinH' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	^self primitiveFailed!

Item was changed:
  ----- Method: Float>>sqrt (in category 'mathematical functions') -----
  sqrt
  	"Answer the square root of the receiver. 
  	 Optional. See Object documentation whatIsAPrimitive."
+ 	| exp guess eps delta |
+ 	<primitive: 55>
+ 	#Numeric.
+ 	"Changed 200/01/19 For ANSI <number> support."
+ 	"Newton-Raphson"
+ 	self <= 0.0
+ 		ifTrue: [self = 0.0
+ 				ifTrue: [^ 0.0]
+ 				ifFalse: ["v Chg"
+ 					^ FloatingPointException signal: 'undefined if less than zero.']].
+ 	"first guess is half the exponent"
+ 	exp := self exponent // 2.
+ 	guess := self timesTwoPower: 0 - exp.
+ 	"get eps value"
+ 	eps := guess * Epsilon.
+ 	eps := eps * eps.
+ 	delta := self - (guess * guess) / (guess * 2.0).
+ 	[delta * delta > eps]
+ 		whileTrue: 
+ 			[guess := guess + delta.
+ 			delta := self - (guess * guess) / (guess * 2.0)].
+ 	^ guess!
- 
- 	"ar 3/26/2006: sqrt is the ONE primitive that we really don't want to use from FloatMathPlugin - it's several times slower and we use it often enough that this can make a noticable difference"
- 
- 	<primitive: 55> "instead of: <primitive: 'primitiveSqrt' module: 'FloatMathPlugin'>"
- 	^self primitiveSqrt!

Item was changed:
  ----- Method: Float>>tan (in category 'mathematical functions') -----
  tan
  	"Answer the tangent of the receiver taken as an angle in radians."
+ 
- 	<primitive: 'primitiveTan' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
  	^ self sin / self cos!

Item was removed:
- ----- Method: Float>>tanH (in category 'mathematical functions') -----
- tanH
- 	<primitive: 'primitiveTanH' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	^self primitiveFailed!

Item was changed:
  ----- Method: Float>>timesTwoPower: (in category 'mathematical functions') -----
  timesTwoPower: anInteger 
  	"Primitive. Answer with the receiver multiplied by 2.0 raised
  	to the power of the argument.
  	Optional. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 54>
+ 
+ 	anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)].
+ 	anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat].
+ 	anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat].
+ 	^ self * (2.0 raisedToInteger: anInteger)!
- 	<primitive: 'primitiveTimesTwoPower' module: 'FloatMathPlugin'>
- 	self isNaN ifTrue:[SignalNaN ifTrue:[NaNError signal]. ^self].
- 	^self primitiveTimesTwoPower: anInteger!

Item was removed:
- ----- Method: Number>>hypot: (in category 'mathematical functions') -----
- hypot: arg
- 	"hypot(x,y) returns sqrt(x^2+y^2) with error less  than 1 ulps"
- 	^self asFloat hypot: arg asFloat!



More information about the Packages mailing list