Float.st
author Claus Gittinger <cg@exept.de>
Mon, 07 Oct 1996 19:47:43 +0200
changeset 1695 465e1eba8e8e
parent 1688 8a42db1eea60
child 1879 26df273349c4
permissions -rw-r--r--
removed useless context-arg of all qMK macros - needs full recompile.

"
 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:''
	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 as results
    of arithmetic operations (even if the operands are subclass-instances).
    (It does the float-check by probing a bit in the classes flag instVar).

    [Class Variables:]

    [see also:]
        Number
        ShortFloat Fraction Integer
        FloatArray DoubleArray

    [author:]
        Claus Gittinger
"
! !

!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 */
    OBJ newFloat;

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

! !

!Float  class methodsFor:'binary storage'!

binaryDefinitionFrom:aStream manager: manager
    |f|

    f := self basicNew.
    self readBinaryIEEEDoubleFrom:aStream into:f.
    ^ f

    "Modified: 16.4.1996 / 21:23:38 / cg"
!

readBinaryIEEEDoubleFrom:aStream
    "read a float from the binary stream, aStream,
     interpreting the next bytes as an IEEE formatted 8-byte float"

    |f|

    f := self basicNew.
    self readBinaryIEEEDoubleFrom:aStream into:f.
    ^ f

    "Created: 16.4.1996 / 20:59:59 / cg"
!

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
    "read a float value from the binary stream, aStream,
     interpreting the next bytes as an IEEE formatted 4-byte float"

    |f|

    f := self basicNew.
    self readBinaryIEEESingleFrom:aStream into:f.
    ^ f

    "Created: 16.4.1996 / 21:00:35 / cg"
!

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 as Float"

    ^ 3.1415926535897932384626434

    "Modified: 23.4.1996 / 09:27:02 / cg"
!

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

    ^ 1.0

    "Modified: 23.4.1996 / 09:27:09 / cg"
!

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

    ^ 0.0

    "Modified: 23.4.1996 / 09:27:15 / cg"
! !

!Float  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 == Float

    "Modified: 23.4.1996 / 15:59:04 / cg"
! !

!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);
	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);
	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);
	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);
	    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);
    RETURN ( newFloat );
%}
! !

!Float methodsFor:'binary storage'!

storeBinaryDefinitionOn:stream manager:manager
    "store the receiver in a binary format on stream.
     This is an internal interface for binary storage mechanism."

    manager putIdOfClass:(self class) on:stream.
    Float storeBinaryIEEEDouble:self on:stream.

    "Modified: 23.4.1996 / 09:29:48 / cg"
! !

!Float methodsFor:'coercion and converting'!

asFloat
    "return a float with same value - thats me"

    ^ self
!

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

%{  /* NOCONTEXT */
    double dVal;

    dVal = __floatVal(self);
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
        RETURN ( __MKSMALLINT( (INT)dVal) );
    }
%}.
    ^ super asInteger

    "12345.0 asInteger"
    "1e15 asInteger"
!

asShortFloat
    "return a shortFloat with same value as receiver"

%{  /* NOCONTEXT */

    OBJ dummy = @global(ShortFloat);
    OBJ newFloat;
    float fVal = (float)__floatVal(self);

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

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)

    "
     3 hash       
     3.0 hash
     3.1 hash  
     3.14159 hash  
     31.4159 hash 
     3.141591 hash 
     1.234567890123456 hash  
     1.234567890123457 hash   
     Set withAll:#(3 3.0 99 99.0 3.1415)
    "
!

~= aNumber
    "return true, if the arguments value are not 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
! !

!Float methodsFor:'mathematical functions'!

arcCos
    "return the arccosine of myself as radians"

