#FEATURE by cg
class: Socket class
added: #newTCPclientToHost:port:domain:domainOrder:withTimeout:
changed: #newTCPclientToHost:port:domain:withTimeout:
"{ Encoding: utf8 }"
"
COPYRIGHT (c) 2018 by eXept Software AG
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:libbasic2' }"
"{ NameSpace: Smalltalk }"
LimitedPrecisionReal variableByteSubclass:#OctaFloat
instanceVariableNames:''
classVariableNames:'OctaFloatZero OctaFloatOne Pi E Epsilon NaN PositiveInfinity
NegativeInfinity Halfpi HalfpiNegative Phi'
poolDictionaries:''
category:'Magnitude-Numbers'
!
!OctaFloat primitiveDefinitions!
%{
#ifdef __xxosx__
# define SUPPORT_OCTAFLOAT
#endif
#include <math.h>
extern float256_t STX_addQ(float256_t, float256_t, int);
extern float256_t STX_mulQ(float256_t, float256_t);
extern float256_t STX_divQ(float256_t, float256_t);
extern float256_t STX_negQ(float256_t);
extern float256_t STX_absQ(float256_t);
extern float256_t STX_floorQ(float256_t);
extern float256_t STX_frexpQ(float256_t, int*);
extern float256_t STX_ceilQ(float256_t);
extern float256_t STX_logQ(float256_t);
extern float256_t STX_log10Q(float256_t);
extern float256_t STX_log2Q(float256_t);
extern float256_t STX_expQ(float256_t);
extern float256_t STX_sinQ(float256_t);
extern float256_t STX_cosQ(float256_t);
extern float256_t STX_tanQ(float256_t);
extern float256_t STX_sinhQ(float256_t);
extern float256_t STX_coshQ(float256_t);
extern float256_t STX_tanhQ(float256_t);
extern float256_t STX_asinQ(float256_t);
extern float256_t STX_acosQ(float256_t);
extern float256_t STX_atanQ(float256_t);
extern float256_t STX_asinhQ(float256_t);
extern float256_t STX_acoshQ(float256_t);
extern float256_t STX_atanhQ(float256_t);
extern float256_t STX_QZero;
extern float256_t STX_dbltoQ(double);
extern float256_t STX_inttoQ(long);
extern double STX_Qtodbl(float256_t);
extern int STX_isNanQ(float256_t*);
extern int STX_prcmpQ(float256_t*, float256_t*);
#define STX_isfiniteQ(q) (!STX_isNanQ(&(q)) && !STX_isInfQ(&(q)))
#define STX_eqQ(x1, x2) (STX_prcmpQ (&(x1), &(x2)) == 0)
#define STX_neqQ(x1, x2) (STX_prcmpQ (&(x1), &(x2)) != 0)
#define STX_gtQ(x1, x2) (STX_prcmpQ (&(x1), &(x2)) > 0)
#define STX_geQ(x1, x2) (STX_prcmpQ (&(x1), &(x2)) >= 0)
#define STX_ltQ(x1, x2) (STX_prcmpQ (&(x1), &(x2)) < 0)
#define STX_leQ(x1, x2) (STX_prcmpQ (&(x1), &(x2)) <= 0)
#ifdef __win32__
/*
* no finite(x) ?
* no isnan(x) ?
*/
# ifndef isnan
# define isnan(x) \
((((unsigned int *)(&x))[0] == 0x00000000) && \
(((unsigned int *)(&x))[1] == 0xFFF80000))
# endif
# ifndef isPositiveInfinity
# define isPositiveInfinity(x) \
((((unsigned int *)(&x))[0] == 0x00000000) && \
(((unsigned int *)(&x))[1] == 0x7FF00000))
# endif
# ifndef isNegativeInfinity
# define isNegativeInfinity(x) \
((((unsigned int *)(&x))[0] == 0x00000000) && \
(((unsigned int *)(&x))[1] == 0xFFF00000))
# endif
# ifndef isinf
# define isinf(x) \
((((unsigned int *)(&x))[0] == 0x00000000) && \
((((unsigned int *)(&x))[1] & 0x7FF00000) == 0x7FF00000))
# endif
# ifndef isfinite
# define isfinite(x) (!isinf(x) && !isnan(x))
# endif
#else // not win32
#endif
%}
! !
!OctaFloat primitiveVariables!
%{
%}
! !
!OctaFloat primitiveFunctions!
%{
%}
! !
!OctaFloat class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2018 by eXept Software AG
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
"
OctaFloats represent rational numbers with limited precision
and are mapped to IEEE octuple precision format (256bit),
also called binary256.
Notice, that a software emulation is done, which is much slower.
Thus only use them, if you really need the additional precision;
if not, use Float (which are doubles) or LongFloats which usually have IEEE extended precision (80bit).
OctaFloats give you definite 256 bit quadruple floats,
thus, code using octaFloats is guaranteed to be portable from one architecture to another.
Representation:
256bit octuple IEEE floats (32bytes);
237 bit mantissa,
19 bit exponent,
71 decimal digits (approx.)
Mixed mode arithmetic:
octaFloat op anyFloat -> octaFloat
anyFloat op octaFloat -> octaFloat
Range and precision of storage formats: see LimitedPrecisionReal >> documentation
[author:]
Claus Gittinger
[see also:]
Number
Float ShortFloat LongFloat Fraction FixedPoint Integer Complex
FloatArray DoubleArray
https://en.wikipedia.org/wiki/Extended_precision
https://en.wikipedia.org/wiki/Octuple-precision_floating-point_format
"
! !
!OctaFloat class methodsFor:'instance creation'!
basicNew
"return a new octaFloat - here we return 0.0
- OctaFloats are usually NOT created this way ...
Its implemented here to allow things like binary store & load
of quadFloats.
(but it is not a good idea to store the bits of a float - the reader might have a
totally different representation - so floats should be
binary stored in a device independent format)."
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t qf = STX_QZero;
__qMKFLOAT256(newFloat, qf); /* OBJECT ALLOCATION */
RETURN (newFloat);
#endif /* SUPPORT_QUADFLOAT */
%}.
self error:'OctaFloats not supported on this patform'
"Created: / 06-06-2019 / 17:18:58 / Claus Gittinger"
!
fromFloat:aFloat
"return a new quadFloat, given a float value"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
if (__isFloatLike(aFloat)) {
double f = __floatVal(aFloat);
float256_t qf;
qf = STX_dbltoQ (f);
__qMKFLOAT256(newFloat, qf); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
#endif /* SUPPORT_OCTAFLOAT */
%}.
aFloat isFloat ifTrue:[
self errorUnsupported.
^ aFloat asLongFloat
].
ArgumentError raise
"
OctaFloat fromFloat:123.0
123.0 asOctaFloat
123 asOctaFloat
"
"Created: / 06-06-2019 / 18:01:03 / Claus Gittinger"
!
fromInteger:anInteger
"return a new quadFloat, given an integer value"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
if (__isSmallInteger(anInteger)) {
INT iVal = __intVal(anInteger);
float256_t qf;
qf = STX_inttoQ( (long)iVal );
__qMKFLOAT256(newFloat, qf); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
#endif /* SUPPORT_OCTAFLOAT */
%}.
^ super fromInteger:anInteger
"
OctaFloat fromInteger:123
123 asOctaFloat
"
!
fromLongFloat:aFloat
"return a new quadFloat, given a long float value"
%{ /* NOCONTEXT */
#ifdef xSUPPORT_OCTAFLOAT
OBJ newFloat;
union {
LONGFLOAT_t lf; // is long double
extFloat80_t ef; // is 80bit ext
float256_t qf; // is 128bit quad
} u;
if (__isLongFloat(aFloat)) {
u.lf = __longFloatVal(aFloat);
if (sizeof(LONGFLOAT_t) == 16) {
// longFloat is already 128 bits in size (sparc)
__qMKFLOAT256(newFloat, u.qf); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
if (sizeof(LONGFLOAT_t) < 16) {
// assume 80bit extended float format (amd64, x86_64)
u.qf = extF80_to_f128( u.ef);
__qMKFLOAT256(newFloat, u.qf); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
// fall into error case
}
#endif /* SUPPORT_OCTAFLOAT */
%}.
aFloat isLongFloat ifTrue:[
self errorUnsupported.
^ aFloat
].
ArgumentError raise
"
OctaFloat fromLongFloat:123.0 asLongFloat
"
!
fromShortFloat:aShortFloat
"return a new quadFloat, given a float value"
^ self fromFloat:(aShortFloat asFloat)
"
OctaFloat fromShortFloat:123.0 asShortFloat
"
"Created: / 08-06-2019 / 03:28:37 / Claus Gittinger"
! !
!OctaFloat class methodsFor:'coercing & converting'!
coerce:aNumber
"convert the argument aNumber into an instance of the receiver (class) and return it."
^ aNumber asOctaFloat.
"Created: / 06-06-2019 / 16:51:01 / Claus Gittinger"
! !
!OctaFloat class methodsFor:'constants'!
NaN
"return a quadFloat which represents not-a-Number (i.e. an invalid number)"
|nan|
NaN isNil ifTrue:[
%{ /* NOCONTEXT */
#ifdef xSUPPORT_OCTAFLOAT
{
OBJ newFloat;
float256_t qf;
softfloat_commonNaNToF128M( (uint32_t*)(&qf) );
__qMKFLOAT256(newFloat, qf); /* OBJECT ALLOCATION */
nan = newFloat;
}
#endif /* SUPPORT_OCTAFLOAT */
%}.
nan isNil ifTrue:[
self errorUnsupported
].
NaN := nan
].
^ NaN
!
e
"return the constant e as quadFloat"
E isNil ifTrue:[
"/ eDigits has enough digits for 128bit IEEE quads
"/ do not use as a literal constant here - we cannot depend on the underlying C-compiler here...
E := self readFrom:(Number eDigits)
].
^ E
"Created: / 06-06-2019 / 17:01:54 / Claus Gittinger"
!
infinity
"return a quadFloat which represents +INF"
|inf|
PositiveInfinity isNil ifTrue:[
%{ /* NOCONTEXT */
#ifdef xSUPPORT_OCTAFLOAT
{
OBJ newFloat;
struct uint128 uiZ;
union ui128_f128 uZ;
float256_t qf;
uiZ.v64 = packToF128UI64( 0, 0x7FFF, 0 );
uiZ.v0 = 0;
uZ.ui = uiZ;
qf = uZ.f;
__qMKFLOAT256(newFloat, qf); /* OBJECT ALLOCATION */
inf = newFloat;
}
#endif /* SUPPORT_OCTAFLOAT */
%}.
inf isNil ifTrue:[
self errorUnsupported
].
PositiveInfinity := inf
].
^ PositiveInfinity
"Created: / 08-06-2019 / 14:05:26 / Claus Gittinger"
!
negativeInfinity
"return a quadFloat which represents -INF"
|inf|
NegativeInfinity isNil ifTrue:[
%{ /* NOCONTEXT */
#ifdef xSUPPORT_OCTAFLOAT
{
OBJ newFloat;
struct uint128 uiZ;
union ui128_f128 uZ;
float256_t qf;
uiZ.v64 = packToF128UI64( 1, 0x7FFF, 0 );
uiZ.v0 = 0;
uZ.ui = uiZ;
qf = uZ.f;
__qMKFLOAT256(newFloat, qf); /* OBJECT ALLOCATION */
inf = newFloat;
}
#endif /* SUPPORT_OCTAFLOAT */
%}.
inf isNil ifTrue:[
self errorUnsupported
].
NegativeInfinity := inf
].
^ NegativeInfinity
"Created: / 08-06-2019 / 14:05:50 / Claus Gittinger"
!
phi
"return the constant phi as quadFloat"
Phi isNil ifTrue:[
"/ phiDigits has enough digits for 128bit IEEE quads
"/ do not use as a literal constant here - we cannot depend on the underlying C-compiler here...
Phi := self readFrom:(Number phiDigits)
].
^ Phi
!
pi
"return the constant pi as quadFloat"
Pi isNil ifTrue:[
"/ piDigits has enough digits for 128bit IEEE quads
"/ do not use as a literal constant here - we cannot depend on the underlying C-compiler here...
Pi := self readFrom:(Number piDigits)
].
^ Pi
"Created: / 06-06-2019 / 17:09:51 / Claus Gittinger"
!
unity
"return the neutral element for multiplication (1.0) as OctaFloat"
OctaFloatOne isNil ifTrue:[
OctaFloatOne := 1.0 asOctaFloat.
].
^ OctaFloatOne
"Created: / 07-06-2019 / 03:26:38 / Claus Gittinger"
!
zero
"return the neutral element for addition (0.0) as OctaFloat"
OctaFloatZero isNil ifTrue:[
OctaFloatZero := 0.0 asOctaFloat
].
^ OctaFloatZero
"Created: / 07-06-2019 / 09:22:56 / Claus Gittinger"
! !
!OctaFloat class methodsFor:'error reportng'!
errorUnsupported
"you may proceed from this error, to get a long float number result
(of course, with less than expected precision)"
self errorUnsupported:'OctaFloats not supported on this patform'
"Created: / 07-06-2019 / 02:44:39 / Claus Gittinger"
"
UnimplementedFunctionalityError handle:[:ex |
ex proceed
] do:[
1.0 asQuadFloat
].
"
! !
!OctaFloat class methodsFor:'queries'!
epsilon
"return the maximum relative spacing of instances of mySelf
(i.e. the value-delta of the least significant bit)"
Epsilon isNil ifTrue:[
Epsilon := self computeEpsilon.
].
^ Epsilon
"
self epsilon
"
"Created: / 10-06-2019 / 21:21:18 / Claus Gittinger"
!
exponentCharacter
"return the character used to print between mantissa an exponent.
Also used by the scanner when reading numbers."
^ $O
"Created: / 10-06-2019 / 21:28:04 / Claus Gittinger"
!
numBitsInExponent
"answer the number of bits in the exponent.
This is a 256bit octuple float, where 19 bits are available in the exponent:
seeeeeee eeeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm...
"
^ 19
"
1.0 class numBitsInExponent -> 11
1.0 asShortFloat class numBitsInExponent -> 8
1.0 asLongFloat class numBitsInExponent -> 15
1.0 asQuadFloat class numBitsInExponent -> 15
1.0 asOctaFloat class numBitsInExponent -> 19
"
"Created: / 11-06-2019 / 00:14:55 / Claus Gittinger"
!
numBitsInMantissa
"answer the number of bits in the mantissa (the significant)
This is a 256bit quadfloat,
where 236 bits are available in the mantissa (the hidden bit is not counted here):
seeeeeee eeeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm...
"
^ 236
"
1.0 class numBitsInMantissa
1.0 asShortFloat class numBitsInMantissa
1.0 asLongFloat class numBitsInMantissa
1.0 asQuadFloat class numBitsInMantissa
1.0 asOctaFloat class numBitsInMantissa
"
"Created: / 07-06-2019 / 03:24:20 / Claus Gittinger"
!
radix
"answer the radix of a OctaFloat's exponent
This is an IEEE float, which is represented as binary"
^ 2 "must be careful here, whenever ST/X is used on VAX or a 370"
"Created: / 19-07-2019 / 17:28:00 / Claus Gittinger"
! !
!OctaFloat methodsFor:'arithmetic'!
* aNumber
"return the product of the receiver and the argument."
aNumber class == OctaFloat ifTrue:[
^ aNumber productFromOctaFloat:self
].
thisContext isReallyRecursive ifTrue:[self error].
^ aNumber productFromOctaFloat:self
!
+ aNumber
"return the sum of the receiver and the argument, aNumber"
^ aNumber sumFromOctaFloat:self
!
- aNumber
"return the difference of the receiver and the argument, aNumber"
^ aNumber differenceFromOctaFloat:self
!
/ aNumber
"return the quotient of the receiver and the argument, aNumber"
aNumber isZero ifTrue:[
"
No, you shalt not divide by zero
"
^ ZeroDivide raiseRequestWith:thisContext.
].
^ aNumber quotientFromOctaFloat:self
!
abs
"return the absolute value of the receiver
reimplemented here for speed"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_absQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
ceiling
"return the smallest integer which is greater or equal to the receiver."
|val|
%{
#ifdef SUPPORT_OCTAFLOAT
float256_t qVal;
float256_t qMinInt;
float256_t qMaxInt;
qVal = __octaFloatVal(self);
qVal = STX_ceilQ(qVal);
qMinInt = STX_dbltoQ((double)_MIN_INT);
qMaxInt = STX_dbltoQ((double)_MAX_INT);
if (STX_geQ(qVal, qMinInt) && STX_leQ(qVal, qMaxInt)) {
double dVal = STX_Qtodbl(qVal);
RETURN ( __mkSmallInteger( (INT) dVal ) );
}
__qMKFLOAT256(val, qVal);
#endif
%}.
^ val asInteger
"
0.5 asOctaFloat ceiling
0.5 asOctaFloat ceilingAsFloat
-0.5 asOctaFloat ceiling
-0.5 asOctaFloat ceilingAsFloat
"
!
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 */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_ceilQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
cos
"return the cosine of the receiver (interpreted as radians)"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_cosQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
cosh
"return the hyperbolic cosine of the receiver (interpreted as radians)"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_coshQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
exp
"return e raised to the power of the receiver"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_expQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
exponent
"extract a normalized float's (unbiased) 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 float's value is: mantissa * 2^exp"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
float256_t myVal;
float256_t frac;
int exp;
myVal = __octaFloatVal(self);
#if 1
// should we?
if (! (STX_isNanQ(&myVal) || STX_isInfQ(&myVal)))
#endif
{
frac = STX_frexpQ(myVal, &exp);
RETURN (__mkSmallInteger(exp));
}
#endif
%}.
^ super exponent
"
1.0 exponent
1.0 asOctaFloat exponent
2.0 exponent
2.0 asOctaFloat exponent
3.0 exponent
3.0 asOctaFloat exponent
4.0 exponent
4.0 asOctaFloat exponent
0.5 exponent
0.5 asOctaFloat exponent
0.4 exponent
0.4 asOctaFloat exponent
0.25 exponent
0.25 asOctaFloat exponent
0.2 exponent
0.2 asOctaFloat exponent
0.00000011111 exponent
0.00000011111 asOctaFloat exponent
0.0 exponent
0.0 asOctaFloat exponent
1e1000 exponent -> error (INF)
1e1000 asOctaFloat exponent -> error (INF)
"
!
floor
"return the integer nearest the receiver towards negative infinity."
|val|
%{
#ifdef SUPPORT_OCTAFLOAT
float256_t qVal;
float256_t qMinInt;
float256_t qMaxInt;
qVal = __octaFloatVal(self);
qVal = STX_floorQ(qVal);
qMinInt = STX_dbltoQ((double)_MIN_INT);
qMaxInt = STX_dbltoQ((double)_MAX_INT);
if (STX_geQ(qVal, qMinInt) && STX_leQ(qVal, qMaxInt)) {
double dVal = STX_Qtodbl(qVal);
RETURN ( __mkSmallInteger( (INT) dVal ) );
}
__qMKFLOAT256(val, qVal);
#endif
%}.
^ val asInteger
"
0.5 asOctaFloat floor
0.5 asOctaFloat floorAsFloat
-0.5 asOctaFloat floor
-0.5 asOctaFloat 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 */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_floorQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
ln
"return natural logarithm of the receiver."
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_logQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
log
"return log base 10 of the receiver.
Alias for log:10."
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_log10Q(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
log2
"return logarithm dualis of the receiver."
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_log2Q(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
mantissa
"extract a normalized float's 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 float's value is mantissa * 2^exp"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
float256_t myVal;
float256_t frac;
int exp;
OBJ newFloat;
myVal = __octaFloatVal(self);
// ouch: math libs seem to not care for NaN here;
#if 1
// should we?
if (! (STX_isNanQ(&myVal) || STX_isInfQ(&myVal)))
#endif
{
frac = STX_frexpQ(myVal, &exp);
__qMKFLOAT256(newFloat, frac);
RETURN ( newFloat );
}
#endif
%}.
^ super mantissa
"
1.0 exponent
1.0 asOctaFloat exponent
1.0 mantissa
1.0 asOctaFloat mantissa
0.25 exponent
0.25 asOctaFloat exponent
0.25 mantissa
0.25 asOctaFloat mantissa
0.00000011111 exponent
0.00000011111 mantissa
1e1000 mantissa
"
"Modified: / 20-06-2017 / 11:37:13 / cg"
"Modified (comment): / 26-05-2019 / 03:12:55 / Claus Gittinger"
!
negated
"return the receiver negated"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_negQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
rem: aNumber
"return the floating point remainder of the receiver and the argument, aNumber"
aNumber isZero ifTrue:[
"
No, you shalt not divide by zero
"
^ ZeroDivide raiseRequestWith:thisContext.
].
^ aNumber remainderFromLongFloat:self
!
sin
"return the sine of the receiver (interpreted as radians)"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_sinQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
sinh
"return the hyperbolic sine of the receiver (interpreted as radians)"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_sinhQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
tan
"return the tangent of the receiver (interpreted as radians)"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_tanQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
!
tanh
"return the hyperbolic tangent of the receiver (interpreted as radians)"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal;
myVal = __octaFloatVal(self);
result = STX_tanhQ(myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif
%}.
! !
!OctaFloat methodsFor:'coercing & converting'!
asFloat
"return a Float with same value as the receiver.
Raises an error if the receiver exceeds the float range."
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t qVal = __octaFloatVal(self);
double dVal = STX_qtodbl(qVal);
if (isfinite(dVal) || !STX_isfiniteQ(qVal)) {
__qMKFLOAT(newFloat, dVal);
RETURN ( newFloat );
}
#endif
%}.
"
value out of range
if you need -INF for a zero receiver, try Number trapInfinity:[...]
"
^ self class
raise:#infiniteResultSignal
receiver:self
selector:#asFloat
arguments:#()
errorString:'receiver is out of the double-precision float range'
"
1.0 asOctaFloat asFloat
"
!
asIEEEFloat
"return an IEEE soft float with same value as receiver"
^ IEEEFloat fromFloat:self
"
123 asFloat asIEEEFloat
0 asShortFloat asIEEEFloat
0 asLongFloat asIEEEFloat
0 asOctaFloat asIEEEFloat
0.0 asIEEEFloat
"
!
asOctaFloat
^ self
"
1.0 asOctaFloat asOctaFloat
"
!
generality
"return the generality value - see ArithmeticValue>>retry:coercing:"
^ 96
"Created: / 07-06-2019 / 09:30:58 / Claus Gittinger"
! !
!OctaFloat methodsFor:'comparing'!
< aNumber
"return true, if the argument is greater"
^ aNumber lessFromOctaFloat:self
"Created: / 07-06-2019 / 09:25:47 / Claus Gittinger"
!
= aNumber
"return true, if the argument represents the same numeric value
as the receiver, false otherwise"
^ aNumber equalFromOctaFloat:self
"Created: / 07-06-2019 / 09:25:27 / Claus Gittinger"
!
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
].
].
^ self asFloat hash
"
1.2345 hash
1.2345 asShortFloat hash
1.2345 asLongFloat hash
1.2345 asOctaFloat hash
1.0 hash
1.0 asShortFloat hash
1.0 asLongFloat hash
1.0 asOctaFloat hash
0.5 asShortFloat hash
0.5 asShortFloat hash
0.5 asLongFloat hash
0.5 asOctaFloat hash
0.25 asShortFloat hash
0.25 asShortFloat hash
0.25 asLongFloat hash
0.25 asOctaFloat hash
"
"Created: / 07-06-2019 / 09:28:07 / Claus Gittinger"
! !
!OctaFloat methodsFor:'double dispatching'!
differenceFromOctaFloat:aOctaFloat
%{
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal, argVal;
myVal = __octaFloatVal(self);
argVal = __octaFloatVal(aOctaFloat);
result = STX_addQ( argVal, myVal, 1 );
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_OCTAFLOAT
%}.
self errorUnsupported
!
equalFromOctaFloat:aOctaFloat
"sent when aOctaFloat does not know how to compare agaist the receiver, self"
%{
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal, argVal;
myVal = __octaFloatVal(self);
argVal = __octaFloatVal(aOctaFloat);
RETURN (STX_eqQ(argVal, myVal) ? true : false);
#endif // SUPPORT_OCTAFLOAT
%}.
self errorUnsupported
"Modified: / 08-06-2019 / 13:31:48 / Claus Gittinger"
!
lessFromOctaFloat:aOctaFloat
"sent when aOctaFloat does not know how to compare agaist the receiver, self"
%{
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal, argVal;
myVal = __octaFloatVal(self);
argVal = __octaFloatVal(aOctaFloat);
RETURN (STX_ltQ(argVal, myVal) ? true : false);
#endif // SUPPORT_OCTAFLOAT
%}.
self errorUnsupported
!
productFromOctaFloat:aOctaFloat
"sent when aOctaFloat does not know how to multiply the receiver, self"
%{
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal, argVal;
myVal = __octaFloatVal(self);
argVal = __octaFloatVal(aOctaFloat);
result = STX_mulQ(myVal, argVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_OCTAFLOAT
%}.
self errorUnsupported
!
quotientFromOctaFloat:aOctaFloat
"sent when aOctaFloat does not know how to multiply the receiver, self"
%{
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal, argVal;
myVal = __octaFloatVal(self);
argVal = __octaFloatVal(aOctaFloat);
result = STX_divQ(argVal, myVal);
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_OCTAFLOAT
%}.
self errorUnsupported
!
sumFromOctaFloat:aOctaFloat
"sent when aOctaFloat does not know how to add the receiver, self"
%{
#ifdef SUPPORT_OCTAFLOAT
OBJ newFloat;
float256_t result, myVal, argVal;
myVal = __octaFloatVal(self);
argVal = __octaFloatVal(aOctaFloat);
result = STX_addQ( myVal, argVal, 0 );
__qMKFLOAT256(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_OCTAFLOAT
%}.
self errorUnsupported
! !
!OctaFloat methodsFor:'error reportng'!
errorUnsupported
self class errorUnsupported
"Modified: / 07-06-2019 / 02:44:51 / Claus Gittinger"
! !
!OctaFloat methodsFor:'printing'!
printOn:aStream
|mantissa exponent|
mantissa := self mantissa.
exponent := self exponent.
self exponent == 0 ifTrue:[
mantissa printOn:aStream.
aStream nextPutAll:'.0'.
^ self
].
mantissa == 0 ifTrue:[
"/ a zero mantissa is impossible - except for zero and a few others
exponent == 0 ifTrue:[ aStream nextPutAll:'0.0'. ^ self].
self == NaN ifTrue:[ aStream nextPutAll:'NAN'. ^ self ].
self == NegativeInfinity ifTrue:[ aStream nextPutAll:'-INF'. ^ self].
self == PositiveInfinity ifTrue:[ aStream nextPutAll:'INF'. ^ self].
self error:'invalid largeFloat' mayProceed:true.
aStream nextPutAll:'Invalid'. ^ self.
].
exponent >= 0 ifTrue:[
(mantissa bitShift:exponent) printOn:aStream.
aStream nextPutAll:'.0'.
^ self
].
((mantissa / (1 bitShift:exponent negated)) asFixedPoint:6) printOn:aStream.
"Created: / 11-06-2019 / 00:13:00 / Claus Gittinger"
! !
!OctaFloat methodsFor:'queries'!
isFinite
"return true, if the receiver is a finite float (not NaN and not +/-INF)"
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
float256_t myVal;
myVal = __octaFloatVal(self);
RETURN (STX_isfiniteQ(myVal) ? true : false);
#endif // SUPPORT_OCTAFLOAT
%}.
"
1.0 isFinite
self NaN isFinite
self infinity isFinite
self negativeInfinity isFinite
(0.0 uncheckedDivide: 0.0) isFinite
(1.0 uncheckedDivide: 0.0) isFinite
"
!
isInfinite
"return true, if the receiver is an infinite float (+Inf or -Inf)."
%{ /* NOCONTEXT */
#ifdef SUPPORT_OCTAFLOAT
float256_t myVal;
myVal = __octaFloatVal(self);
RETURN (STX_isInfQ(&myVal) ? true : false);
#endif // SUPPORT_OCTAFLOAT
%}.
"
1.0 asOctaFloat isFinite
1.0 asOctaFloat isInfinite
self NaN isFinite
self NaN isInfinite
self infinity isFinite
self infinity isInfinite
self negativeInfinity isFinite
self negativeInfinity isInfinite
(0.0 uncheckedDivide: 0.0) isFinite
(1.0 uncheckedDivide: 0.0) isFinite
"
!
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 */
#ifdef SUPPORT_OCTAFLOAT
float256_t myVal;
myVal = __octaFloatVal(self);
RETURN (STX_isNanQ(&myVal) ? true : false);
#endif // SUPPORT_OCTAFLOAT
%}.
"
1.0 asOctaFloat isFinite
self NaN isFinite
self infinity isFinite
(0.0 uncheckedDivide: 0.0) isFinite
(1.0 uncheckedDivide: 0.0) isFinite
"
! !
!OctaFloat methodsFor:'testing'!
isOctaFloat
"return true, if the receiver is some kind of quad floating point number (iee quad precision)"
^ true
! !
!OctaFloat class methodsFor:'documentation'!
version_CVS
^ '$Header$'
! !