"{ Encoding: utf8 }"

"

 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.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

LimitedPrecisionReal variableByteSubclass:#Float

	instanceVariableNames:''

	classVariableNames:'DefaultPrintFormat DefaultPrintfFormat DefaultPrintPrecision E

		Epsilon Halfpi HalfpiNegative Ln10 Ln2 MaxSmallInteger NaN

		NegativeInfinity Pi PositiveInfinity RadiansPerDegree Sqrt2 Twopi'

	poolDictionaries:''

	category:'Magnitude-Numbers'

!

!Float primitiveDefinitions!

%{

#include <stdio.h>

#include <errno.h>

#ifndef __OPTIMIZE__

# define __OPTIMIZE__

#endif

#define __USE_ISOC9X 1

#define __USE_ISOC99 1

#include <math.h>

#include <float.h>

#ifndef INT64

# ifdef HAS_LONGLONG

#  define INT64 long long int

# else

# define INT64 __int64

# endif

#endif

/*

 * on some systems errno is a macro ... check for it here

 */

#ifndef errno

 extern errno;

#endif

#if !defined (__win32__)

# include <locale.h>

#endif

#if defined(__irix__)

# include <nan.h>

#endif

#if defined(__linux__)

# ifndef NAN

#  include <bits/nan.h>

# endif

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

#  ifndef WIN32

  double cbrt();

#  endif

# endif

# ifndef tan

  double tan();

# endif

#endif /* not AIX */

#ifdef __win32__

/*

 * no finite(x) ?

 * no isnan(x) ?

 */

# ifndef isnan

#  define isnan(x)      \

// old, invalid definition

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

# define NO_ASINH

# define NO_ACOSH

# define NO_ATANH

# ifdef __MINGW__

#  ifndef _STRING_H_INCLUDED_

#   include <string.h>

#   define _STRING_H_INCLUDED_

#  endif

# endif

#endif /* __win32__ */

#ifdef solaris

# ifndef isfinite

#  define isfinite(f) finite((double)(f))

# endif

#endif

#ifdef realIX

# ifndef isfinite

#  define isfinite(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.

    They use the C-compiler's 'double' format,

    which is usually the 8byte IEEE double float format.

    Floats give you 64 bit floats.

    In contrast to ShortFloats (32bit) and LongFloats (>=64bit).

    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/shortFloats,

	and does some float-checks by an identity compare with the Float-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).

    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. The reason for doing this

    was to be compatible to both Digitalk, Squeak AND ParcPlace smalltalk implementations

    (ParcPlace uses a 4-byte Float and an 8-byte Double class, in contrast to

     Digitalk and Squeak, which have an 8-byte Float class).

    Thus, by providing an 8-byte Float class, code would not loose precicion

    (although some memory is wasted when porting from VW).

    Notice that ST/X provides an alias called Double, and an extra ShortFloat class, which has 4-byte

    instances.

    Mixed mode arithmetic:

	float op float       -> float

	float op fix         -> float

	float op fraction    -> float

	float op integer     -> float

	float op shortFloat  -> float

	float op longFloat   -> longFloat

	float op complex     -> complex

    Representation:

	    64bit double precision IEEE floats

	    52 bit mantissa + 1 hidden bit providing 53 bits of precision,

	    11 bit exponent,

	    15 decimal digits (approx.)

    Range and Precision of Storage Formats: see LimitedPrecisionReal >> documentation

    [author:]

	Claus Gittinger

    [see also:]

	Number

	ShortFloat LongFloat Fraction FixedPoint Integer Complex

	FloatArray DoubleArray

"

!

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

#ifdef __SCHTEAM__

    ERROR("trying to instantiate a float");

#else

    OBJ newFloat;

    __qMKFLOAT(newFloat, 0.0);

    RETURN (newFloat);

#endif /* not SCHTEAM */

%}

!

fastFromString:aString at:startIndex

    "return the next Float from the string starting at startIndex.

     No spaces are skipped.

     Raises an exception, if the startIndex is not valid.

     Returns garbage if the argument string is not a valid double float number.

     This is a specially tuned entry (using a low-level C-call to atof).

     It has been added to allow high speed string decomposition

     into numbers, especially for mass-data (reading millions of floats)."

