"

 COPYRIGHT (c) 1988-93 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.

"

Number variableByteSubclass:#Float

       instanceVariableNames:''

       classVariableNames:''

       poolDictionaries:''

       category:'Magnitude-Numbers'

!

Float comment:'

COPYRIGHT (c) 1988-93 by Claus Gittinger

              All Rights Reserved

%W% %E%

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

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

'!

!Float class methodsFor:'instance creation'!

new:aNumber

    "catch this message - not allowed for floats"

    self error:'Floats cannot be created with new:'

!

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."

%{  /* NOCONTEXT */

    RETURN ( _MKFLOAT((0.0) COMMA_SND) );

%}

! !

!Float class methodsFor:'constants'!

zero

    "return the neutral element for addition"

    ^ 0.0

!

unity

    "return the neutral element for multiplication"

    ^ 1.0

!

pi

    "return the constant pi"

    ^ 3.1415926535897932384626434

! !

!Float methodsFor:'copying'!

shallowCopy

    "return a shallow copy of myself

     - reimplemented here since Floats are kind of kludgy"

    ^ self

!

deepCopy

    "return a deep copy of myself

     - reimplemented here since Floats are kind of kludgy"

    ^ self

! !

!Float methodsFor:'accessing'!

size

   "redefined since floats are kludgy (ByteArry)"

   ^ 0

!

at:index

    "redefined to prevent access to individual bytes in a float"

    self error:'not allowed for floats'

!

at:index put:aValue

    "redefined to prevent access to individual bytes in a float"

    self error:'not allowed for floats'

! !

!Float methodsFor:'arithmetic'!

+ 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:

        _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);

        _InstPtr(newFloat)->o_class = Float;

        _FloatInstPtr(newFloat)->f_floatvalue = result;

        RETURN ( newFloat );

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

        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:

        _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);

        _InstPtr(newFloat)->o_class = Float;

        _FloatInstPtr(newFloat)->f_floatvalue = result;

        RETURN ( newFloat );

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

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

        goto retResult;

    }

%}

.

    ^ aNumber differenceFromFloat:self

!

* 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:

        _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);

        _InstPtr(newFloat)->o_class = Float;

        _FloatInstPtr(newFloat)->f_floatvalue = result; 

        RETURN ( newFloat );

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

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

        goto retResult;

    }

%}

.

    ^ aNumber productFromFloat: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:

            _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);

            _InstPtr(newFloat)->o_class = Float;

            _FloatInstPtr(newFloat)->f_floatvalue = result;

            RETURN ( newFloat );

        }

    } else {

        if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

            val = _floatVal(aNumber);

            if (val != 0.0) {

                result = _floatVal(self) / val;

                goto retResult;

            }

        }

    }

%}

.

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

        DivisionByZeroSignal raise.

        ^ self

    ].

    ^ aNumber quotientFromFloat:self

!

// aNumber

    "return the integer quotient of dividing the receiver by aNumber with

    truncation towards negative infinity."

    ^ (self / aNumber) floor asInteger

!

\\ aNumber

    "return the integer remainder of dividing the receiver by aNumber with

    truncation towards negative infinity."

    ^ (self - ((self / aNumber) floor * aNumber)) floor asInteger

!

negated

    "return myself negated"

%{  /* NOCONTEXT */

    RETURN ( _MKFLOAT(- _floatVal(self) COMMA_SND) );

%}

! !

!Float methodsFor:'testing'!

positive

    "return true if the receiver is greater or equal to zero"

%{  /* NOCONTEXT */

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

%}

!

negative

    "return true if the receiver is less than zero"

%{  /* NOCONTEXT */

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

%}

! !

!Float methodsFor:'comparing'!

< aNumber

    "return true, if the argument is greater"

%{  /* NOCONTEXT */

    if (_isSmallInteger(aNumber)) {

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

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

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

    }

%}

.

    ^ aNumber lessFromFloat:self

!

> aNumber

    "return true, if the argument is less"

%{  /* NOCONTEXT */

    if (_isSmallInteger(aNumber)) {

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

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

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

    }

%}

.

    ^ self retry:#> coercing:aNumber

!

<= aNumber

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

