ShortFloat.st
author Claus Gittinger <cg@exept.de>
Tue, 07 Jan 1997 12:02:05 +0100
changeset 2072 e84dbf5e5424
parent 1893 c66af5c46272
child 2387 3aafb49a86ac
permissions -rw-r--r--
removed package-change info message

"
 COPYRIGHT (c) 1996 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:#ShortFloat
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Magnitude-Numbers'
!

!ShortFloat class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1996 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
"
    ShortFloats represent rational numbers with limited precision. In ST/X, Float uses
    the underlying C-compilers double implementation, while ShortFloats are
    mapped onto C-floats.
    Therefore instances of Float are usually represented by the 8-byte IEE 
    double precision float format, while ShortFloats use 4byte IEE format.
    (but there is no guaranty).

    Notice, that ST/X Floats are what Doubles are in ST-80 and ShortFloats are
    ST-80's Floats respectively.
    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 shortFloat 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/shortFloats, 
    and does its float-checks by an identity compare with the ShortFloat-class. 
    (i.e. your subclasses instances may 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.

    [author:]
        Claus Gittinger

    [see also:]
        Number
        Float Fraction FixedPoint Integer
"

! !

!ShortFloat class methodsFor:'instance creation'!

basicNew
    "return a new shortFloat - here we return 0.0
     - shortFloats are usually NOT created this way ...
     Its implemented here to allow things like binary store & load
     of shortFloats. (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 */
    OBJ newFloat;

    __qMKSFLOAT(newFloat, 0.0);
    RETURN (newFloat);
%}
! !

!ShortFloat class methodsFor:'constants'!

pi
    "return the constant pi as ShortFloat"

    ^ 3.14159 asShortFloat

    "Modified: 23.4.1996 / 09:26:31 / cg"
!

unity
    "return the neutral element for multiplication (1.0) as ShortFloat"

    ^ 1.0 asShortFloat

    "Modified: 23.4.1996 / 09:26:51 / cg"
!

zero
    "return the neutral element for addition (0.0) as ShortFloat"

    ^ 0.0 asShortFloat

    "Modified: 23.4.1996 / 09:26:45 / cg"
! !

!ShortFloat class methodsFor:'queries'!

isBuiltInClass
    "return true if this class is known by the run-time-system.
     Here, true is returned for myself, false for subclasses."

    ^ self == ShortFloat

    "Modified: 23.4.1996 / 16:00:23 / cg"
! !

!ShortFloat methodsFor:'arithmetic'!

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

%{  /* NOCONTEXT */

    OBJ newFloat;
    float result;
    double dResult;

    if (__isSmallInteger(aNumber)) {
        result = __shortFloatVal(self) * (float)(__intVal(aNumber));
retResult:
        __qMKSFLOAT(newFloat, result);
        RETURN ( newFloat );
    }
    if (__isShortFloat(aNumber)) {
        result = __shortFloatVal(self) * __shortFloatVal(aNumber);
        goto retResult;
    }
    if (__isFloatLike(aNumber)) {
        dResult = (double) __shortFloatVal(self)* __floatVal(aNumber);
        __qMKFLOAT(newFloat, dResult);
        RETURN ( newFloat );

    }
%}.
    ^ aNumber productFromShortFloat:self
!

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

%{  /* NOCONTEXT */

    OBJ newFloat;
    float result;
    double dResult;

    if (__isSmallInteger(aNumber)) {
        result = __shortFloatVal(self) + (float)(__intVal(aNumber));
retResult:
        __qMKSFLOAT(newFloat, result);
        RETURN ( newFloat );
    }
    if (__isShortFloat(aNumber)) {
        result = __shortFloatVal(self) + __shortFloatVal(aNumber);
        goto retResult;
    }
    if (__isFloatLike(aNumber)) {
        dResult = (double) __shortFloatVal(self) + __floatVal(aNumber);
        __qMKFLOAT(newFloat, dResult);
        RETURN ( newFloat );

    }
%}.
    ^ aNumber sumFromShortFloat:self
!

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

%{  /* NOCONTEXT */

    OBJ newFloat;
    float result;
    double dResult;

    if (__isSmallInteger(aNumber)) {
        result = __shortFloatVal(self) - (float)(__intVal(aNumber));
retResult:
        __qMKSFLOAT(newFloat, result);
        RETURN ( newFloat );
    }
    if (__isShortFloat(aNumber)) {
        result = __shortFloatVal(self) - __shortFloatVal(aNumber);
        goto retResult;
    }
    if (__isFloatLike(aNumber)) {
        dResult = (double) __shortFloatVal(self) - __floatVal(aNumber);
        __qMKFLOAT(newFloat, dResult);
        RETURN ( newFloat );

    }
%}.
    ^ aNumber differenceFromShortFloat:self
!

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

%{  /* NOCONTEXT */

    OBJ newFloat;
    float result, val;
    double dResult, dVal;

    if (__isSmallInteger(aNumber)) {
        if (aNumber != __MKSMALLINT(0)) {
            result = __shortFloatVal(self) / (float)(__intVal(aNumber));
retResult:
            __qMKSFLOAT(newFloat, result);
            RETURN ( newFloat );
        }
    }
    if (__isShortFloat(aNumber)) {
        val = __shortFloatVal(aNumber);
        if (val != 0.0) {
            result = __shortFloatVal(self) / val;
            goto retResult;
        }
    }
    if (__isFloatLike(aNumber)) {
        dVal = __floatVal(aNumber);
        if (dVal != 0.0) {
            dResult = (double) __shortFloatVal(self) / dVal;
            __qMKFLOAT(newFloat, dResult);
        }
        RETURN ( newFloat );

    }
%}.
    ((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;
    float rslt = - __shortFloatVal(self);

    __qMKSFLOAT(newFloat, rslt);
    RETURN ( newFloat );
%}

! !

!ShortFloat methodsFor:'coercion and converting'!

asFloat
    "return a Float with same value as the receiver"

%{  /* NOCONTEXT */

    OBJ newFloat;
    double dVal = (double)__shortFloatVal(self);

    __qMKFLOAT(newFloat, dVal);
    RETURN ( newFloat );
%}

    "
     1.0 asShortFloat asFloat 
    "
!

asInteger
    "return an integer with same value - might truncate"

%{  /* NOCONTEXT */
    float fVal;

    fVal = __shortFloatVal(self);
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
        RETURN ( __MKSMALLINT( (INT)fVal) );
    }
%}.
    ^ super asInteger

    "
     12345.0 asShortFloat asInteger
     1e15 asShortFloat asInteger
    "
!

asShortFloat
    "return a ShortFloat with same value as the receiver - thats me"

    ^ self
!

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

    ^ 70


! !

!ShortFloat methodsFor:'comparing'!

< aNumber
    "return true, if the argument is greater"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
        RETURN ( (__shortFloatVal(self) < (float)(__intVal(aNumber))) ? true : false );
    }
    if (__isFloatLike(aNumber)) {
        RETURN ( (double)(__shortFloatVal(self) < __floatVal(aNumber)) ? true : false );
    }
    if (__isShortFloat(aNumber)) {
        RETURN ( (__shortFloatVal(self) < __shortFloatVal(aNumber)) ? true : false );
    }
