--- a/QuadFloat.st Fri Nov 22 00:48:55 2019 +0100
+++ b/QuadFloat.st Fri Nov 22 03:36:18 2019 +0100
@@ -18,17 +18,36 @@
#include <math.h>
-extern int STX_qisNan(float128_t* pq);
-extern int STX_qprcmp(float128_t* a, float128_t* b);
extern float128_t STX_qadd(float128_t, float128_t, int);
-extern float128_t STX_qneg(float128_t n);
-extern float128_t STX_qabs(float128_t n);
-extern float128_t STX_qfloor(float128_t n);
-extern float128_t STX_qceil(float128_t n);
+extern float128_t STX_qmul(float128_t, float128_t);
+extern float128_t STX_qdiv(float128_t, float128_t);
+extern float128_t STX_qneg(float128_t);
+extern float128_t STX_qabs(float128_t);
+extern float128_t STX_qfloor(float128_t);
+extern float128_t STX_qfrexp(float128_t, int*);
+extern float128_t STX_qceil(float128_t);
+extern float128_t STX_qlog(float128_t);
+extern float128_t STX_qlog10(float128_t);
+extern float128_t STX_qlog2(float128_t);
+extern float128_t STX_qexp(float128_t);
+extern float128_t STX_qsin(float128_t);
+extern float128_t STX_qcos(float128_t);
+extern float128_t STX_qtan(float128_t);
+extern float128_t STX_qsinh(float128_t);
+extern float128_t STX_qcosh(float128_t);
+extern float128_t STX_qtanh(float128_t);
+extern float128_t STX_qasin(float128_t);
+extern float128_t STX_qacos(float128_t);
+extern float128_t STX_qatan(float128_t);
+extern float128_t STX_qasinh(float128_t);
+extern float128_t STX_qacosh(float128_t);
+extern float128_t STX_qatanh(float128_t);
extern float128_t STX_qZero;
extern float128_t STX_dbltoq(double);
extern float128_t STX_inttoq(long);
extern double STX_qtodbl(float128_t);
+extern int STX_qisNan(float128_t*);
+extern int STX_qprcmp(float128_t*, float128_t*);
#define STX_qisfinite(q) (!STX_qisNan(&(q)) && !STX_qisInf(&(q)))
#define STX_qeq(x1, x2) (STX_qprcmp (&(x1), &(x2)) == 0)
@@ -78,34 +97,13 @@
! !
!QuadFloat primitiveVariables!
-ded float format (amd64, x86_64)
- u.qf = extF80_to_f128( u.ef);
- __qMKQFLOAT(newFloat, u.qf); /* OBJECT ALLOCATION */
- RETURN (newFloat);
- }
- // fall into error case
- }
-#endif /* SUPPORT_QUADFLOAT */
-%}.
- aFloat isLongFloat ifTrue:[
- self errorUnsupported
- ].
- ArgumentError raise
-
- "
- QuadFloat fromLongFloat:123.0 asLongFloat
- "
+%{
+%}
! !
!QuadFloat primitiveFunctions!
-f); /* OBJECT ALLOCATION */
- nan = newFloat;
- }
-#endif /* SUPPORT_QUADFLOAT */
-%}.
- NaN := nan
- ].
- ^ NaN
+%{
+%}
! !
!QuadFloat class methodsFor:'documentation'!
@@ -168,8 +166,7 @@
if (sizeof(long double) == sizeof(float128_t)) {
__qMKLFLOAT(newFloat, 0.0); /* OBJECT ALLOCATION */
} else {
- float128_t qf;
- f64_to_f128M(0.0, &qf);
+ float128_t qf = STX_qZero;
__qMKQFLOAT(newFloat, qf); /* OBJECT ALLOCATION */
}
RETURN (newFloat);
@@ -188,10 +185,10 @@
OBJ newFloat;
if (__isFloatLike(aFloat)) {
- float64_t f = __floatVal(aFloat);
+ double f = __floatVal(aFloat);
float128_t qf;
- f64_to_f128M(f, &qf);
+ qf = STX_dbltoq (f);
__qMKQFLOAT(newFloat, qf); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
@@ -222,11 +219,7 @@
INT iVal = __intVal(anInteger);
float128_t qf;
-#if __POINTER_SIZE__ == 4
- i32_to_f128M( iVal, &qf );
-else
- i64_to_f128M( iVal, &qf );
-#endif
+ qf = STX_inttoq( (long)iVal );
__qMKQFLOAT(newFloat, qf); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
@@ -244,7 +237,7 @@
"return a new quadFloat, given a long float value"
%{ /* NOCONTEXT */
-#ifdef SUPPORT_QUADFLOAT
+#ifdef xSUPPORT_QUADFLOAT
OBJ newFloat;
union {
LONGFLOAT_t lf; // is long double
@@ -311,7 +304,7 @@
NaN isNil ifTrue:[
%{ /* NOCONTEXT */
-#ifdef SUPPORT_QUADFLOAT
+#ifdef xSUPPORT_QUADFLOAT
{
OBJ newFloat;
float128_t qf;
@@ -347,7 +340,7 @@
PositiveInfinity isNil ifTrue:[
%{ /* NOCONTEXT */
-#ifdef SUPPORT_QUADFLOAT
+#ifdef xSUPPORT_QUADFLOAT
{
OBJ newFloat;
struct uint128 uiZ;
@@ -377,7 +370,7 @@
NegativeInfinity isNil ifTrue:[
%{ /* NOCONTEXT */
-#ifdef SUPPORT_QUADFLOAT
+#ifdef xSUPPORT_QUADFLOAT
{
OBJ newFloat;
struct uint128 uiZ;
@@ -404,9 +397,9 @@
"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)
+ "/ 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
@@ -540,7 +533,7 @@
"return the product of the receiver and the argument."
aNumber class == QuadFloat ifTrue:[
- ^ aNumber productFromQuadFloat:self
+ ^ aNumber productFromQuadFloat:self
].
thisContext isReallyRecursive ifTrue:[self error].
@@ -571,6 +564,385 @@
^ aNumber quotientFromQuadFloat:self
!
+floor
+ "return the integer nearest the receiver towards negative infinity."
+
+ |val|
+
+%{
+ float128_t qVal;
+ float128_t qMinInt;
+ float128_t qMaxInt;
+
+ qVal = __quadFloatVal(self);
+ qVal = STX_qfloor(qVal);
+
+ qMinInt = STX_dbltoq((double)_MIN_INT);
+ qMaxInt = STX_dbltoq((double)_MAX_INT);
+ if (STX_qge(qVal, qMinInt) && STX_qle(qVal, qMaxInt)) {
+ double dVal = STX_qtodbl(qVal);
+ RETURN ( __mkSmallInteger( (INT) dVal ) );
+ }
+ __qMKQFLOAT(val, qVal);
+%}.
+ ^ val asInteger
+
+ "
+ 0.5 asQuadFloat floor
+ 0.5 asQuadFloat floorAsFloat
+ -0.5 asQuadFloat floor
+ -0.5 asQuadFloat 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_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qfloor(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+ceiling
+ "return the smallest integer which is greater or equal to the receiver."
+
+ |val|
+
+%{
+ float128_t qVal;
+ float128_t qMinInt;
+ float128_t qMaxInt;
+
+ qVal = __quadFloatVal(self);
+ qVal = STX_qceil(qVal);
+
+ qMinInt = STX_dbltoq((double)_MIN_INT);
+ qMaxInt = STX_dbltoq((double)_MAX_INT);
+ if (STX_qge(qVal, qMinInt) && STX_qle(qVal, qMaxInt)) {
+ double dVal = STX_qtodbl(qVal);
+ RETURN ( __mkSmallInteger( (INT) dVal ) );
+ }
+ __qMKQFLOAT(val, qVal);
+%}.
+ ^ val asInteger
+
+ "
+ 0.5 asQuadFloat ceiling
+ 0.5 asQuadFloat ceilingAsFloat
+ -0.5 asQuadFloat ceiling
+ -0.5 asQuadFloat 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_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qceil(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+exponent
+ "extract a normalized float's 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 */
+ float128_t myVal;
+ float128_t frac;
+ int exp;
+
+ myVal = __quadFloatVal(self);
+#if 1
+ // should we?
+ if (! (STX_qisNan(&myVal) || STX_qisInf(&myVal)))
+#endif
+ {
+ frac = STX_qfrexp(myVal, &exp);
+ RETURN (__mkSmallInteger(exp));
+ }
+%}.
+ ^ super exponent
+
+ "
+ 1.0 exponent
+ 1.0 asQuadFloat exponent
+ 2.0 exponent
+ 2.0 asQuadFloat exponent
+ 3.0 exponent
+ 3.0 asQuadFloat exponent
+ 4.0 exponent
+ 4.0 asQuadFloat exponent
+ 0.5 exponent
+ 0.5 asQuadFloat exponent
+ 0.4 exponent
+ 0.4 asQuadFloat exponent
+ 0.25 exponent
+ 0.25 asQuadFloat exponent
+ 0.2 exponent
+ 0.2 asQuadFloat exponent
+ 0.00000011111 exponent
+ 0.00000011111 asQuadFloat exponent
+ 0.0 exponent
+ 0.0 asQuadFloat exponent
+
+ 1e1000 exponent -> error (INF)
+ 1e1000 asQuadFloat exponent -> error (INF)
+ "
+!
+
+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 */
+ float128_t myVal;
+ float128_t frac;
+ int exp;
+ OBJ newFloat;
+
+ myVal = __quadFloatVal(self);
+ // ouch: math libs seem to not care for NaN here;
+#if 1
+ // should we?
+ if (! (STX_qisNan(&myVal) || STX_qisInf(&myVal)))
+#endif
+ {
+ frac = STX_qfrexp(myVal, &exp);
+ __qMKQFLOAT(newFloat, frac);
+ RETURN ( newFloat );
+ }
+%}.
+ ^ super mantissa
+
+ "
+ 1.0 exponent
+ 1.0 asQuadFloat exponent
+ 1.0 mantissa
+ 1.0 asQuadFloat mantissa
+
+ 0.25 exponent
+ 0.25 asQuadFloat exponent
+ 0.25 mantissa
+ 0.25 asQuadFloat 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"
+!
+
+abs
+ "return the absolute value of the receiver
+ reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qabs(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+exp
+ "return e raised to the power of the receiver"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qexp(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+log
+ "return log base 10 of the receiver.
+ Alias for log:10."
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qlog10(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+ln
+ "return natural logarithm of the receiver."
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qlog(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+log2
+ "return logarithm dualis of the receiver."
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qlog2(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+sin
+ "return the sine of the receiver (interpreted as radians)"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qsin(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+cos
+ "return the cosine of the receiver (interpreted as radians)"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qcos(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+tan
+ "return the tangent of the receiver (interpreted as radians)"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qtan(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+sinh
+ "return the hyperbolic sine of the receiver (interpreted as radians)"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qsinh(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+cosh
+ "return the hyperbolic cosine of the receiver (interpreted as radians)"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qcosh(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
+tanh
+ "return the hyperbolic tangent of the receiver (interpreted as radians)"
+
+%{ /* NOCONTEXT */
+#ifdef SUPPORT_QUADFLOAT
+ OBJ newFloat;
+ float128_t result, myVal;
+
+ myVal = __quadFloatVal(self);
+ result = STX_qtanh(myVal);
+ __qMKQFLOAT(newFloat, result);
+ RETURN ( newFloat );
+#endif
+%}.
+!
+
negated
"return the receiver negated"
@@ -580,7 +952,7 @@
float128_t result, myVal;
myVal = __quadFloatVal(self);
- f128M_negate( &myVal, &result );
+ result = STX_qneg(myVal);
__qMKQFLOAT(newFloat, result);
RETURN ( newFloat );
#endif
@@ -601,6 +973,37 @@
!QuadFloat methodsFor:'coercing & converting'!
+asFloat
+ "return a Float with same value as the receiver.
+ Raises an error if the receiver exceeds the float range."
+
+%{ /* NOCONTEXT */
+
+ OBJ newFloat;
+ float128_t qVal = __quadFloatVal(self);
+ double dVal = STX_qtodbl(qVal);
+
+ if (isfinite(dVal) || !STX_qisfinite(qVal)) {
+ __qMKFLOAT(newFloat, dVal);
+ RETURN ( newFloat );
+ }
+%}.
+ "
+ 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 asQuadFloat asFloat
+ "
+!
+
generality
"return the generality value - see ArithmeticValue>>retry:coercing:"
@@ -679,7 +1082,7 @@
myVal = __quadFloatVal(self);
argVal = __quadFloatVal(aQuadFloat);
- f128M_sub( &myVal, &argVal, &result );
+ result = STX_qadd( argVal, myVal, 1 );
__qMKQFLOAT(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_QUADFLOAT
@@ -697,7 +1100,7 @@
myVal = __quadFloatVal(self);
argVal = __quadFloatVal(aQuadFloat);
- RETURN (f128M_eq( &argVal, &myVal ) ? true : false);
+ RETURN (STX_qeq(argVal, myVal) ? true : false);
#endif // SUPPORT_QUADFLOAT
%}.
self errorUnsupported
@@ -715,7 +1118,7 @@
myVal = __quadFloatVal(self);
argVal = __quadFloatVal(aQuadFloat);
- RETURN (f128M_lt( &argVal, &myVal ) ? true : false);
+ RETURN (STX_qlt(argVal, myVal) ? true : false);
#endif // SUPPORT_QUADFLOAT
%}.
self errorUnsupported
@@ -731,7 +1134,7 @@
myVal = __quadFloatVal(self);
argVal = __quadFloatVal(aQuadFloat);
- f128M_mul( &myVal, &argVal, &result );
+ result = STX_qmul(myVal, argVal);
__qMKQFLOAT(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_QUADFLOAT
@@ -749,7 +1152,7 @@
myVal = __quadFloatVal(self);
argVal = __quadFloatVal(aQuadFloat);
- f128M_div( &myVal, &argVal, &result );
+ result = STX_qdiv(argVal, myVal);
__qMKQFLOAT(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_QUADFLOAT
@@ -767,7 +1170,7 @@
myVal = __quadFloatVal(self);
argVal = __quadFloatVal(aQuadFloat);
- f128M_add( &myVal, &argVal, &result );
+ result = STX_qadd( myVal, argVal, 0 );
__qMKQFLOAT(newFloat, result);
RETURN ( newFloat );
#endif // SUPPORT_QUADFLOAT
@@ -827,17 +1230,17 @@
float128_t myVal;
myVal = __quadFloatVal(self);
- RETURN ((f128_isInf(myVal) || f128_isNan(myVal)) ? false : true);
+ RETURN (STX_qisfinite(myVal) ? true : false);
#endif // SUPPORT_QUADFLOAT
%}.
"
- 1.0 isFinite
- self NaN isFinite
- self infinity isFinite
- self negativeInfinity isFinite
- (0.0 uncheckedDivide: 0.0) isFinite
- (1.0 uncheckedDivide: 0.0) isFinite
+ 1.0 isFinite
+ self NaN isFinite
+ self infinity isFinite
+ self negativeInfinity isFinite
+ (0.0 uncheckedDivide: 0.0) isFinite
+ (1.0 uncheckedDivide: 0.0) isFinite
"
!
@@ -849,21 +1252,21 @@
float128_t myVal;
myVal = __quadFloatVal(self);
- RETURN (f128_isInf(myVal) ? true : false);
+ RETURN (STX_qisInf(&myVal) ? true : false);
#endif // SUPPORT_QUADFLOAT
%}.
"
- 1.0 isFinite
- 1.0 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
+ 1.0 asQuadFloat isFinite
+ 1.0 asQuadFloat 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
"
!
@@ -877,16 +1280,16 @@
float128_t myVal;
myVal = __quadFloatVal(self);
- RETURN (f128_isNan(myVal) ? true : false);
+ RETURN (STX_qisNan(&myVal) ? true : false);
#endif // SUPPORT_QUADFLOAT
%}.
"
- 1.0 isFinite
- self NaN isFinite
- self infinity isFinite
- (0.0 uncheckedDivide: 0.0) isFinite
- (1.0 uncheckedDivide: 0.0) isFinite
+ 1.0 asQuadFloat isFinite
+ self NaN isFinite
+ self infinity isFinite
+ (0.0 uncheckedDivide: 0.0) isFinite
+ (1.0 uncheckedDivide: 0.0) isFinite
"
! !
@@ -903,4 +1306,3 @@
version_CVS
^ '$Header$'
! !
-