"
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.
"
"{ Package: 'stx:libbasic' }"
LimitedPrecisionReal variableByteSubclass:#Float
instanceVariableNames:''
classVariableNames:'DefaultPrintFormat'
poolDictionaries:''
category:'Magnitude-Numbers'
!
!Float primitiveDefinitions!
%{
#include <errno.h>
#ifndef __OPTIMIZE__
# define __OPTIMIZE__
#endif
#define __USE_ISOC9X 1
#include <math.h>
/*
* on some systems errno is a macro ... check for it here
*/
#ifndef errno
extern errno;
#endif
#if defined (_AIX)
# include <float.h>
#endif
#if defined(IRIX)
# include <nan.h>
#endif
#if defined(LINUX)
# ifndef NAN
# include <bits/nan.h>
# endif
#endif
#if defined(solaris) || defined(sunos)
# include <nan.h>
#endif
/*
* sigh - some systems define that stuff; others dont.
* (AIX even declares them as macros, so an external decl
* will not work below ...
*/
#if !defined(_AIX) && !defined(NEXT3)
# ifdef acos
double acos();
# endif
# ifdef asin
double asin();
# endif
# ifndef atan
double atan();
# endif
# ifndef cos
double cos();
# endif
# ifndef sin
double sin();
# endif
# ifndef pow
double pow();
# endif
# ifndef log
double log();
# endif
# ifndef exp
double exp();
# endif
# ifndef sqrt
double sqrt();
# endif
# ifndef tan
double tan();
# endif
#endif /* not AIX */
#ifdef WIN32
/*
* no finite(x) ?
* no isnan(x) ?
*/
# ifndef finite
# define finite(x) 1
# endif
# ifndef isnan
# define isnan(x) 0
# endif
#endif
#ifdef realIX
/*
* no finite(x)
*/
# ifndef finite
# define finite(x) 1
# endif
#endif
#ifndef NEXT3
# ifndef ceil
double ceil();
double floor();
# endif
#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 IEEE 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).
Mixed mode arithmetic:
float op float -> float
float op fix -> float
float op integer -> float
float op float -> float
[Class Variables:]
[see also:]
Number
ShortFloat Fraction FixedPoint Integer
FloatArray DoubleArray
[author:]
Claus Gittinger
"
!
errorHandling
"
Floating point error handling and signalling depends on the systems
(actually: the C-runtime systems) ability to handle floating point errors.
Most systems report errors by raising an OS floatingPoint exception,
which is mapped to a fpExceptionInterrupt in ST/X.
However, some systems do return NaN as result.
Currently, ST/X does not care specially for these systems - it maybe added
easily, if there is sufficient customer interest, though.
Try:
|f1 f2|
f1 := 1.0.
f2 := 0.0.
f1 / f2
or:
2 arcSin
"
! !
!Float class methodsFor:'initialization'!
initialize
DefaultPrintFormat := '.6' "/ 6 valid digits
"
DefaultPrintFormat := '.9'
DefaultPrintFormat := '.6'
"
! !
!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);
%}
!
fastFromString:aString at:startIndex
"return the next Float from the string starting at startIndex.
No spaces are skipped.
This is a specially tuned entry (using a low-level C-call), which
returns garbage if the argument string is not a valid float number.
It has been added to allow higher speed string decomposition into
numbers."
%{
if (__isString(aString) && __isSmallInteger(startIndex)) {
char *cp = (char *)(__stringVal(aString));
int idx = __intVal(startIndex) - 1;
double atof();
double val;
if ((unsigned)idx < __stringSize(aString)) {
val = atof(cp + idx);
RETURN (__MKFLOAT(val));
}
}
%}.
self primitiveFailed.
"
Float fastFromString:'123.45' at:1
Float fastFromString:'123.45' at:2
Float fastFromString:'123.45E4' at:1
Float fastFromString:'hello123.45E4' at:6
Float fastFromString:'12345' at:1
Float fastFromString:'12345' at:2
Float fastFromString:'12345' at:3
Float fastFromString:'12345' at:4
Float fastFromString:'12345' at:5
Float fastFromString:'12345' at:6
Float fastFromString:'12345' at:0
Float fastFromString:'hello123.45E4' at:1
Time millisecondsToRun:[
100000 timesRepeat:[
Float readFrom:'123.45'
]
]
"
"
Time millisecondsToRun:[
100000 timesRepeat:[
Float fastFromString:'123.45' at:1
]
]
"
!
fromVAXFloatBytes:b1 b2:b2 b3:b3 b4:b4
"creates a double, given the four vax float bytes to an ieee double.
For NaNs and Infinity, nil is returned.
"
%{ /* NOCONTEXT */
REGISTER union {
unsigned char b[4];
unsigned int l;
float f;
} r;
#ifdef i386 /* actually: LSBFIRST */
r.b[3] = __intVal( b2 );
r.b[2] = __intVal( b1 );
r.b[1] = __intVal( b4 );
r.b[0] = __intVal( b3 );
#else
r.b[0] = __intVal( b2 );
r.b[1] = __intVal( b1 );
r.b[2] = __intVal( b4 );
r.b[3] = __intVal( b3 );
#endif
if( (r.l & 0xff800000) != 0x80000000 )
{
if( (r.l & 0x7f800000) > 0x01000000 )
r.l -= 0x01000000;
else
r.l = 0;
RETURN( __MKFLOAT(r.f) );
}
%}.
^ nil
!
readFrom:aStringOrStream onError:exceptionBlock
"read a float from a string"
|num|
num := super readFrom:aStringOrStream onError:nil.
num isNil ifTrue:[
^ exceptionBlock value
].
^ num asFloat
"
Float readFrom:'0.1'
Float readFrom:'0'
"
"Created: / 7.1.1998 / 16:17:19 / cg"
"Modified: / 7.1.1998 / 16:18:33 / cg"
! !
!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)
"
self isIEEEFormat ifFalse:[self error:'unsupported operation'].
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)
"
self isIEEEFormat ifFalse:[self error:'unsupported operation'].
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)
"
self isIEEEFormat ifFalse:[self error:'unsupported operation'].
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)
"
self isIEEEFormat ifFalse:[self error:'unsupported operation'].
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'!
NaN
"return the constant NaN (not a Number).
Do not use (yet) - for now, this is only defined for a
few selected architectures."
%{
#if defined(LINUX) && defined(i386)
# ifdef NAN
RETURN (__MKFLOAT(NAN));
# else
RETURN (__MKFLOAT(_SNAN));
# endif
#endif
%}.
^ nil
"
Float NaN
Float NaN + 0.0
Float NaN + Float NaN
0.0 + Float NaN
"
!
pi
"return the constant pi as Float"
"/ dont expect this many valid digits on all machines;
"/ The actual precision is very CPU specific.
"/ ^ 3.14159265358979323846264338327950288
^ 3.14159265358979323846264338327950288419716939937510582097494459
"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'!
hasSharedInstances
"return true if this class has shared instances, that is, instances
with the same value are identical.
Although not really shared, floats should be treated
so, to be independent of the implementation of the arithmetic methods."
^ true
!
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"
!
isIEEEFormat
"return true, if this machine represents floats in IEEE format.
Currently, no support is provided for non-ieee machines
to convert their floats into this (which is only relevant,
if such a machine wants to send floats as binary to some other
machine).
Machines with non-IEEE format are VAXed and IBM370-type systems
(among others). Today, most systems use IEEE format floats."
^ true "/ this may be a lie
! !
!Float methodsFor:'arithmetic'!
* aNumber
"return the product of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
/*
* notice:
* the following inline code handles some common cases,
* and exists as an optimization, to speed up those cases.
*
* Conceptionally, (and for most other argument types),
* mixed arithmetic is implemented by double dispatching
* (see the message send at the bottom)
*/
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;
}
if (__isShortFloat(aNumber)) {
result = __floatVal(self) * (double)(__shortFloatVal(aNumber));
goto retResult;
}
%}.
^ aNumber productFromFloat:self
!
+ aNumber
"return the sum of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
/*
* notice:
* the following inline code handles some common cases,
* and exists as an optimization, to speed up those cases.
*
* Conceptionally, (and for most other argument types),
* mixed arithmetic is implemented by double dispatching
* (see the message send at the bottom)
*/
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;
}
if (__isShortFloat(aNumber)) {
result = __floatVal(self) + (double)(__shortFloatVal(aNumber));
goto retResult;
}
%}.
^ aNumber sumFromFloat:self
!
- aNumber
"return the difference of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
/*
* notice:
* the following inline code handles some common cases,
* and exists as an optimization, to speed up those cases.
*
* Conceptionally, (and for most other argument types),
* mixed arithmetic is implemented by double dispatching
* (see the message send at the bottom)
*/
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;
}
if (__isShortFloat(aNumber)) {
result = __floatVal(self) - (double)(__shortFloatVal(aNumber));
goto retResult;
}
%}.
^ aNumber differenceFromFloat:self
!
/ aNumber
"return the quotient of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
/*
* notice:
* the following inline code handles some common cases,
* and exists as an optimization, to speed up those cases.
*
* Conceptionally, (and for most other argument types),
* mixed arithmetic is implemented by double dispatching
* (see the message send at the bottom)
*/
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;
}
} else if (__isShortFloat(aNumber)) {
val = (double)(__shortFloatVal(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 raiseRequestWith:thisContext.
].
^ aNumber quotientFromFloat:self
!
abs
"return the absolute value of the receiver
reimplemented here for speed"
%{ /* NOCONTEXT */
OBJ newFloat;
double val =__floatVal(self);
double rslt;
if (val < 0.0) {
rslt = -val;
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
RETURN (self);
%}.
^ super abs
"
3.0 abs
-3.0 abs
"
!
negated
"return myself negated"
%{ /* NOCONTEXT */
OBJ newFloat;
double rslt = - __floatVal(self);
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
%}.
^ 0.0 - self
!
uncheckedDivide:aNumber
"return the quotient of the receiver and the argument, aNumber.
Do not check for divide by zero (return NaN or infinity)"
%{ /* NOCONTEXT */
OBJ newFloat;
double result, val;
if (__isSmallInteger(aNumber)) {
result = __floatVal(self) / ( (double)__intVal(aNumber)) ;
retResult:
__qMKFLOAT(newFloat, result);
RETURN ( newFloat );
} else if (__isFloatLike(aNumber)) {
val = __floatVal(aNumber);
result = __floatVal(self) / val;
goto retResult;
}
%}
.
^ aNumber quotientFromFloat:self
"
0.0 uncheckedDivide:0.0
1.0 uncheckedDivide:0.0
"
! !
!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:'coercing & converting'!
asDouble
"ST80 compatibility: return a float with same value - thats me"
^ self
!
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"
!
asLongFloat
"return a longFloat with same value as receiver"
%{ /* NOCONTEXT */
#ifdef LONGFLOAT
OBJ dummy = @global(LongFloat);
OBJ newFloat;
LONGFLOAT fVal = (LONGFLOAT)__floatVal(self);
__qMKLFLOAT(newFloat, fVal);
RETURN ( newFloat );
#endif
%}.
^ self
"
123 asFloat asLongFloat
"
"Created: / 7.9.2001 / 13:43:04 / cg"
"Modified: / 7.9.2001 / 13:43:16 / cg"
!
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 );
%}
!
asTrueFraction
"Answer a fraction that EXACTLY represents self,
a double precision IEEE floating point number.
Floats are stored in the same form on all platforms.
(Does not handle gradual underflow or NANs.)
By David N. Smith with significant performance
improvements by Luciano Esteban Notarfrancesco.
(Version of 11April97)"
|shifty sign expPart exp fraction fractionPart result zeroBitsCount|
self isInfinite ifTrue: [self error: 'Cannot represent infinity as a fraction'].
self isNaN ifTrue: [self error: 'Cannot represent Not-a-Number as a fraction'].
"Extract the bits of an IEEE double float "
UninterpretedBytes isBigEndian ifTrue:[
"/ shifty := ((self basicAt: 1) bitShift: 32) + (self basicAt: 2).
shifty := LargeInteger basicNew numberOfDigits:8.
1 to:8 do:[:i | shifty digitAt:(9-i) put:(self basicAt:i)].
] ifFalse:[
shifty := LargeInteger basicNew numberOfDigits:8.
1 to:8 do:[:i | shifty digitAt:i put:(self basicAt:i)].
].
" Extract the sign and the biased exponent "
sign := (shifty bitShift: -63) = 0 ifTrue: [1] ifFalse: [-1].
expPart := (shifty bitShift: -52) bitAnd: 16r7FF.
" Extract fractional part; answer 0 if this is a true 0.0 value "
fractionPart := shifty bitAnd: 16r000FFFFFFFFFFFFF.
( expPart=0 and: [ fractionPart=0 ] ) ifTrue: [ ^ 0 ].
" Replace omitted leading 1 in fraction "
fraction := fractionPart bitOr: 16r0010000000000000.
"Unbias exponent: 16r3FF is bias; 52 is fraction width"
exp := 16r3FF + 52 - expPart.
" Form the result. When exp>52, the exponent is adjusted by
the number of trailing zero bits in the fraction to minimize
the (huge) time otherwise spent in #gcd:. "
exp negative ifTrue: [
result := sign * fraction bitShift: exp negated
] ifFalse:[
zeroBitsCount := fraction lowBit - 1.
exp := exp - zeroBitsCount.
exp <= 0 ifTrue: [
zeroBitsCount := zeroBitsCount + exp.
"exp := 0." " Not needed; exp not refernced again "
result := sign * fraction bitShift:zeroBitsCount negated
] ifFalse: [
result := Fraction
numerator: (sign * fraction bitShift: zeroBitsCount negated)
denominator: (1 bitShift:exp)
]
].
"Low cost validation omitted after extensive testing"
"(result asFloat = self) ifFalse: [self error: 'asTrueFraction validation failed']."
^ result
"
0.3 asTrueFraction
1.25 asTrueFraction
0.25 asTrueFraction
-0.25 asTrueFraction
3e37 asTrueFraction
"
!
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 (aNumber != nil) {
if (__isSmallInteger(aNumber)) {
RETURN ( (__floatVal(self) < (double)(__intVal(aNumber))) ? true : false );
}
if (__qIsFloatLike(aNumber)) {
RETURN ( (__floatVal(self) < __floatVal(aNumber)) ? true : false );
}
}
%}.
^ aNumber lessFromFloat:self
!
<= aNumber
"return true, if the argument is greater or equal"
%{ /* NOCONTEXT */
if (aNumber != nil) {
if (__isSmallInteger(aNumber)) {
RETURN ( (__floatVal(self) <= (double)(__intVal(aNumber))) ? true : false );
}
if (__qIsFloatLike(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 (aNumber != nil) {
if (__isSmallInteger(aNumber)) {
RETURN ( (__floatVal(self) == (double)(__intVal(aNumber))) ? true : false );
}
if (__qIsFloatLike(aNumber)) {
RETURN ( (__floatVal(self) == __floatVal(aNumber)) ? true : false );
}
if (__qClass(aNumber)==ShortFloat) {
RETURN ( (__floatVal(self) == (double)(__shortFloatVal(aNumber))) ? true : false );
}
} else {
RETURN (false);
}
%}.
^ self retry:#= coercing:aNumber
!
> aNumber
"return true, if the argument is less"
%{ /* NOCONTEXT */
if (aNumber != nil) {
if (__isSmallInteger(aNumber)) {
RETURN ( (__floatVal(self) > (double)(__intVal(aNumber))) ? true : false );
}
if (__qIsFloatLike(aNumber)) {
RETURN ( (__floatVal(self) > __floatVal(aNumber)) ? true : false );
}
}
%}.
^ self retry:#> coercing:aNumber
!
>= aNumber
"return true, if the argument is less or equal"
%{ /* NOCONTEXT */
if (aNumber != nil) {
if (__isSmallInteger(aNumber)) {
RETURN ( (__floatVal(self) >= (double)(__intVal(aNumber))) ? true : false );
}
if (__qIsFloatLike(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:16r1F) bitShift:24) +
((self basicAt:7) bitShift:16) +
((self basicAt:6) bitShift:8) +
(((self basicAt:5) + (self basicAt:1) + (self basicAt:2)) bitAnd:16rFF)
"
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 (aNumber != nil) {
if (__isSmallInteger(aNumber)) {
RETURN ( (__floatVal(self) != (double)(__intVal(aNumber))) ? true : false );
}
if (__qIsFloatLike(aNumber)) {
RETURN ( (__floatVal(self) != __floatVal(aNumber)) ? true : false );
}
} else {
RETURN (true);
}
%}.
^ self retry:#~= coercing:aNumber
! !
!Float methodsFor:'mathematical functions'!
arcCos
"return the arccosine of myself (I am interpreted as radians).
Raises an exception, if the receiver is not in -1..1"
%{ /* NOCONTEXT */
double val, rslt;
OBJ newFloat;
val = __floatVal(self);
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
if ((val >= -1.0) && (val <= 1.0))
#endif
{
__threadErrno = 0;
rslt = acos(val);
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
{
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
}
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#arcCos
arguments:#()
errorString:'bad receiver in arcCos'
"
-10 arcCos
1 arcCos
"
"Modified: / 16.11.2001 / 14:14:13 / cg"
!
arcSin
"return the arcsine of myself (I am interpreted as radians).
Raises an exception, if the receiver is not in -1..1"
%{ /* NOCONTEXT */
double val, rslt;
OBJ newFloat;
val = __floatVal(self);
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
if ((val >= -1.0) && (val <= 1.0))
#endif
{
__threadErrno = 0;
rslt = asin(val);
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
{
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
}
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#arcSin
arguments:#()
errorString:'bad receiver in arcSin'
"
-10 arcSin
1 arcSin
"
"Modified: / 16.11.2001 / 14:14:18 / cg"
!
arcTan
"return the arctangent of myself as radians"
%{ /* NOCONTEXT */
double rslt;
OBJ newFloat;
__threadErrno = 0;
rslt = atan(__floatVal(self));
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#arcTan
arguments:#()
errorString:'bad receiver in arcTan'
"Modified: / 16.11.2001 / 14:14:22 / cg"
!
cos
"return the cosine of myself interpreted as radians"
%{ /* NOCONTEXT */
double rslt;
OBJ newFloat;
__threadErrno = 0;
rslt = cos(__floatVal(self));
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#cos
arguments:#()
errorString:'bad receiver in cos'
"Modified: / 16.11.2001 / 14:14:26 / cg"
!
exp
"return e raised to the power of the receiver"
%{ /* NOCONTEXT */
double rslt;
OBJ newFloat;
__threadErrno = 0;
rslt = exp(__floatVal(self));
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#exp
arguments:#()
errorString:'bad receiver in exp'
"Modified: / 16.11.2001 / 14:14:29 / cg"
!
ln
"return the natural logarithm of myself.
Raises an exception, if the receiver is less or equal to zero."
%{ /* NOCONTEXT */
double val, rslt;
OBJ newFloat;
val = __floatVal(self);
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
if (val > 0.0)
#endif
{
__threadErrno = 0;
rslt = log(val);
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
{
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
}
}
%}.
"
an invalid value for logarithm
"
^ self class
raise:#domainErrorSignal
receiver:self
selector:#ln
arguments:#()
errorString:'bad receiver in ln'
"Modified: / 16.11.2001 / 14:14:33 / cg"
!
raisedTo:aNumber
"return self raised to the power of aNumber"
|n|
n := aNumber asFloat.
%{
double rslt;
OBJ newFloat;
if (__isFloatLike(n)) {
__threadErrno = 0;
rslt = pow(__floatVal(self), __floatVal(n));
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
}
%}.
"
an invalid argument (not convertable to float ?)
"
^ self class
raise:#domainErrorSignal
receiver:self
selector:#raisedTo:
arguments:(Array with:aNumber)
errorString:'bad receiver/arg in raisedTo:'
"Modified: / 16.11.2001 / 14:16:51 / cg"
!
sin
"return the sine of myself interpreted as radians"
%{ /* NOCONTEXT */
double rslt;
OBJ newFloat;
__threadErrno = 0;
rslt = sin(__floatVal(self));
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#sin
arguments:#()
errorString:'bad receiver in sin'
"Modified: / 16.11.2001 / 14:14:37 / cg"
!
sqrt
"return the square root of myself.
Raises an exception, if the receiver is less than zero."
%{ /* NOCONTEXT */
double val, rslt;
OBJ newFloat;
val = __floatVal(self);
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
if (val >= 0.0)
#endif
{
__threadErrno = 0;
rslt = sqrt(val);
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
{
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
}
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#sqrt
arguments:#()
errorString:'bad receiver in sqrt'
"
10 sqrt
-10 sqrt
"
"Modified: / 16.11.2001 / 14:14:43 / cg"
!
tan
"return the tangent of myself interpreted as radians"
%{ /* NOCONTEXT */
double rslt;
OBJ newFloat;
__threadErrno = 0;
rslt = tan(__floatVal(self));
#ifdef LINUX /* and maybe others */
if (! isnan(rslt))
#endif
if (__threadErrno == 0) {
__qMKFLOAT(newFloat, rslt);
RETURN ( newFloat );
}
%}.
^ self class
raise:#domainErrorSignal
receiver:self
selector:#tan
arguments:#()
errorString:'bad receiver in tan'
"Modified: / 16.11.2001 / 14:14:49 / cg"
! !
!Float methodsFor:'printing & storing'!
printString
"return a printed representation of the receiver;
if not specified otherwise (by setting DefaultPrintFormat),
6 valid digits are printed.
LimitedPrecisonReal and its subclasses use #printString instead of
#printOn: as basic print mechanism."
%{ /* NOCONTEXT */
char buffer[64];
REGISTER char *cp;
OBJ s;
char *fmt;
char fmtBuffer[20];
if (__isString(@global(DefaultPrintFormat))) {
fmt = (char *) __stringVal(@global(DefaultPrintFormat));
} else {
/*
* in case we get called before #initialize ...
*/
fmt = ".6";
}
/*
* build a printf format string
*/
fmtBuffer[0] = '%';
strncpy(fmtBuffer+1, fmt, 10);
#ifdef SYSV
strcat(fmtBuffer, "lg");
#else
strcat(fmtBuffer, "G");
#endif
sprintf(buffer, fmtBuffer, __floatVal(self));
/*
* 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') || (*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
(1.0 uncheckedDivide:0) printString
(0.0 uncheckedDivide:0) 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)) {
sprintf(buffer, __stringVal(formatString), __floatVal(self));
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 (((unsigned)(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 (((unsigned)(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:'queries'!
basicSize
"return the size in bytes of the float.
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 */
RETURN (__MKSMALLINT(sizeof(double)));
%}.
!
defaultNumberOfDigits
"Answer how many digits of accuracy this class supports"
^ 14
! !
!Float methodsFor:'special access'!
exponent
"extract a normalized floats exponent.
The returned value depends on the float-representation of
the underlying machine and is therefore highly unportable.
This is not for general use.
This assumes that the mantissa is normalized to
0.5 .. 1.0 and the floats value is mantissa * 2^exp"
%{ /* NOCONTEXT */
double frexp();
double frac;
INT exp;
__threadErrno = 0;
frac = frexp(__floatVal(self), &exp);
if (__threadErrno == 0) {
RETURN (__MKSMALLINT(exp));
}
%}.
^ self primitiveFailed
"
1.0 exponent
2.0 exponent
3.0 exponent
4.0 exponent
0.5 exponent
0.4 exponent
0.25 exponent
0.00000011111 exponent
"
!
mantissa
"extract a normalized floats mantissa.
The returned value depends on the float-representation of
the underlying machine and is therefore highly unportable.
This is not for general use.
This assumes that the mantissa is normalized to
0.5 .. 1.0 and the floats value is mantissa * 2^exp"
%{ /* NOCONTEXT */
double frexp();
double frac;
INT exp;
__threadErrno = 0;
frac = frexp(__floatVal(self), &exp);
if (__threadErrno == 0) {
RETURN (__MKFLOAT(frac));
}
%}.
^ self primitiveFailed
"
1.0 exponent
1.0 mantissa
0.25 exponent
0.25 mantissa
0.00000011111 exponent
0.00000011111 mantissa
"
! !
!Float methodsFor:'testing'!
isFinite
"return true, if the receiver is a finite float
i.e. not NaN and not infinite."
%{ /* NOCONTEXT */
double dV = __floatVal(self);
/*
* notice: on machines which do not provide
* a finite() macro or function (WIN32),
* this may always ret true here ...
*/
if (finite(dV)) {
RETURN (true);
}
%}.
^false
"
1.0 isFinite
(0.0 uncheckedDivide: 0.0) isFinite
(1.0 uncheckedDivide: 0.0) isFinite
"
!
isInfinite
"return true, if the receiver is an infinite float (Inf).
These are not created by ST/X float operations (they raise an exception);
however, inline C-code could produce them ...
Redefined here for speed"
%{ /* NOCONTEXT */
double dV = __floatVal(self);
/*
* notice: on machines which do not provide
* finite() & isnan() macros or functions (WIN32),
* this may always ret false here ...
*/
#if defined(isinf) || defined(LINUX)
if (isinf(dV)) { RETURN (true); }
#else
if (!finite(dV) && !isnan(dV)) { RETURN (true); }
#endif
%}.
^ false
"
1.0 isInfinite
(0.0 uncheckedDivide: 0.0) isInfinite
(1.0 uncheckedDivide: 0.0) isInfinite
"
!
isLiteral
"return true, if the receiver can be used as a literal constant in ST syntax
(i.e. can be used in constant arrays)"
^ true
!
isNaN
"return true, if the receiver is an invalid float (NaN - not a number).
These are not created by ST/X float operations (they raise an exception);
however, inline C-code could produce them ..."
%{ /* NOCONTEXT */
double dV = (__floatVal(self));
if (isnan(dV)) { RETURN (true); }
#if 0 /* Currently all our systems support isnan()
* If not, you have to fix librun/jinterpret.c also.
*/
/*
* sigh - every vendor is playing its own game here ...
* Q: what are standards worth, anyway ?
*/
#ifdef IS_NAN
if (IS_NAN(dV)) { RETURN (true); }
RETURN (false);
#endif
#ifdef IS_QNAN
if (IS_QNAN(dV)) { RETURN (true); }
RETURN (false);
#endif
#ifdef FLT_SNAN
if (dV == FLT_SNAN) { RETURN (true); }
RETURN (false);
#endif
#ifdef FLT_QNAN
if (dV == FLT_QNAN) { RETURN (true); }
RETURN (false);
#endif
#ifdef _SNANF
if (dV == _SNAN) { RETURN (true); }
RETURN (false);
#endif
#ifdef _QNANF
if (dV == _QNAN) { RETURN (true); }
RETURN (false);
#endif
#ifdef IsPosNAN
if IsPosNAN(dV) { RETURN (true); }
RETURN (false);
#endif
#ifdef IsNegNAN
if IsNegNAN(dV) { RETURN (true); }
RETURN (false);
#endif
#ifdef NAN
if (dV == NAN) { RETURN (true); }
RETURN (false);
#endif
#ifdef NaN
if (NaN(dV)) { RETURN (true); }
RETURN (false);
#endif
#endif /* 0 */
%}.
^ false
"
1.0 isNaN
(0.0 uncheckedDivide: 0.0) isNaN
"
!
negative
"return true if the receiver is less than zero"
%{ /* NOCONTEXT */
RETURN ( (__floatVal(self) < 0.0) ? true : false );
%}.
^ self < 0.0
!
numberOfBits
"return the size (in bits) of the real;
typically, 64 is returned here,
but who knows ..."
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT (sizeof(double) * 8));
%}
"
1.2 numberOfBits
1.2 asShortFloat numberOfBits
"
!
positive
"return true if the receiver is greater or equal to zero"
%{ /* NOCONTEXT */
RETURN ( (__floatVal(self) >= 0.0) ? true : false );
%}
!
strictlyPositive
"return true if the receiver is greater than zero"
%{ /* NOCONTEXT */
RETURN ( (__floatVal(self) > 0.0) ? true : false );
%}
! !
!Float methodsFor:'tracing'!
traceInto:aRequestor level:level from:referrer
"double dispatch into tracer, passing my type implicitely in the selector"
^ aRequestor traceFloat:self level:level from:referrer
! !
!Float methodsFor:'truncation & rounding'!
ceiling
"return the smallest integer which is greater or equal to the receiver."
|val|
%{
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 ) );
}
__qMKFLOAT(val, dVal);
%}.
^ val asInteger
!
ceilingAsFloat
"return the smallest integer-valued float greater or equal to the receiver.
This is much like #ceiling, but avoids a (possibly expensive) conversion
of the result to an integer.
It may be useful, if the result is to be further used in another
float-operation."
%{ /* NOCONTEXT */
double dVal;
OBJ val;
/*
* ST-80 (and X3J20) returns integer.
*/
dVal = ceil(__floatVal(self));
__qMKFLOAT(val, dVal);
RETURN (val);
%}
!
floor
"return the integer nearest the receiver towards negative infinity."
|val|
%{
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 ) );
}
__qMKFLOAT(val, dVal);
%}.
^ val asInteger
"
0.5 floor
0.5 floorAsFloat
-0.5 floor
-0.5 floorAsFloat
"
!
floorAsFloat
"return the integer nearest the receiver towards negative infinity
as a float.
This is much like #floor, but avoids a (possibly expensive) conversion
of the result to an integer.
It may be useful, if the result is to be further used in another
float-operation."
%{ /* NOCONTEXT */
double dVal;
OBJ v;
dVal = floor(__floatVal(self));
__qMKFLOAT(v, dVal);
RETURN (v);
%}
"
0.5 floor
0.5 floorAsFloat
-0.5 floor
-0.5 floorAsFloat
"
!
fractionPart
"extract the after-decimal fraction part.
the floats value is
float truncated + float fractionalPart"
%{ /* NOCONTEXT */
double modf();
double frac, trunc;
__threadErrno = 0;
frac = modf(__floatVal(self), &trunc);
if (__threadErrno == 0) {
RETURN (__MKFLOAT(frac));
}
%}.
^ self primitiveFailed
"
1.0 fractionPart
2.0 fractionPart
3.0 fractionPart
4.0 fractionPart
0.5 fractionPart
0.25 fractionPart
3.14159 fractionPart
12345673.14159 fractionPart
123456731231231231.14159 fractionPart
3.14159 fractionPart + 3.14159 truncated
12345673.14159 fractionPart + 12345673.14159 truncated
123456731231231231.14159 fractionPart + 123456731231231231.14159 truncated
"
!
rounded
"return the receiver rounded to the nearest integer"
|val|
%{
double dVal;
dVal = __floatVal(self);
if (dVal < 0.0) {
dVal = ceil(dVal - 0.5);
} else {
dVal = floor(dVal + 0.5);
}
/*
* ST-80 (and X3J20) returns integer.
*/
if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
RETURN ( __MKSMALLINT( (INT) dVal ) );
}
__qMKFLOAT(val, dVal);
%}.
val notNil ifTrue:[
^ val asInteger
].
self < 0.0 ifTrue:[
^ (self - 0.5) ceiling asInteger
].
^ (self + 0.5) floor asInteger
"
0.4 rounded
0.5 rounded
0.6 rounded
-0.4 rounded
-0.5 rounded
-0.6 rounded
"
!
roundedAsFloat
"return the receiver rounded to the nearest integer as a float.
This is much like #rounded, but avoids a (possibly expensive) conversion
of the result to an integer.
It may be useful, if the result is to be further used in another
float-operation."
|val|
%{ /* NOCONTEXT */
double dVal;
OBJ v;
dVal = __floatVal(self);
if (dVal < 0.0) {
dVal = ceil(dVal - 0.5);
} else {
dVal = floor(dVal + 0.5);
}
__qMKFLOAT(v, dVal);
RETURN (v);
%}
"
0.5 rounded
-0.5 rounded
0.5 roundedAsFloat
-0.5 roundedAsFloat
"
!
truncated
"return the receiver truncated towards zero as an integer"
|val|
%{
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 ) );
}
__qMKFLOAT(val, dVal);
%}.
^ val asInteger
"
0.5 truncated
-0.5 truncated
0.5 truncatedAsFloat
-0.5 truncatedAsFloat
"
!
truncatedAsFloat
"return the receiver truncated towards zero as a float.
This is much like #truncated, but avoids a (possibly expensive) conversion
of the result to an integer.
It may be useful, if the result is to be further used in another
float-operation."
%{ /* NOCONTEXT */
double dVal;
OBJ v;
dVal = __floatVal(self);
if (dVal < 0.0) {
dVal = ceil(dVal);
} else {
dVal = floor(dVal);
}
__qMKFLOAT(v, dVal);
RETURN (v);
%}
"
0.5 truncated
-0.5 truncated
0.5 truncatedAsFloat
-0.5 truncatedAsFloat
"
! !
!Float class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.123 2001-12-18 13:46:10 cg Exp $'
! !
Float initialize!