%}.
    ^ aNumber lessFromShortFloat:self

    "
     1.0 asShortFloat > (1/3)
    "
!

<= aNumber
    "return true, if the argument is greater or equal"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
        RETURN ( (__shortFloatVal(self) <= (float)(__intVal(aNumber))) ? true : false );
    }
    if (__isFloatLike(aNumber)) {
        RETURN ( (double)(__shortFloatVal(self) <= __floatVal(aNumber)) ? true : false );
    }
    if (__isShortFloat(aNumber)) {
        RETURN ( (__shortFloatVal(self) <= __shortFloatVal(aNumber)) ? true : false );
    }
%}.
    ^ self retry:#<= coercing:aNumber

!

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

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
        RETURN ( (__shortFloatVal(self) == (float)(__intVal(aNumber))) ? true : false );
    }
    if (__isFloatLike(aNumber)) {
        RETURN ( (double)(__shortFloatVal(self) == __floatVal(aNumber)) ? true : false );
    }
    if (__isShortFloat(aNumber)) {
        RETURN ( (__shortFloatVal(self) == __shortFloatVal(aNumber)) ? true : false );
    }
%}.
    ^ self retry:#= coercing:aNumber

!

> aNumber
    "return true, if the argument is less"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
        RETURN ( (__shortFloatVal(self) > (float)(__intVal(aNumber))) ? true : false );
    }
    if (__isFloatLike(aNumber)) {
        RETURN ( (double)(__shortFloatVal(self) > __floatVal(aNumber)) ? true : false );
    }
    if (__isShortFloat(aNumber)) {
        RETURN ( (__shortFloatVal(self) > __shortFloatVal(aNumber)) ? true : false );
    }
