"

 COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

LimitedPrecisionReal variableByteSubclass:#Float

	 instanceVariableNames:''

	 classVariableNames:'LastErrorNumber'

	 poolDictionaries:''

	 category:'Magnitude-Numbers'

!

!Float primitiveDefinitions!

%{

#include <errno.h>

/*

 * on some systems errno is a macro ... check for it here

 */

#ifndef errno

 extern errno;

#endif

%}

! !

!Float class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Floats represent rational numbers with limited precision. In ST/X, Float uses

    the underlying C-compilers double implementation, therefore instances of Float

    are usually represented by the 8-byte IEE double precision float format.

    (but there is no guaranty).

    Notice, that Floats are defined as Byte-array to prevent the garbage collector

    from going into the value ... otherwise I needed a special case in many places.

    Also notice, that ST/X Floats are what Doubles are in ST-80 - this may change 

    in one of the next versions (at least on machines, which provide different float

    and double types in their C-compiler.

    WARNING:

    The layout of float instances is known by the runtime system and the compiler;

    you may not add instance variables here. 

    Also, subclassing is complicated by the fact, that the VM creates floats, and does 

    its float-checks by an identity compare with the Float-class. (i.e. your subclasses 

    instances will not be recognized as float-like objects, thus mixed mode arithmetic 

    will always coerce them, effectively slowing things down).

    This may be changed, to use a flag bit in the class.

    Class Variables:

	LastErrorNumber <Integer>       value of errno (after a trig- or other math err)

"

! !

!Float class methodsFor:'instance creation'!

basicNew

    "return a new float - here we return 0.0

     - floats are usually NOT created this way ...

     Its implemented here to allow things like binary store & load

     of floats. (but even this support will go away eventually, its not

     a good idea to store the bits of a float - the reader might have a

     totally different representation - so floats will eventually be 

     binary stored in a device independent format."

%{  /* NOCONTEXT */

    RETURN ( _MKFLOAT((0.0) COMMA_SND) );

%}

! !

!Float class methodsFor:'binary storage'!

binaryDefinitionFrom: stream manager: manager

    |f|

    f := self basicNew.

    self readBinaryIEEEDoubleFrom:stream into:f.

    ^ f

!

readBinaryIEEEDoubleFrom:aStream into:aFloat

    "read the receivers value from the binary stream, aStream,

     interpreting the next bytes as an IEEE formatted 8-byte float"

    "

     this implementation is wrong: does not work on non-IEEE machines

     (to date all machines where ST/X is running on use

      IEEE float format. Need more here, when porting ST/X to 370's)

    "

    UninterpretedBytes isBigEndian ifFalse:[

	"swap the bytes"

	8 to:1 by:-1 do:[:i |

	    aFloat basicAt:i put:(aStream next)

	].

	^ self

    ].

    1 to:8 do:[:i |

	aFloat basicAt:i put:aStream next

    ]

!

readBinaryIEEESingleFrom:aStream into:aFloat

    "read a float value from the binary stream, aStream,

     interpreting the next bytes as an IEEE formatted 4-byte float"

    "

     this implementation is wrong: does not work on non-IEEE machines

     (to date all machines where ST/X is running on use

      IEEE float format. Need more here, when porting ST/X to 370's)

    "

    UninterpretedBytes isBigEndian ifFalse:[

	"swap the bytes"

	8 to:4 by:-1 do:[:i |

	    aFloat basicAt:i put:(aStream next)

	].

	^ self

    ].

    1 to:4 do:[:i |

	aFloat basicAt:i put:aStream next

    ]

!

storeBinaryIEEEDouble:aFloat on:aStream

    "store aFloat as an IEEE formatted 8-byte float

     onto the binary stream, aStream"

    "

     this implementation is wrong: does not work on non-IEEE machines

     (to date all machines where ST/X is running on use

      IEEE float format. Need more here, when porting ST/X to 370's)

    "

    UninterpretedBytes isBigEndian ifFalse:[

	"swap the bytes"

	8 to:1 by:-1 do:[:i |

	    aStream nextPut:(aFloat basicAt:i).

	].

	^ self

    ].

    1 to:8 do:[:i |

	aStream nextPut:(aFloat basicAt:i).

    ].

!

storeBinaryIEEESingle:aFloat on:aStream

    "store aFloat as an IEEE formatted 4-byte float

     onto the binary stream, aStream"

    "

     this implementation is wrong: does not work on non-IEEE machines

     (to date all machines where ST/X is running on use

      IEEE float format. Need more here, when porting ST/X to 370's)

    "

    UninterpretedBytes isBigEndian ifFalse:[

	"swap the bytes"

	8 to:4 by:-1 do:[:i |

	    aStream nextPut:(aFloat basicAt:i).

	].

	^ self

    ].

    1 to:4 do:[:i |

	aStream nextPut:(aFloat basicAt:i).

    ]

! !

!Float class methodsFor:'constants'!

pi

    "return the constant pi"

    ^ 3.1415926535897932384626434

!

unity

    "return the neutral element for multiplication"

    ^ 1.0

!

zero

    "return the neutral element for addition"

    ^ 0.0

! !

!Float class methodsFor:'queries'!

isBuiltInClass

    "this class is known by the run-time-system"

    ^ self == Float

!

lastErrorNumber

    "return the value of errno after an error"

    ^ LastErrorNumber

    "

     2 arcSin.

     OperatingSystem errorTextForNumber:(Float lastErrorNumber)

    "

! !

!Float methodsFor:'arithmetic'!

* aNumber

    "return the product of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    double result;

    if (__isSmallInteger(aNumber)) {

	result = _floatVal(self) * (double)(_intVal(aNumber));

retResult:

	_qMKFLOAT(newFloat, result, SENDER);

	RETURN ( newFloat );

    }

    if (__isFloatLike(aNumber)) {

	result = _floatVal(self) * _floatVal(aNumber);

	goto retResult;

    }

%}

.

    ^ aNumber productFromFloat:self

!

+ aNumber

    "return the sum of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    double result;

    if (__isSmallInteger(aNumber)) {

	result = _floatVal(self) + (double)(_intVal(aNumber));

retResult:

	_qMKFLOAT(newFloat, result, SENDER);

	RETURN ( newFloat );

    }

    if (__isFloatLike(aNumber)) {

	result = _floatVal(self) + _floatVal(aNumber);

	goto retResult;

    }

%}

.

    ^ aNumber sumFromFloat:self

!

- aNumber

    "return the difference of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    double result;

    if (__isSmallInteger(aNumber)) {

	result = _floatVal(self) - (double)(_intVal(aNumber));

retResult:

	_qMKFLOAT(newFloat, result, SENDER);

	RETURN ( newFloat );

    }

    if (__isFloatLike(aNumber)) {

	result = _floatVal(self) - _floatVal(aNumber);

	goto retResult;

    }

%}

.

    ^ aNumber differenceFromFloat:self

!

/ aNumber

    "return the quotient of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    double result, val;

    if (__isSmallInteger(aNumber)) {

	if (aNumber != _MKSMALLINT(0)) {

	    result = _floatVal(self) / ( (double)_intVal(aNumber)) ;

retResult:

	    _qMKFLOAT(newFloat, result, SENDER);

	    RETURN ( newFloat );

	}

    } else {

	if (__isFloatLike(aNumber)) {

	    val = _floatVal(aNumber);

	    if (val != 0.0) {

		result = _floatVal(self) / val;

		goto retResult;

	    }

	}

    }

%}

.

    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[

	"

	 No, you shalt not divide by zero

	"

	^ DivisionByZeroSignal raise.

    ].

    ^ aNumber quotientFromFloat:self

!

negated

    "return myself negated"

%{  /* NOCONTEXT */

    OBJ newFloat;

    double rslt = - _floatVal(self);

    _qMKFLOAT(newFloat, rslt, SENDER);

    RETURN ( newFloat );

%}

! !

!Float methodsFor:'binary storage'!

storeBinaryDefinitionOn:stream manager:manager

    manager putIdOfClass:(self class) on:stream.

    Float storeBinaryIEEEDouble:self on:stream.

! !

!Float methodsFor:'coercion and converting'!

asFloat

    "return a float with same value - thats me"

    ^ self

!

asInteger

    "return an integer with same value - might truncate"

    |l v sign|

%{  /* NOCONTEXT */

    if ((_floatVal(self) >= (double)_MIN_INT)

     && (_floatVal(self) <= (double)_MAX_INT)) {

	RETURN ( _MKSMALLINT( (INT)_floatVal(self)) );

    }

%}

.

    ^ super asInteger

    "12345.0 asInteger"

    "1e15 asInteger"

!

coerce:aNumber

    "return aNumber converted into receivers type"

    ^ aNumber asFloat

!

generality

    "return the generality value - see ArithmeticValue>>retry:coercing:"

    ^ 80

! !

!Float methodsFor:'comparing'!

< aNumber

    "return true, if the argument is greater"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {

	RETURN ( (_floatVal(self) < (double)(_intVal(aNumber))) ? true : false );

    }

    if (__isFloatLike(aNumber)) {

	RETURN ( (_floatVal(self) < _floatVal(aNumber)) ? true : false );

    }

%}

.

    ^ aNumber lessFromFloat:self

!

<= aNumber

    "return true, if the argument is greater or equal"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {

	RETURN ( (_floatVal(self) <= (double)(_intVal(aNumber))) ? true : false );

    }

    if (__isFloatLike(aNumber)) {

	RETURN ( (_floatVal(self) <= _floatVal(aNumber)) ? true : false );

    }

%}