%{  /* NOCONTEXT */

    double acos();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = acos(__floatVal(self));
    if (errno == 0) {
        __qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
!

arcSin
    "return the arcsine of myself as radians"

%{  /* NOCONTEXT */

    double asin();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = asin(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
!

arcTan
    "return the arctangent of myself as radians"

%{  /* NOCONTEXT */

    double atan();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = atan(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
!

cos
    "return the cosine of myself interpreted as radians"

%{  /* NOCONTEXT */

    double cos();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = cos(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
!

exp
    "return e raised to the power of the receiver"

%{  /* NOCONTEXT */

    double exp();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = exp(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
!

ln
    "return the natural logarithm of myself"

%{  /* NOCONTEXT */

    double log();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = log(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    "
     an invalid value for logarithm
    "
    ^ DomainErrorSignal raise
!

raisedTo:aNumber
    "return self raised to the power of aNumber"
    |n|

    n := aNumber asFloat.
%{
    double pow();
    double rslt;
    OBJ newFloat;

    if (__isFloatLike(n)) {
	errno = 0;
	rslt = pow(__floatVal(self), __floatVal(n));
	errno = 0;  /* XXXX */
        if (errno == 0) {
	    __qMKFLOAT(newFloat, rslt);
	    RETURN ( newFloat );
        }
    }
%}.
    "
     an invalid argument (not convertable to float ?)
    "
    ^ DomainErrorSignal raise
!

sin
    "return the sine of myself interpreted as radians"

%{  /* NOCONTEXT */

    double sin();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = sin(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
!

sqrt
    "return the square root of myself"

%{  /* NOCONTEXT */

    double sqrt();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = sqrt(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
!

tan
    "return the tangent of myself interpreted as radians"

%{  /* NOCONTEXT */

    double tan();
    double rslt;
    OBJ newFloat;

    errno = 0;
    rslt = tan(__floatVal(self));
    if (errno == 0) {
	__qMKFLOAT(newFloat, rslt);
	RETURN ( newFloat );
    }
%}.
    ^ DomainErrorSignal raise
! !

!Float 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", __floatVal(self));
#else
    sprintf(buffer, "%.6G", __floatVal(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.

    "1.0 printString"
    "1.234 printString"
    "1e10 printString"
    "1.2e3 printString"
    "1.2e30 printString"
!

printfPrintString:formatString
    "non-portable: return a printed representation of the receiver
     as specified by formatString, which is defined by printf.
     If you use this, be aware, that specifying doubles differs on
     systems; on SYSV machines you have to give something like %lf, 
     while on BSD systems the format string has to be %F.
     Also, the resulting string may not be longer than 255 bytes -
     since thats the (static) size of the buffer.
     This method is NONSTANDARD and may be removed without notice."

%{  /* STACK: 400 */
    char buffer[256];
    OBJ s;

    if (__isString(formatString)) {
	/*
	 * 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__

	sprintf(buffer, __stringVal(formatString), __floatVal(self));

	__END_PROTECT_REGISTERS__

	s = __MKSTRING(buffer COMMA_SND);
	if (s != nil) {
	    RETURN (s);
	}
    }
%}.
    self primitiveFailed

    "Float pi printfPrintString:'%%lg -> %lg'"
    "Float pi printfPrintString:'%%lf -> %lf'"
    "Float pi printfPrintString:'%%7.5lg -> %7.5lg'"
    "Float pi printfPrintString:'%%7.5lf -> %7.5lf'"
    "Float pi printfPrintString:'%%G -> %G'"
    "Float pi printfPrintString:'%%F -> %F'"
    "Float pi printfPrintString:'%%7.5G -> %7.5G'"
    "Float pi printfPrintString:'%%7.5F -> %7.5F'"
! !

!Float methodsFor:'private accessing'!

basicAt:index
    "return an internal byte of the float.
     The value returned here depends on byte order, float representation etc.
     Therefore, this method should be used strictly private.

     Notice: 
	the need to redefine this method here is due to the
	inability of many machines to store floats in non-double aligned memory.
	Therefore, on some machines, the first 4 bytes of a float are left unused,
	and the actual float is stored at index 5 .. 12.
	To hide this at one place, this method knows about that, and returns
	values as if this filler wasnt present."

%{  /* NOCONTEXT */

    register int indx;
    unsigned char *cp;

    /*
     * notice the missing test for self being a nonNilObject -
     * this can be done since basicAt: is defined both in UndefinedObject
     * and SmallInteger
     */
    if (__isSmallInteger(index)) {
	indx = __intVal(index) - 1;
	if ((indx >= 0) && (indx < sizeof(double))) {
	    cp = (unsigned char *)(& (__FloatInstPtr(self)->f_floatvalue));
	    RETURN ( __MKSMALLINT(cp[indx] & 0xFF) );
	}
    }
%}.
    index isInteger ifFalse:[
	^ self indexNotInteger
    ].
    ^ self subscriptBoundsError:index
!

basicAt:index put:value
    "set an internal byte of the float.
     The value to be stored here depends on byte order, float representation etc.
     Therefore, this method should be used strictly private.

     Notice: 
	the need to redefine this method here is due to the
	inability of many machines to store floats in non-double aligned memory.
	Therefore, on some machines, the first 4 bytes of a float are left unused,
	and the actual float is stored at index 5 .. 12.
	To hide this at one place, this method knows about that, and returns
	values as if this filler wasnt present."

%{  /* NOCONTEXT */
    register int indx, val;
    unsigned char *cp;

    /*
     * notice the missing test for self being a nonNilObject -
     * this can be done since basicAt: is defined both in UndefinedObject
     * and SmallInteger
     */
    if (__bothSmallInteger(index, value)) {
	val = __intVal(value);
	if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
	    indx = __intVal(index) - 1;
	    if ((indx >= 0) && (indx < sizeof(double))) {
		cp = (unsigned char *)(& (__FloatInstPtr(self)->f_floatvalue));
		cp[indx] = val;
		RETURN ( value );
	    }
	}
    }
%}.
    index isInteger ifFalse:[
	^ self indexNotInteger
    ].
    value isInteger ifFalse:[
	"
	 the object to store should be an integer number
	"
	^ self elementNotInteger
    ].
    (value between:0 and:255) ifFalse:[
	"
	 the object to store must be a bytes value
	"
	^ self elementBoundsError
    ].
    ^ self subscriptBoundsError:index
! !

!Float methodsFor:'testing'!

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

%{  /* NOCONTEXT */

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

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

%{  /* NOCONTEXT */

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

!Float methodsFor:'truncation and rounding'!

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

    |val|

%{
    double ceil();
    double dVal;

    /*
     * ST-80 (and X3J20) returns integer.
     */
    dVal = ceil(__floatVal(self));
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
	RETURN ( __MKSMALLINT( (INT) dVal ) );
    }
    val = __MKFLOAT(dVal);
%}.
    ^ val asInteger
!

floor
    "return the integer nearest the receiver towards negative infinity."

    |val|

%{
    double floor();
    double dVal;

    /*
     * ST-80 (and X3J20) returns integer.
     */
    dVal = floor(__floatVal(self));
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
	RETURN ( __MKSMALLINT( (INT) dVal ) );
    }
    val = __MKFLOAT(dVal);
%}.
    ^ val asInteger
!

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

    |val|

%{
    double floor();
    double dVal;

    /*
     * ST-80 (and X3J20) returns integer.
     */
    dVal = floor(__floatVal(self) + 0.5);
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
	RETURN ( __MKSMALLINT( (INT) dVal ) );
    }
    val = __MKFLOAT(dVal);
%}.
    ^ val asInteger
!

truncated
    "return the receiver truncated towards zero as an integer"

    |val|

%{
    double floor(), ceil();
    double dVal;

    dVal = __floatVal(self);
    if (dVal < 0.0) {
	dVal = ceil(dVal);
    } else {
	dVal = floor(dVal);
    }

    /*
     * ST-80 (and X3J20) returns integer.
     */
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
	RETURN ( __MKSMALLINT( (INT) dVal ) );
    }
    val = __MKFLOAT(dVal);
%}.
    ^ val asInteger
! !

!Float  class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.43 1996-10-07 17:47:12 cg Exp $'
! !