%}.
    ^ self retry:#> coercing:aNumber
!

>= aNumber
    "return true, if the argument is less or equal"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
        RETURN ( (__shortFloatVal(self) >= (float)(__intVal(aNumber))) ? true : false );
    }
    if (__isFloatLike(aNumber)) {
        RETURN ( (double)(__shortFloatVal(self) >= __floatVal(aNumber)) ? true : false );
    }
    if (__isShortFloat(aNumber)) {
        RETURN ( (__shortFloatVal(self) >= __shortFloatVal(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:4) bitAnd:16r3F) bitShift:24) +
      ((self basicAt:3) bitShift:16) +
      ((self basicAt:2) bitShift:8) +
      (self basicAt:1)

    "
     1.2345 hash      
     1.2345 asShortFloat hash 
     1.0 hash             
     1.0 asShortFloat hash  
    "
!

~= aNumber
    "return true, if the arguments value are not equal"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
        RETURN ( (__shortFloatVal(self) != (float)(__intVal(aNumber))) ? true : false );
    }
    if (__isFloatLike(aNumber)) {
        RETURN ( (double)(__shortFloatVal(self) !=  __floatVal(aNumber)) ? true : false );
    }
    if (__isShortFloat(aNumber)) {
        RETURN ( (__shortFloatVal(self) !=  __shortFloatVal(aNumber)) ? true : false );
    }
%}.
    ^ self retry:#~= coercing:aNumber

! !

!ShortFloat methodsFor:'printing & storing'!

printString
    "return a printed representation of the receiver"

%{  /* NOCONTEXT */

    char buffer[64];
    REGISTER char *cp;
    OBJ s;

    /*
     * actually only needed on sparc: since thisContext is
     * in a global register, which gets destroyed by printf,
     * manually save it here - very stupid ...
     */
    __BEGIN_PROTECT_REGISTERS__

#ifdef SYSV
    sprintf(buffer, "%.6lg", (double)__shortFloatVal(self));
#else
    sprintf(buffer, "%.6G", (double)__shortFloatVal(self));
#endif

    __END_PROTECT_REGISTERS__

    /* 
     * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
     * (i.e. look if string contains '.' or 'e' and append '.0' if not)
     */
    for (cp = buffer; *cp; cp++) {
        if ((*cp == '.') || (*cp == 'e')) break;
    }
    if (! *cp) {
        *cp++ = '.';
        *cp++ = '0';
        *cp = '\0';
    }

    s = __MKSTRING(buffer COMMA_SND);
    if (s != nil) {
        RETURN (s);
    }
%}.
    "
     memory allocation (for the new string) failed.
     When we arrive here, there was no memory, even after a garbage collect.
     This means, that the VM wanted to get some more memory from the
     OS, which was not kind enough to give it.
     Bad luck - you should increase the swap space on your machine.
    "
    ^ ObjectMemory allocationFailureSignal raise.
! !

!ShortFloat methodsFor:'testing'!

negative
    "return true if the receiver is less than zero"

%{  /* NOCONTEXT */

    RETURN ( (__shortFloatVal(self) < 0.0) ? true : false );
%}


!

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

%{  /* NOCONTEXT */

    RETURN ( (__shortFloatVal(self) >= 0.0) ? true : false );
%}

!

strictlyPositive
    "return true if the receiver is greater than zero"

%{  /* NOCONTEXT */

    RETURN ( (__shortFloatVal(self) > 0.0) ? true : false );
%}

! !

!ShortFloat class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.12 1996-11-05 18:39:47 cg Exp $'
! !