"

 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.

"

LimitedPrecisionReal variableByteSubclass:#Float

	instanceVariableNames:''

	classVariableNames:'DefaultPrintFormat'

	poolDictionaries:''

	category:'Magnitude-Numbers'

!

!Float primitiveDefinitions!

%{

#include <errno.h>

#ifndef __OPTIMIZE__

# define __OPTIMIZE__

#endif

#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)

# include <nan.h>

#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);

%}

!

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'!

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

    "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'!

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 */

    OBJ newFloat;

    double result;

    if (__isSmallInteger(aNumber)) {

        result = __floatVal(self) * (double)(__intVal(aNumber));

retResult:

        __qMKFLOAT(newFloat, result);

        RETURN ( newFloat );

    } else if (__isFloatLike(aNumber)) {

        result = __floatVal(self) * __floatVal(aNumber);

        goto retResult;

    } else if (__isShortFloat(aNumber)) {

        result = __floatVal(self) * (double)(__shortFloatVal(aNumber));

        goto retResult;

    }