--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Float.st Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,818 @@
+"
+ COPYRIGHT (c) 1988-93 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.
+"
+
+Number variableByteSubclass:#Float
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Magnitude-Numbers'
+!
+
+Float comment:'
+
+COPYRIGHT (c) 1988-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+
+notice, that Floats are defined as Byte-array to prevent garbage collector
+from going into the value ... otherwise I needed a special case in many places.
+'!
+
+!Float class methodsFor:'instance creation'!
+
+new:aNumber
+ "catch this message - not allowed for floats"
+
+ self error:'Floats cannot be created with new:'
+!
+
+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."
+
+%{ /* NOCONTEXT */
+ RETURN ( _MKFLOAT((0.0) COMMA_SND) );
+%}
+! !
+
+!Float class methodsFor:'constants'!
+
+zero
+ "return the neutral element for addition"
+
+ ^ 0.0
+!
+
+unity
+ "return the neutral element for multiplication"
+
+ ^ 1.0
+!
+
+pi
+ "return the constant pi"
+
+ ^ 3.1415926535897932384626434
+! !
+
+!Float methodsFor:'copying'!
+
+shallowCopy
+ "return a shallow copy of myself
+ - reimplemented here since Floats are kind of kludgy"
+
+ ^ self
+!
+
+deepCopy
+ "return a deep copy of myself
+ - reimplemented here since Floats are kind of kludgy"
+
+ ^ self
+! !
+
+!Float methodsFor:'accessing'!
+
+size
+ "redefined since floats are kludgy (ByteArry)"
+
+ ^ 0
+!
+
+at:index
+ "redefined to prevent access to individual bytes in a float"
+
+ self error:'not allowed for floats'
+!
+
+at:index put:aValue
+ "redefined to prevent access to individual bytes in a float"
+
+ self error:'not allowed for floats'
+! !
+
+!Float methodsFor:'arithmetic'!
+
++ 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:
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = result;
+ RETURN ( newFloat );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ 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:
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = result;
+ RETURN ( newFloat );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ result = _floatVal(self) - _floatVal(aNumber);
+ goto retResult;
+ }
+%}
+.
+ ^ aNumber differenceFromFloat:self
+!
+
+* 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:
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = result;
+ RETURN ( newFloat );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ result = _floatVal(self) * _floatVal(aNumber);
+ goto retResult;
+ }
+%}
+.
+ ^ aNumber productFromFloat: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:
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = result;
+ RETURN ( newFloat );
+ }
+ } else {
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ val = _floatVal(aNumber);
+ if (val != 0.0) {
+ result = _floatVal(self) / val;
+ goto retResult;
+ }
+ }
+ }
+%}
+.
+ ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
+ DivisionByZeroSignal raise.
+ ^ self
+ ].
+ ^ aNumber quotientFromFloat:self
+!
+
+// aNumber
+ "return the integer quotient of dividing the receiver by aNumber with
+ truncation towards negative infinity."
+
+ ^ (self / aNumber) floor asInteger
+!
+
+\\ aNumber
+ "return the integer remainder of dividing the receiver by aNumber with
+ truncation towards negative infinity."
+
+ ^ (self - ((self / aNumber) floor * aNumber)) floor asInteger
+!
+
+negated
+ "return myself negated"
+
+%{ /* NOCONTEXT */
+ RETURN ( _MKFLOAT(- _floatVal(self) COMMA_SND) );
+%}
+! !
+
+!Float methodsFor:'testing'!
+
+positive
+ "return true if the receiver is greater or equal to zero"
+
+%{ /* NOCONTEXT */
+ RETURN ( (_floatVal(self) >= 0.0) ? true : false );
+%}
+!
+
+negative
+ "return true if the receiver is less than zero"
+
+%{ /* NOCONTEXT */
+ RETURN ( (_floatVal(self) < 0.0) ? true : false );
+%}
+! !
+
+!Float methodsFor:'comparing'!
+
+< aNumber
+ "return true, if the argument is greater"
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(aNumber)) {
+ RETURN ( (_floatVal(self) < (double)(_intVal(aNumber))) ? true : false );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ RETURN ( (_floatVal(self) < _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ aNumber lessFromFloat:self
+!
+
+> aNumber
+ "return true, if the argument is less"
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(aNumber)) {
+ RETURN ( (_floatVal(self) > (double)(_intVal(aNumber))) ? true : false );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ RETURN ( (_floatVal(self) > _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#> coercing:aNumber
+!
+
+<= aNumber
+ "return true, if the argument is greater or equal"
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(aNumber)) {
+ RETURN ( (_floatVal(self) <= (double)(_intVal(aNumber))) ? true : false );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ 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 ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ RETURN ( (_floatVal(self) >= _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#>= coercing:aNumber
+!
+
+= aNumber
+ "return true, if the arguments value are equal"
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(aNumber)) {
+ RETURN ( (_floatVal(self) == (double)(_intVal(aNumber))) ? true : false );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ RETURN ( (_floatVal(self) == _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#= coercing:aNumber
+!
+
+~= aNumber
+ "return true, if the arguments value are not equal"
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(aNumber)) {
+ RETURN ( (_floatVal(self) != (double)(_intVal(aNumber))) ? true : false );
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ RETURN ( (_floatVal(self) != _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#~= coercing:aNumber
+! !
+
+!Float methodsFor:'coercion and converting'!
+
+coerce:aNumber
+ "return aNumber converted into receivers type"
+
+ ^ aNumber asFloat
+!
+
+generality
+ "return the generality value - see ArithmeticValue>>retry:coercing:"
+ ^ 80
+!
+
+asFloat
+ "return a float with same value - thats me"
+
+ ^ self
+!
+
+asFraction
+ "return a corresponding fraction
+ - notice, that fract asFloat asFract does not always return
+ a good fraction ..."
+
+ |fract digits power num denom|
+
+ "we (indirectly) use printf which knows the precision of floats"
+
+ fract := self fractionPart.
+ digits := fract printString copyFrom:3.
+ power := digits size.
+ num := (self - fract) asInteger.
+ denom := (10 raisedToInteger:power).
+ num := num * denom.
+ num := num + (Integer readFromString:digits).
+ ^ (Fraction numerator:num denominator:denom) reduced
+
+ "0.3 asFraction"
+ "0.5 asFraction"
+ "(1/5) asFloat asFraction"
+ "(1/8) asFloat asFraction"
+ "(1/12) asFloat asFraction -> inexact result due to float errors"
+ "(1/13) asFloat asFraction -> inexact result due to float errors"
+!
+
+asInteger
+ "return an integer with same value - might truncate"
+
+ |l v sign|
+
+%{ /* NOCONTEXT */
+
+ if ((_floatVal(self) >= (double)_MIN_INT)
+ && (_floatVal(self) <= (double)_MAX_INT)) {
+ RETURN ( _MKSMALLINT( (INT)_floatVal(self)) );
+ }
+%}
+.
+ "this is stupid code - rounding errors accumulate; fix later"
+
+ sign := self sign.
+ v := self abs.
+ (v >= 10) ifTrue:[
+ l := (v / 10.0) asInteger * 10
+ ] ifFalse:[
+ l := 0
+ ].
+ v := v - ((v / 10.0) floor * 10.0) floor.
+ l := l + v truncated.
+ ^ l * sign
+
+ "12345.0 asInteger"
+ "1e15 asInteger"
+! !
+
+!Float methodsFor:'double dispatching'!
+
+sumFromFraction:aFraction
+ "sent when a fraction does not know how to add the recevier, a float"
+
+ ^ (self * aFraction denominator + aFraction numerator) / aFraction denominator
+!
+
+differenceFromFraction:aFraction
+ "sent when a fraction does not know how to subtract the recevier, a float"
+
+ ^ (self * aFraction denominator - aFraction numerator) / aFraction denominator
+!
+
+productFromFraction:aFraction
+ "sent when a fraction does not know how to multiply the recevier, a float"
+
+ ^ self * aFraction numerator / aFraction denominator
+!
+
+quotientFromFraction:aFraction
+ "sent when a fraction does not know how to divide by the recevier, a float"
+
+ ^ aFraction numerator / (self * aFraction denominator)
+! !
+
+!Float methodsFor:'truncation and rounding'!
+
+truncated
+ "return the receiver truncated towards zero as Integer"
+
+ |val|
+
+%{
+ double floor(), ceil();
+ double dVal;
+
+ dVal = _floatVal(self);
+ if (dVal < 0.0) {
+ dVal = ceil(dVal);
+ } else {
+ dVal = floor(dVal);
+ }
+
+ /*
+ * mhmh it seems that ST-80 is returning integers if possible.
+ * (at least, some pd programs expect it ...)
+ */
+ if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
+ RETURN ( _MKSMALLINT( (INT) dVal ) );
+ }
+ val = _MKFLOAT(dVal COMMA_CON);
+%}
+.
+ ^ val asInteger
+!
+
+rounded
+ "return the receiver rounded to the nearest integer as integer"
+
+ |val|
+
+%{
+ double floor();
+ double dVal;
+
+ /*
+ * mhmh it seems that ST-80 is returning integers if possible
+ * at least, some pd programs expect it ...
+ */
+ dVal = floor(_floatVal(self) + 0.5);
+ if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
+ RETURN ( _MKSMALLINT( (INT) dVal ) );
+ }
+ val = _MKFLOAT(dVal COMMA_CON);
+%}
+.
+ ^ val asInteger
+!
+
+floor
+ "return the biggest integer-valued float less or equal to the receiver"
+
+%{ /* NOCONTEXT */
+
+ double floor();
+
+ RETURN ( _MKFLOAT(floor(_floatVal(self)) COMMA_SND) );
+%}
+!
+
+ceiling
+ "return the smallest integer-valued float greater or equal to the receiver"
+
+%{ /* NOCONTEXT */
+
+ double ceil();
+
+ RETURN ( _MKFLOAT(ceil(_floatVal(self)) COMMA_SND) );
+%}
+!
+
+fractionPart
+ "return a float with value from digits after the decimal point"
+
+ ^ self - self truncated asFloat
+
+ "1234.56789 fractionPart"
+ "1.2345e6 fractionPart"
+! !
+
+!Float methodsFor:'mathematical functions'!
+
+ln
+ "return the natural logarithm of myself"
+
+%{ /* NOCONTEXT */
+
+ double log();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = log(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+raisedTo:aNumber
+ "return self raised to the power of aNumber"
+ |n|
+
+ n := aNumber asFloat.
+%{
+ double pow();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ if (_isFloat(n)) {
+ errno = 0;
+ result = pow(_floatVal(self), _floatVal(n));
+ errno = 0; /* XXXX */
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_CON) );
+ ErrorNumber = _MKSMALLINT(errno);
+ }
+%}
+.
+ DomainErrorSignal raise
+!
+
+exp
+ "return e raised to the power of the receiver"
+
+%{ /* NOCONTEXT */
+
+ double exp();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = exp(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+sin
+ "return the sine of myself interpreted as radians"
+
+%{ /* NOCONTEXT */
+
+ double sin();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = sin(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+cos
+ "return the cosine of myself interpreted as radians"
+
+%{ /* NOCONTEXT */
+
+ double cos();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = cos(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+tan
+ "return the tangent of myself interpreted as radians"
+
+%{ /* NOCONTEXT */
+
+ double tan();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = tan(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+arcSin
+ "return the arcsine of myself as radians"
+
+%{ /* NOCONTEXT */
+
+ double asin();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = asin(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+arcCos
+ "return the arccosine of myself as radians"
+
+%{ /* NOCONTEXT */
+
+ double acos();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = acos(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+arcTan
+ "return the arctangent of myself as radians"
+
+%{ /* NOCONTEXT */
+
+ double atan();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = atan(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+!
+
+sqrt
+ "return the square root of myself"
+
+%{ /* NOCONTEXT */
+
+ double sqrt();
+ double result;
+ extern errno;
+ extern OBJ ErrorNumber;
+
+ errno = 0;
+ result = sqrt(_floatVal(self));
+ if (errno == 0)
+ RETURN ( _MKFLOAT(result COMMA_SND) );
+ ErrorNumber = _MKSMALLINT(errno);
+%}
+.
+ DomainErrorSignal raise
+! !
+
+!Float methodsFor:'printing and storing'!
+
+printString
+ "return a printed representation of the receiver"
+
+%{ /* NOCONTEXT */
+
+ char buffer[256];
+ REGISTER char *cp;
+#ifdef THIS_CONTEXT
+ OBJ sav = __thisContext;
+#endif
+
+#ifdef SYSV
+ sprintf(buffer, "%.6lg", _floatVal(self));
+#else
+ sprintf(buffer, "%.6G", _floatVal(self));
+#endif
+
+#ifdef THIS_CONTEXT
+ __thisContext = sav;
+#endif
+ /*
+ * kludge to make integral floats prints as i.0 (not i 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';
+ }
+
+ RETURN ( _MKSTRING(buffer COMMA_SND) );
+%}
+ "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 differes on
+ systems; on SYSV machines you have to give something like %lf,
+ while on BSD systems the format string has to be %F."
+
+%{ /* NOCONTEXT */
+ char buffer[256];
+
+ if (_isString(formatString)) {
+#ifdef THIS_CONTEXT
+ OBJ sav = __thisContext;
+#endif
+ sprintf(buffer, _stringVal(formatString), _floatVal(self));
+#ifdef THIS_CONTEXT
+ __thisContext = sav;
+#endif
+ RETURN ( _MKSTRING(buffer COMMA_SND) );
+ }
+%}
+.
+ 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'"
+! !