%{   /* NOCONTEXT */

     int idx = __intVal(startIndex) - 1;

     if (__isStringLike(aString) && __isSmallInteger(startIndex)) {

	char *cp = (char *)(__stringVal(aString));

	double val;

	OBJ newFloat;

	if ((unsigned)idx < __stringSize(aString)) {

#ifndef NO_STRTOD

	    double strtod(const char *, char**);

	    val = strtod(cp+idx, NULL);

#else

	    double atof();

	    val = atof(cp + idx);

#endif

	    __qMKFLOAT(newFloat, val);

	    RETURN (newFloat);

	}

     }

%}.

     self primitiveFailed.

    "

     Float fastFromString:'123.45' at:1

     Float fastFromString:'123.45' at:2

     Float fastFromString:'123.45' at:3

     Float fastFromString:'123.45' at:4

     Float fastFromString:'123.45' at:5

     Float fastFromString:'123.45' at:6

     Float fastFromString:'123.45E4' at:1

     Float fastFromString:'hello123.45E4' at:6

     Float fastFromString:'12345' at:1

     Float fastFromString:'12345' at:2

     Float fastFromString:'12345' at:3

     Float fastFromString:'12345' at:4

     Float fastFromString:'12345' at:5

     Float fastFromString:'12345' at:6          -> error

     Float fastFromString:'12345' at:0          -> error

     Float fastFromString:'hello123.45E4' at:1  -> 0

     Float fastFromString:'1.7976931348623157e+308'

     Float fastFromString:'Nan'

     Float fastFromString:'+Inf'

     Float fastFromString:'-Inf'

    "

    "

     Time millisecondsToRun:[

	1000000 timesRepeat:[

	    Float readFrom:'123.45'

	]

     ]

    "

    "

     Time millisecondsToRun:[

	1000000 timesRepeat:[

	    Float fastFromString:'123.45' at:1

	]

     ]

    "

    "Modified (comment): / 21-06-2017 / 09:24:32 / cg"

    "Modified (comment): / 20-03-2019 / 13:45:12 / Claus Gittinger"

!

fromIEEE32Bit: anInteger

    "creates a double, given the four native float bytes as an integer"

%{  /* NOCONTEXT */

#ifndef __SCHTEAM__

    REGISTER union {

	unsigned int    i;

	float           f;

    } r;

    r.i = __unsignedLongIntVal( anInteger );

    RETURN( __MKFLOAT((double)(r.f)) );

#endif

%}.

    self primitiveFailed.

    "

     ShortFloat fromIEEE32Bit:((ShortFloat pi digitBytesMSB:true) asIntegerMSB:true)

    "

    "Modified (comment): / 21-06-2017 / 09:26:41 / cg"

!

fromIEEE64Bit: anInteger

    "creates a double, given the eight native double bytes as an integer"

%{  /* NOCONTEXT */

#ifndef __SCHTEAM__

    extern int __unsignedLong64IntVal(OBJ o, __uint64__ *pI);

    REGISTER union {

	__uint64__  u64;

	double      d;

    } r;

    if (__unsignedLong64IntVal(anInteger, &r.u64))  {

	RETURN( __MKFLOAT(r.d) );

    }

#endif

%}.

    self primitiveFailed.

    "

	Float fromIEEE64Bit:((Float pi digitBytesMSB:true) asIntegerMSB:true)

    "

    "Modified: / 21-06-2017 / 09:37:47 / cg"

!

fromInteger:anInteger

    "return a new float, given an integer value"

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    if (anInteger.isSmallInteger()) {

	return __c__._RETURN( STDouble._new( (double)(anInteger.longValue()) ));

    }

#else

    OBJ newFloat;

    if (__isSmallInteger(anInteger)) {

	double f = (double)__smallIntegerVal(anInteger);

	__qMKFLOAT(newFloat, f);   /* OBJECT ALLOCATION */

	RETURN (newFloat);

    }

#endif /* not SCHTEAM */

%}.

    ^ super fromInteger:anInteger

    "

     Float fromInteger:123

     Float fromInteger:(100 factorial)

     (100 factorial) asFloat

    "

!

fromNumber:aNumber

    "return aNumber coerced to Float"

    ^ aNumber asFloat

    "Modified (comment): / 21-06-2017 / 08:55:15 / cg"

!

fromVAXFloatBytes:b1 b2:b2 b3:b3 b4:b4

    "creates a double, given the four vax F-format float bytes to an ieee double.

     For NaNs and Infinity, nil is returned.

     To get an idea of how big the floating-point zoo really is,

     see: http://www.quadibloc.com/comp/cp0201.htm

    "

%{  /* NOCONTEXT */

#ifndef __SCHTEAM__

    REGISTER union {

	unsigned char   b[4];