"
COPYRIGHT (c) 1996 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:#ShortFloat
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Magnitude-Numbers'
!
!ShortFloat 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 <nan.h>
# endif
#endif
#if defined(solaris) || defined(sunos)
# include <nan.h>
#endif
#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
%}
! !
!ShortFloat class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1996 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
"
ShortFloats represent rational numbers with limited precision. In ST/X, Float uses
the underlying C-compilers double implementation, while ShortFloats are
mapped onto C-floats.
Therefore instances of Float are usually represented by the 8-byte IEE
double precision float format, while ShortFloats use 4byte IEE format.
(but there is no guaranty).
Notice, that ST/X Floats are what Doubles are in ST-80 and ShortFloats are
ST-80's Floats respectively.
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 shortFloat 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/shortFloats,
and does its float-checks by an identity compare with the ShortFloat-class.
(i.e. your subclasses instances may not be recognized as float-like objects,
thus mixed mode arithmetic will always coerce them, effectively slowing things down).
This may be changed, to use a flag bit in the class.
[author:]
Claus Gittinger
[see also:]
Number
Float Fraction FixedPoint Integer
"
! !
!ShortFloat class methodsFor:'instance creation'!
basicNew
"return a new shortFloat - here we return 0.0
- shortFloats are usually NOT created this way ...
Its implemented here to allow things like binary store & load
of shortFloats. (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;
__qMKSFLOAT(newFloat, 0.0);
RETURN (newFloat);
%}
!
fastFromString:aString at:startIndex
"return the next ShortFloat 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 (__MKSFLOAT(val));
}
}
%}.
self primitiveFailed.
"
ShortFloat fastFromString:'123.45' at:1
ShortFloat fastFromString:'123.45' at:2
ShortFloat fastFromString:'123.45E4' at:1
ShortFloat fastFromString:'hello123.45E4' at:6
ShortFloat fastFromString:'12345' at:1
ShortFloat fastFromString:'12345' at:2
ShortFloat fastFromString:'12345' at:3
ShortFloat fastFromString:'12345' at:4
ShortFloat fastFromString:'12345' at:5
ShortFloat fastFromString:'12345' at:6
ShortFloat fastFromString:'12345' at:0
ShortFloat fastFromString:'hello123.45E4' at:1
Time millisecondsToRun:[
100000 timesRepeat:[
ShortFloat readFrom:'123.45'
]
]
"
"
Time millisecondsToRun:[
100000 timesRepeat:[
ShortFloat fastFromString:'123.45' at:1
]
]
"
!
readFrom:aStringOrStream
"read a shortFloat from a string"
|num|
num := super readFrom:aStringOrStream onError:[self error:'conversion error for: ' , self name].
num notNil ifTrue:[
num := num asShortFloat
].
^ num
"
ShortFloat readFrom:'0.1'
ShortFloat readFrom:'0'
ShortFloat readFrom:'.123'
ShortFloat readFrom:'-.123'
ShortFloat readFrom:'1e4'
"
"Modified: / 7.1.1998 / 16:17:59 / cg"
!
readFrom:aStringOrStream onError:exceptionBlock
"read a shortFloat from a string"
|num|
num := super readFrom:aStringOrStream onError:nil.
num isNil ifTrue:[
^ exceptionBlock value
].
^ num asShortFloat
"
ShortFloat readFrom:'0.1'
ShortFloat readFrom:'0'
ShortFloat readFrom:'.123'
"
"Modified: / 7.1.1998 / 16:17:59 / cg"
! !
!ShortFloat class methodsFor:'constants'!
pi
"return the constant pi as ShortFloat"
^ 3.14159 asShortFloat
"Modified: 23.4.1996 / 09:26:31 / cg"
!
unity
"return the neutral element for multiplication (1.0) as ShortFloat"
^ 1.0 asShortFloat
"Modified: 23.4.1996 / 09:26:51 / cg"
!
zero
"return the neutral element for addition (0.0) as ShortFloat"
^ 0.0 asShortFloat
"Modified: 23.4.1996 / 09:26:45 / cg"
! !
!ShortFloat class methodsFor:'queries'!
isBuiltInClass
"return true if this class is known by the run-time-system.
Here, true is returned for myself, false for subclasses."
^ self == ShortFloat
"Modified: 23.4.1996 / 16:00:23 / 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
! !
!ShortFloat methodsFor:'arithmetic'!
* aNumber
"return the product of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
OBJ newFloat;
float result;
double dResult;
if (__isSmallInteger(aNumber)) {
result = __shortFloatVal(self) * (float)(__intVal(aNumber));
retResult:
__qMKSFLOAT(newFloat, result);
RETURN ( newFloat );
} else if (__isShortFloat(aNumber)) {
result = __shortFloatVal(self) * __shortFloatVal(aNumber);
goto retResult;
} else if (__isFloatLike(aNumber)) {
dResult = (double) __shortFloatVal(self)* __floatVal(aNumber);
__qMKFLOAT(newFloat, dResult);
RETURN ( newFloat );
}
%}.
^ aNumber productFromShortFloat:self
!
+ aNumber
"return the sum of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
OBJ newFloat;
float result;
double dResult;
if (__isSmallInteger(aNumber)) {
result = __shortFloatVal(self) + (float)(__intVal(aNumber));
retResult:
__qMKSFLOAT(newFloat, result);
RETURN ( newFloat );
} else if (__isShortFloat(aNumber)) {
result = __shortFloatVal(self) + __shortFloatVal(aNumber);
goto retResult;
} else if (__isFloatLike(aNumber)) {
dResult = (double) __shortFloatVal(self) + __floatVal(aNumber);
__qMKFLOAT(newFloat, dResult);
RETURN ( newFloat );
}
%}.
^ aNumber sumFromShortFloat:self
!
- aNumber
"return the difference of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
OBJ newFloat;
float result;
double dResult;
if (__isSmallInteger(aNumber)) {
result = __shortFloatVal(self) - (float)(__intVal(aNumber));
retResult:
__qMKSFLOAT(newFloat, result);
RETURN ( newFloat );
} else if (__isShortFloat(aNumber)) {
result = __shortFloatVal(self) - __shortFloatVal(aNumber);
goto retResult;
} else if (__isFloatLike(aNumber)) {
dResult = (double) __shortFloatVal(self) - __floatVal(aNumber);
__qMKFLOAT(newFloat, dResult);
RETURN ( newFloat );
}
%}.
^ aNumber differenceFromShortFloat:self
!
/ aNumber
"return the quotient of the receiver and the argument, aNumber"
%{ /* NOCONTEXT */
OBJ newFloat;
float result, val;
double dResult, dVal;
if (__isSmallInteger(aNumber)) {
if (aNumber != __MKSMALLINT(0)) {
result = __shortFloatVal(self) / (float)(__intVal(aNumber));
retResult:
__qMKSFLOAT(newFloat, result);
RETURN ( newFloat );
}
} else if (__isShortFloat(aNumber)) {
val = __shortFloatVal(aNumber);
if (val != 0.0) {
result = __shortFloatVal(self) / val;
goto retResult;
}
} else if (__isFloatLike(aNumber)) {
dVal = __floatVal(aNumber);
if (dVal != 0.0) {
dResult = (double) __shortFloatVal(self) / dVal;
__qMKFLOAT(newFloat, dResult);
RETURN ( newFloat );
}
}
%}.
((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
"
No, you shalt not divide by zero
"
^ DivisionByZeroSignal raiseRequest.
].
^ aNumber quotientFromShortFloat:self
!
negated
"return myself negated"
%{ /* NOCONTEXT */
OBJ newFloat;
float rslt = - __shortFloatVal(self);
__qMKSFLOAT(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;
float result, val;
double dResult, dVal;
if (__isSmallInteger(aNumber)) {
result = __shortFloatVal(self) / (float)(__intVal(aNumber));
retResult:
__qMKSFLOAT(newFloat, result);
RETURN ( newFloat );
} else if (__isShortFloat(aNumber)) {
val = __shortFloatVal(aNumber);
result = __shortFloatVal(self) / val;
goto retResult;
} else if (__isFloatLike(aNumber)) {
dVal = __floatVal(aNumber);
dResult = (double) __shortFloatVal(self) / dVal;
__qMKFLOAT(newFloat, dResult);
RETURN ( newFloat );
}
%}.
^ aNumber quotientFromShortFloat:self
"
0.0 asShortFloat uncheckedDivide:0
1.0 asShortFloat uncheckedDivide:0.0
"
! !
!ShortFloat methodsFor:'coercing & converting'!
asFloat
"return a Float with same value as the receiver"
%{ /* NOCONTEXT */
OBJ newFloat;
double dVal = (double)__shortFloatVal(self);
__qMKFLOAT(newFloat, dVal);
RETURN ( newFloat );
%}
"
1.0 asShortFloat asFloat
"
!
asInteger
"return an integer with same value - might truncate"
%{ /* NOCONTEXT */
float fVal;
fVal = __shortFloatVal(self);
if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
RETURN ( __MKSMALLINT( (INT)fVal) );
}
%}.
^ super asInteger
"
12345.0 asShortFloat asInteger
1e15 asShortFloat asInteger
"
!
asShortFloat
"return a ShortFloat with same value as the receiver - thats me"
^ self
!
asTrueFraction
"return a fraction with same value as the receiver"
^ self asFloat asTrueFraction
!
generality
"return the generality value - see ArithmeticValue>>retry:coercing:"
^ 70
! !
!ShortFloat methodsFor:'comparing'!
< aNumber
"return true, if the argument is greater"
%{ /* NOCONTEXT */
if (__isSmallInteger(aNumber)) {
RETURN ( (__shortFloatVal(self) < (float)(__intVal(aNumber))) ? true : false );
}
if (__isFloatLike(aNumber)) {
RETURN ( (double)(__shortFloatVal(self) < __floatVal(aNumber)) ? true : false );
}
if (__isShortFloat(aNumber)) {
RETURN ( (__shortFloatVal(self) < __shortFloatVal(aNumber)) ? true : false );
}
%}.
^ aNumber lessFromShortFloat:self
"
1.0 asShortFloat > (1/3)
"
!
<= aNumber
"return true, if the argument is greater or equal"
%{ /* NOCONTEXT */
if (__isSmallInteger(aNumber)) {
RETURN ( (__shortFloatVal(self) <= (float)(__intVal(aNumber))) ? true : false );
}
if (__isFloatLike(aNumber)) {
RETURN ( (double)(__shortFloatVal(self) <= __floatVal(aNumber)) ? true : false );
}
if (__isShortFloat(aNumber)) {
RETURN ( (__shortFloatVal(self) <= __shortFloatVal(aNumber)) ? true : false );
}
%}.
^ self retry:#<= coercing:aNumber
!
= aNumber
"return true, if the arguments value are equal by value"
%{ /* NOCONTEXT */
if (__isSmallInteger(aNumber)) {
RETURN ( (__shortFloatVal(self) == (float)(__intVal(aNumber))) ? true : false );
}
if (__isFloatLike(aNumber)) {
RETURN ( (double)(__shortFloatVal(self) == __floatVal(aNumber)) ? true : false );
}
if (__isShortFloat(aNumber)) {
RETURN ( (__shortFloatVal(self) == __shortFloatVal(aNumber)) ? true : false );
}
%}.
^ self retry:#= coercing:aNumber
!
> aNumber
"return true, if the argument is less"
%{ /* NOCONTEXT */
if (__isSmallInteger(aNumber)) {
RETURN ( (__shortFloatVal(self) > (float)(__intVal(aNumber))) ? true : false );
}
if (__isFloatLike(aNumber)) {
RETURN ( (double)(__shortFloatVal(self) > __floatVal(aNumber)) ? true : false );
}
if (__isShortFloat(aNumber)) {
RETURN ( (__shortFloatVal(self) > __shortFloatVal(aNumber)) ? true : false );
}
%}.
^ self retry:#> coercing:aNumber
!
>= aNumber
"return true, if the argument is less or equal"
%{ /* NOCONTEXT */
if (__isSmallInteger(aNumber)) {
RETURN ( (__shortFloatVal(self) >= (float)(__intVal(aNumber))) ? true : false );
}
if (__isFloatLike(aNumber)) {
RETURN ( (double)(__shortFloatVal(self) >= __floatVal(aNumber)) ? true : false );
}
if (__isShortFloat(aNumber)) {
RETURN ( (__shortFloatVal(self) >= __shortFloatVal(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
].
].
^ self asFloat hash
"
1.2345 hash
1.2345 asShortFloat hash
1.0 hash
1.0 asShortFloat hash
0.5 asShortFloat hash
0.25 asShortFloat hash
0.5 hash
0.25 hash
"
!
~= aNumber
"return true, if the arguments value are not equal"
%{ /* NOCONTEXT */
if (__isSmallInteger(aNumber)) {
RETURN ( (__shortFloatVal(self) != (float)(__intVal(aNumber))) ? true : false );
}
if (__isFloatLike(aNumber)) {
RETURN ( (double)(__shortFloatVal(self) != __floatVal(aNumber)) ? true : false );
}
if (__isShortFloat(aNumber)) {
RETURN ( (__shortFloatVal(self) != __shortFloatVal(aNumber)) ? true : false );
}
%}.
^ self retry:#~= coercing:aNumber
! !
!ShortFloat methodsFor:'printing & storing'!
printString
"return a printed representation of the receiver
LimitedPrecisonReal and its subclasses use #printString instead of
#printOn: as basic print mechanism."
%{ /* NOCONTEXT */
char buffer[64];
REGISTER char *cp;
OBJ s;
/*
* actually only needed on sparc: since thisContext is
* in a global register, which gets destroyed by printf,
* manually save it here - very stupid ...
*/
__BEGIN_PROTECT_REGISTERS__
#ifdef SYSV
sprintf(buffer, "%.6lg", (double)__shortFloatVal(self));
#else
sprintf(buffer, "%.6G", (double)__shortFloatVal(self));
#endif
__END_PROTECT_REGISTERS__
/*
* kludge to make integral float f prints as "f.0" (not as "f" as printf does)
* (i.e. look if string contains '.' or 'e' and append '.0' if not)
*/
for (cp = buffer; *cp; cp++) {
if ((*cp == '.') || (*cp == 'e') || (*cp == 'E')) break;
}
if (! *cp) {
*cp++ = '.';
*cp++ = '0';
*cp = '\0';
}
s = __MKSTRING(buffer COMMA_SND);
if (s != nil) {
RETURN (s);
}
%}.
^ self asFloat printString
! !
!ShortFloat 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( (double)(__shortFloatVal(self)), &exp);
if (__threadErrno == 0) {
RETURN (__MKSMALLINT(exp));
}
%}.
^ self primitiveFailed
"
1.0 asShortFloat exponent
1.0 asShortFloat exponent
0.5 asShortFloat exponent
0.25 asShortFloat exponent
0.00000011111 asShortFloat 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( (double)(__shortFloatVal(self)), &exp);
if (__threadErrno == 0) {
RETURN (__MKFLOAT(frac));
}
%}.
^ self primitiveFailed
"
1.0 asShortFloat exponent
1.0 asShortFloat mantissa
0.5 asShortFloat exponent
0.5 asShortFloat mantissa
0.25 asShortFloat exponent
0.25 asShortFloat mantissa
0.00000011111 asShortFloat exponent
0.00000011111 asShortFloat mantissa
"
! !
!ShortFloat methodsFor:'testing'!
isFinite
"return true, if the receiver is a finite float
i.e. not NaN and not infinite."
%{ /* NOCONTEXT */
double dV = (double) __shortFloatVal(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 asShortFloat isFinite
(0.0 asShortFloat uncheckedDivide: 0.0) isFinite
(1.0 asShortFloat 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 */
double dV = (double)(__shortFloatVal(self));
/*
* notice: on machines which do not provide
* a finite() macro or function (WIN32),
* this may always ret false here ...
*/
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 asShortFloat isNaN
(0.0 asShortFloat uncheckedDivide: 0.0) isNaN
"
!
negative
"return true if the receiver is less than zero"
%{ /* NOCONTEXT */
RETURN ( (__shortFloatVal(self) < 0.0) ? true : false );
%}.
^ self < 0.0
!
numberOfBits
"return the size (in bits) of the real;
typically, 32 is returned here,
but who knows ..."
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT (sizeof(float) * 8));
%}
"
1.2 numberOfBits
1.2 asShortFloat numberOfBits
"
!
positive
"return true if the receiver is greater or equal to zero"
%{ /* NOCONTEXT */
RETURN ( (__shortFloatVal(self) >= 0.0) ? true : false );
%}
!
strictlyPositive
"return true if the receiver is greater than zero"
%{ /* NOCONTEXT */
RETURN ( (__shortFloatVal(self) > 0.0) ? true : false );
%}
! !
!ShortFloat methodsFor:'truncation & rounding'!
floor
"return the integer nearest the receiver towards negative infinity."
|val|
%{
float fVal;
/*
* ST-80 (and X3J20) returns integer.
*/
fVal = (float)(floor((double)__shortFloatVal(self)));
if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
RETURN ( __MKSMALLINT( (INT) fVal ) );
}
__qMKSFLOAT(val, fVal);
%}.
^ val asInteger
"
0.5 asShortFloat floor
-0.5 asShortFloat floor
"
!
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((double)(__shortFloatVal(self)), &trunc);
if (__threadErrno == 0) {
RETURN (__MKSFLOAT(frac));
}
%}.
^ self primitiveFailed
"
1.0 asShortFloat fractionalPart
0.5 asShortFloat fractionalPart
0.25 asShortFloat fractionalPart
3.14159 asShortFloat fractionalPart
12345673.14159 asShortFloat fractionalPart
123456731231231231.14159 asShortFloat fractionalPart
"
! !
!ShortFloat class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.61 2000-08-21 22:45:29 cg Exp $'
! !