Object subclass: #DhbDecimalFloatingNumber
    instanceVariableNames: 'mantissa exponent '
    classVariableNames: 'Digits '
    poolDictionaries: ''!

Object subclass: #DhbFloatingPointMachine
    instanceVariableNames: 'defaultNumericalPrecision radix machinePrecision negativeMachinePrecision smallestNumber largestNumber smallNumber largestExponentArgument '
    classVariableNames: 'UniqueInstance '
    poolDictionaries: ''!

SubApplication subclass: #DhbNumericalPrecision
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''!



!DhbDecimalFloatingNumber class publicMethods !

new: aNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^self new normalize: aNumber! !

!DhbDecimalFloatingNumber class privateMethods !

defaultDigits
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^15!

defaultDigits: anInteger
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	Digits := anInteger.!

digits
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	Digits isNil
		ifTrue: [ Digits := self defaultDigits].
	^Digits!

resetDigits
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	Digits := nil.! !

!DhbDecimalFloatingNumber publicMethods !

* aNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^self class new: ( self value * aNumber value)!

+ aNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^self class new: ( self value + aNumber value)!

- aNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^self class new: ( self value - aNumber value)!

/ aNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^self class new: ( self value / aNumber value)!

printOn: aStream
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	mantissa printOn: aStream.
	aStream nextPutAll: 'xE'.
	exponent negated printOn: aStream.!

sqrt
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^self class new:  self value sqrt!

value
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	^mantissa / ( 10 raisedToInteger: exponent)! !

!DhbDecimalFloatingNumber privateMethods !

normalize: aNumber
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 9/6/99 "
	exponent := (self class digits - (aNumber log: 10)) floor.
	mantissa := ( aNumber * ( 10 raisedToInteger: exponent)) truncated.
	^self
	! !

!DhbFloatingPointMachine class publicMethods !

new
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	UniqueInstance = nil
		ifTrue: [ UniqueInstance := super new].
	^UniqueInstance!

reset
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	UniqueInstance := nil.! !

!DhbFloatingPointMachine publicMethods !

defaultNumericalPrecision
		"
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 22/4/99 "
	defaultNumericalPrecision isNil
		ifTrue: [ defaultNumericalPrecision := self machinePrecision sqrt].
	^defaultNumericalPrecision!

largestExponentArgument
		"(c) Copyrights Didier BESSET, 2000, all rights reserved.
		 Initial code: 1/18/00 "
	largestExponentArgument isNil
		ifTrue: [ largestExponentArgument := self largestNumber ln].
	^largestExponentArgument!

largestNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 5/5/99 "
	largestNumber isNil
		ifTrue: [ self computeLargestNumber].
	^largestNumber!

machinePrecision
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 22/4/99 "
	machinePrecision isNil
		ifTrue: [ self computeMachinePrecision].
	^machinePrecision!

negativeMachinePrecision
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 22/4/99 "
	negativeMachinePrecision isNil
		ifTrue: [ self computeNegativeMachinePrecision].
	^negativeMachinePrecision!

radix
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	radix isNil
		ifTrue: [ self computeRadix].
	^radix!

showParameters
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 10/6/99 "
	Transcript cr; cr;
			nextPutAll: 'Floating-point machine parameters'; cr;
			nextPutAll: '---------------------------------';cr;
			nextPutAll: 'Radix: '.
	self radix printOn: Transcript.
	Transcript cr; nextPutAll: 'Machine precision: '.
	self machinePrecision printOn: Transcript.
	Transcript cr; nextPutAll: 'Negative machine precision: '.
	self negativeMachinePrecision printOn: Transcript.
	Transcript cr; nextPutAll: 'Smallest number: '.
	self smallestNumber printOn: Transcript.
	Transcript cr; nextPutAll: 'Largest number: '.
	self largestNumber printOn: Transcript.			!

smallestNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 5/5/99 "
	smallestNumber isNil
		ifTrue: [ self computeSmallestNumber].
	^smallestNumber!

smallNumber
		"(c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 5/5/99 "
	smallNumber isNil
		ifTrue: [ smallNumber := self smallestNumber sqrt].
	^smallNumber! !

!DhbFloatingPointMachine privateMethods !

computeLargestNumber
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 11/6/99 "
	| zero one floatingRadix fullMantissaNumber |
	zero := 0 asFloat.
	one := 1 asFloat.
	floatingRadix := self radix asFloat.
	fullMantissaNumber := one - ( floatingRadix * self negativeMachinePrecision).
	largestNumber := fullMantissaNumber.
	[ [ fullMantissaNumber := fullMantissaNumber * floatingRadix.
	    largestNumber := fullMantissaNumber.
		true] whileTrue: [ ].
		] when: ExAll do: [ :signal | signal exitWith: nil].!

computeMachinePrecision
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	| one zero a b inverseRadix tmp x |
	one := 1 asFloat.
	zero := 0 asFloat.
	inverseRadix := one / self radix asFloat.
	machinePrecision := one.
	[ tmp := one + machinePrecision.
	  tmp - one = zero]
		whileFalse:[  machinePrecision := machinePrecision * inverseRadix].!

computeNegativeMachinePrecision
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	| one zero floatingRadix inverseRadix tmp |
	one := 1 asFloat.
	zero := 0 asFloat.
	floatingRadix := self radix asFloat.
	inverseRadix := one / floatingRadix.
	negativeMachinePrecision := one.
	[ tmp := one - negativeMachinePrecision.
	  tmp - one = zero]
		whileFalse:[ negativeMachinePrecision := negativeMachinePrecision * inverseRadix].!

computeRadix
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	| one zero a b tmp1 tmp2|
	one := 1 asFloat.
	zero := 0 asFloat.
	a := one.
	[ a := a + a.
	  tmp1 := a + one.
	  tmp2 := tmp1 - a.
	  tmp2 - one = zero] whileTrue:[].
	b := one.
	[ b := b + b.
	  tmp1 := a + b.
	  radix := ( tmp1 - a) truncated.
	  radix = 0 ] whileTrue: [].!

computeSmallestNumber
		"Private -
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 11/6/99 "
	| zero one floatingRadix inverseRadix fullMantissaNumber |
	zero := 0 asFloat.
	one := 1 asFloat.
	floatingRadix := self radix asFloat.
	inverseRadix := one / floatingRadix.
	fullMantissaNumber := one - ( floatingRadix * self negativeMachinePrecision).
	smallestNumber := fullMantissaNumber.
	[ [ fullMantissaNumber := fullMantissaNumber * inverseRadix.
	    smallestNumber := fullMantissaNumber.
		true] whileTrue: [ ].
		] when: ExAll do: [ :signal | signal exitWith: nil].! !

!Number publicMethods !

equalsTo: aNumber
		"
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	^self relativelyEqualsTo: aNumber upTo: DhbFloatingPointMachine new defaultNumericalPrecision!

relativelyEqualsTo: aNumber upTo: aSmallNumber
		"
		 (c) Copyrights Didier BESSET, 1999, all rights reserved.
		 Initial code: 21/4/99 "
	| norm |
	norm := self abs max: aNumber abs.
	^norm <= DhbFloatingPointMachine new defaultNumericalPrecision
		or: [ (self - aNumber) abs < ( aSmallNumber * norm)]! !

DhbDecimalFloatingNumber initializeAfterLoad!

DhbFloatingPointMachine initializeAfterLoad!

DhbNumericalPrecision initializeAfterLoad!