%{  /* NOCONTEXT */

    if (_isSmallInteger(aNumber)) {

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

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

        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 ((aNumber != nil) && (_qClass(aNumber) == Float)) {

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

    }

%}

.

    ^ self retry:#>= coercing:aNumber

!

= aNumber

    "return true, if the arguments value are equal"

%{  /* NOCONTEXT */

    if (_isSmallInteger(aNumber)) {

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

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

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

    }

%}

.

    ^ self retry:#= coercing:aNumber

!

~= aNumber

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

%{  /* NOCONTEXT */

    if (_isSmallInteger(aNumber)) {

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

    }

    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {

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

    }

%}

.

    ^ self retry:#~= coercing:aNumber

! !

!Float methodsFor:'coercion and converting'!

coerce:aNumber

    "return aNumber converted into receivers type"

    ^ aNumber asFloat

!

generality

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

    ^ 80

!

asFloat

    "return a float with same value - thats me"

    ^ self

!

asFraction

    "return a corresponding fraction

     - notice, that fract asFloat asFract does not always return

     a good fraction ..."

    |fract digits power num denom|

    "we (indirectly) use printf which knows the precision of floats"

    fract := self fractionPart.

    digits := fract printString copyFrom:3.

    power := digits size.

    num := (self - fract) asInteger.

    denom := (10 raisedToInteger:power).

    num := num * denom.

    num := num + (Integer readFromString:digits).

    ^ (Fraction numerator:num denominator:denom) reduced

    "0.3 asFraction"

    "0.5 asFraction"

    "(1/5) asFloat asFraction"

    "(1/8) asFloat asFraction"

    "(1/12) asFloat asFraction -> inexact result due to float errors"

    "(1/13) asFloat asFraction -> inexact result due to float errors"

!

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)) );

    }

%}

.

    "this is stupid code - rounding errors accumulate; fix later"

    sign := self sign.

    v := self abs.

    (v >= 10) ifTrue:[

        l := (v / 10.0) asInteger * 10

    ] ifFalse:[

        l := 0

    ].

    v := v - ((v / 10.0) floor * 10.0) floor.

    l := l + v truncated.

    ^ l * sign

    "12345.0 asInteger"

    "1e15 asInteger"

! !

!Float methodsFor:'double dispatching'!

sumFromFraction:aFraction

    "sent when a fraction does not know how to add the recevier, a float"

    ^ (self * aFraction denominator + aFraction numerator) / aFraction denominator

!

differenceFromFraction:aFraction

    "sent when a fraction does not know how to subtract the recevier, a float"

    ^ (self * aFraction denominator - aFraction numerator) / aFraction denominator

!

productFromFraction:aFraction

    "sent when a fraction does not know how to multiply the recevier, a float"

    ^ self * aFraction numerator / aFraction denominator

!

quotientFromFraction:aFraction

    "sent when a fraction does not know how to divide by the recevier, a float"

    ^ aFraction numerator / (self * aFraction denominator)

! !

!Float methodsFor:'truncation and rounding'!

truncated

    "return the receiver truncated towards zero as Integer"

    |val|

%{

    double floor(), ceil();

    double dVal;

    dVal = _floatVal(self);

    if (dVal < 0.0) {

        dVal = ceil(dVal);

    } else {

        dVal = floor(dVal);

    }

    /*

     * mhmh it seems that ST-80 is returning integers if possible.

     * (at least, some pd programs expect it ...)

     */

    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {

        RETURN ( _MKSMALLINT( (INT) dVal ) );

    }

    val = _MKFLOAT(dVal COMMA_CON);

%}

.

    ^ val asInteger

!

rounded

    "return the receiver rounded to the nearest integer as integer"

    |val|

%{

    double floor();

    double dVal;

    /*

     * mhmh it seems that ST-80 is returning integers if possible

     * at least, some pd programs expect it ...

     */

    dVal = floor(_floatVal(self) + 0.5);

    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {

        RETURN ( _MKSMALLINT( (INT) dVal ) );

    }

    val = _MKFLOAT(dVal COMMA_CON);

%}

.

    ^ val asInteger

!

floor

    "return the biggest integer-valued float less or equal to the receiver"

%{  /* NOCONTEXT */

    double floor();

    RETURN ( _MKFLOAT(floor(_floatVal(self)) COMMA_SND) );

%}

!

ceiling

    "return the smallest integer-valued float greater or equal to the receiver"

%{  /* NOCONTEXT */

    double ceil();

    RETURN ( _MKFLOAT(ceil(_floatVal(self)) COMMA_SND) );

%}

!

fractionPart

    "return a float with value from digits after the decimal point"