.

    ^ self retry:#<= coercing:aNumber

!

= aNumber

    "return true, if the arguments value are equal by value"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {

	RETURN ( (_floatVal(self) == (double)(_intVal(aNumber))) ? true : false );

    }

    if (__isFloatLike(aNumber)) {

	RETURN ( (_floatVal(self) == _floatVal(aNumber)) ? true : false );

    }

%}

.

    ^ self retry:#= coercing:aNumber

!

> aNumber

    "return true, if the argument is less"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {

	RETURN ( (_floatVal(self) > (double)(_intVal(aNumber))) ? true : false );

    }

    if (__isFloatLike(aNumber)) {

	RETURN ( (_floatVal(self) > _floatVal(aNumber)) ? true : false );

    }

%}

.

    ^ self retry:#> coercing:aNumber

!

>= aNumber

    "return true, if the argument is less or equal"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {

	RETURN ( (_floatVal(self) >= (double)(_intVal(aNumber))) ? true : false );

    }

    if (__isFloatLike(aNumber)) {

	RETURN ( (_floatVal(self) >= _floatVal(aNumber)) ? true : false );

    }

%}

.

    ^ self retry:#>= coercing:aNumber

!

hash

    "return a number for hashing; redefined, since floats compare

     by numeric value (i.e. 3.0 = 3), therefore 3.0 hash must be the same

     as 3 hash."

    |i|

    (self >= SmallInteger minVal and:[self <= SmallInteger maxVal]) ifTrue:[

	i := self asInteger.

	self = i ifTrue:[

	    ^ i hash

	].

    ].

    "

     mhmh take some of my value-bits to hash on

    "

    ^ (((self basicAt:8) bitAnd:16r3F) bitShift:24) +

      ((self basicAt:7) bitShift:16) +

      ((self basicAt:6) bitShift:8) +

      (self basicAt:5)