"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1999 by eXept Software AG

	      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:#LongFloat

	instanceVariableNames:''

	classVariableNames:'DefaultPrintFormat DefaultPrintfFormat DefaultPrintPrecision

		LongFloatZero LongFloatOne Pi E Epsilon NaN PositiveInfinity

		NegativeInfinity Halfpi HalfpiNegative Phi'

	poolDictionaries:''

	category:'Magnitude-Numbers'

!

!LongFloat primitiveDefinitions!

%{

#include <stdio.h>

#include <errno.h>

#ifndef __OPTIMIZE__

# define __OPTIMIZE__

#endif

#define __USE_ISOC9X 1

#define __USE_ISOC99 1

#include <math.h>

/*

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

 */

#ifndef errno

 extern errno;

#endif

#if !defined (__win32__)

# include <locale.h>

#endif

#include <float.h>

#if defined(__irix__) || defined(__solaris__) || defined(__sunos__)

# include <nan.h>

#endif

#if defined(__osx__)

# include <math.h>

#endif

#if defined(__linux__)

# ifndef NAN

#  include <bits/nan.h>

# endif

#endif

#ifdef __win32__

/*

 * no finite(x) ?

 * no isnan(x) ?

 */

# ifndef isnanl

#  define isnanl(x)      \

	((((unsigned int *)(&x))[0] == 0x00000000) && \

	 (((unsigned int *)(&x))[1] == 0xC0000000) && \

	 (((unsigned short *)(&x))[4] & 0x7FFF == 0x7FFF))

# endif

# ifndef isnan

#  define isnan(x)      \

	((((unsigned int *)(&x))[1] & 0x7FF80000) == 0x7FF80000)

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

   // sigh: the default ming setup uses the microsoft printf,

   // which does not support long doubles

#  define snprintf  __mingw_snprintf

# endif /* __MINGW__ */

#endif /* __win32__ */

#ifdef __solaris__

# ifndef isfinite

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

# endif

#endif

#ifdef __realIX__

# ifndef isfinite

#  define isfinite(x)     1

# endif

#endif /* realIX */

#if defined(__GNUC__) || defined(__MINGW__) || defined(__win32__)

# ifndef LONGFLOAT_t

#  define LONGFLOAT_t      long double

# endif

# if defined(__linux__) || defined(__osx__) || defined(__win32__)

#  define LONG_ceil     ceill

#  define LONG_floor    floorl

#  define LONG_sqrt     sqrtl

#  define LONG_sin      sinl

#  define LONG_cos      cosl

#  define LONG_tan      tanl

#  define LONG_sinh     sinhl

#  define LONG_cosh     coshl

#  define LONG_tanh     tanhl

#  define LONG_asin     asinl

#  define LONG_acos     acosl

#  define LONG_atan     atanl

#  define LONG_exp      expl

#  define LONG_frexp    frexpl

#  define LONG_log      logl

#  define LONG_log10    log10l

#  define LONG_modf     modfl

#  define LONG_trunc    truncl

#  define LONG_pow      powl

#  ifdef __llvm__

#   define LONG_isnan    isnan

#  else

#   define LONG_isnan    isnanl

#  endif

#  if defined(__osx__)

#   define LONG_isfinite isfinite

#  else

#   define LONG_isfinite isfinitel

#  endif

#  if !defined(__win32__)

#   define LONG_asinh    asinhl

#   define LONG_acosh    acoshl

#   define LONG_atanh    atanhl

#  endif /* linux */

# endif  /* defined(__linux__) || defined(__win32__) */

# if !defined(LONG_isnan)

/* This should be true for ISO C99 systems - even for newer linux systems */

#  define LONG_isnan    isnan

#  define LONG_isfinite isfinite

# endif /* !defined(LONG_isnan) */

#endif /* defined(__GNUC__) || defined(__win32__) */

%}

! !

!LongFloat class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1999 by eXept Software AG

	      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

"

    LongFloats represent rational numbers with limited precision.

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

    which is either mapped to the IEEE extended precision (80bit)

    or IEEE quadruple precision format (128bit).

    In contrast to Floats (which use the C-compilers 64bit 'double' format),

    LongFloats give you one of 80 bit extended floats, 96 bit extended floats or 128 bit quadruple floats,

    depending on the underlying CPU.

    Thus, code using longFloats is not guaranteed to be portable from one architecture to another,

    but faster than software emulations.

    NOTE:

	on systems which do not support 'long doubles', LongFloats are (silently)

	represented as 'doubles'.

    Representation:

	gcc-x86:

	    80bit extended IEEE floats stored in in 96bits (12bytes);

	    1 bit integer part,

	    64 bit mantissa,

	    16 bit exponent,

	    19 decimal digits (approx.)

	borland-x86 (WIN32):

	    80bit extended IEEE floats stored in in 80bits (10bytes);

	    1 bit integer part,

	    64 bit mantissa,

	    16 bit exponent,

	    19 decimal digits (approx.)

	gcc-x86_64: (WIN64)

	    like gcc-x86

	gcc-sparc:

	    128bit quadruple IEEE floats (16bytes);

	    112 bit mantissa,

	    16 bit exponent,

	    34 decimal digits (approx.)

    Mixed mode arithmetic:

	longFloat op longFloat   -> longFloat

	longFloat op fix         -> longFloat

	longFloat op fraction    -> longFloat

	longFloat op integer     -> longFloat

	longFloat op shortFloat  -> longFloat

	longFloat op float       -> longFloat

	longFloat op complex     -> complex

    Range and precision of storage formats: see LimitedPrecisionReal >> documentation

    [author:]

	Claus Gittinger

    [see also:]

	Number

	Float ShortFloat Fraction FixedPoint Integer Complex

	FloatArray DoubleArray

	https://en.wikipedia.org/wiki/Extended_precision

"

! !

!LongFloat class methodsFor:'instance creation'!

basicNew

    "return a new longFloat - here we return 0.0

     - LongFloats are usually NOT created this way ...

     Its implemented here to allow things like binary store & load

     of longFloats. (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__

    return __c__._RETURN( new STDouble(0.0) );

#else

    OBJ newFloat;

    if (sizeof(LONGFLOAT_t) == sizeof(double)) {

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

    } else {

	__qMKLFLOAT(newFloat, 0.0);   /* OBJECT ALLOCATION */

    }

    RETURN (newFloat);

#endif /* not SCHTEAM */

%}

!

fastFromString:aString at:startIndex

    "return the next LongFloat 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 strtold).

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

	OBJ newFloat;

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

#ifndef NO_STRTOLD

	    long double strtold(const char *, char**);

	    LONGFLOAT_t val = strtold(cp+idx, NULL);

	    __qMKLFLOAT(newFloat, val);

	    RETURN (newFloat);

#else

# ifndef NO_SSCANF_LONGFLOAT

	    LONGFLOAT_t val;

	    sscanf(cp+idx, "%Lf", &val);

	    __qMKLFLOAT(newFloat, val);

	    RETURN (newFloat);

# endif

#endif

	}

     }

%}.

     ^ self readFromString:(startIndex == 1 ifTrue:[aString] ifFalse:[aString from:startIndex])

    "

     LongFloat fastFromString:'123.45' at:1

     LongFloat fastFromString:'123.45' at:2

     LongFloat fastFromString:'123.45' at:3

     LongFloat fastFromString:'123.45' at:4

     LongFloat fastFromString:'123.45' at:5

     LongFloat fastFromString:'123.45' at:6

     LongFloat fastFromString:'123.45E4' at:1

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

     LongFloat fastFromString:'12345' at:1

     LongFloat fastFromString:'12345' at:2

     LongFloat fastFromString:'12345' at:3

     LongFloat fastFromString:'12345' at:4

     LongFloat fastFromString:'12345' at:5

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

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

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

     LongFloat fastFromString:'1.7976931348623157e+308'

     LongFloat fastFromString:'Nan'

     LongFloat fastFromString:'+Inf'

     LongFloat fastFromString:'-Inf'

    "

    "

     Time millisecondsToRun:[

	1000000 timesRepeat:[

	    LongFloat readFrom:'123.45'

	]

     ]

    "

    "

     Time millisecondsToRun:[

	1000000 timesRepeat:[

	    LongFloat fastFromString:'123.45' at:1

	]

     ]

    "

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

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

!

fromFloat:aFloat

    "return a new longFloat, given a float value"

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    if (aFloat.isDouble()) {

	return __c__._RETURN(aFloat);

    }

    if (aFloat.isFloat()) {

	return __c__._RETURN( new STDouble(aFloat.floatValue()) );

    }

#else

    OBJ newFloat;

    LONGFLOAT_t f;

    if (sizeof(LONGFLOAT_t) == sizeof(double)) {

	RETURN (aFloat);

    }

    if (__isFloatLike(aFloat)) {

	f = (LONGFLOAT_t)(__floatVal(aFloat));

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

	RETURN (newFloat);

    }

#endif

%}.

    ArgumenError raise

    "

     LongFloat fromFloat:123.0

     123.0 asLongFloat

     123 asLongFloat

    "

!

fromIEEE32Bit: anInteger

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

%{  /* NOCONTEXT */

    OBJ newFloat;

    REGISTER union {

	unsigned int    i;

	float           f;

    } r;

    LONGFLOAT_t f;

    r.i = __unsignedLongIntVal( anInteger );

    f = (LONGFLOAT_t)r.f;

    __qMKLFLOAT(newFloat, f);

    RETURN( newFloat );

%}.

    ^ Float fromIEEE32Bit: anInteger

    "

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

    "

    "Modified: / 21-06-2017 / 09:35:58 / cg"

!

fromIEEE64Bit: anInteger

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

%{  /* NOCONTEXT */

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

    REGISTER union {

	__uint64__  u64;

	double      d;

    } r;

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

	OBJ newFloat;

	LONGFLOAT_t f = (LONGFLOAT_t)r.d;

	__qMKLFLOAT(newFloat, f);

	RETURN( newFloat );

    }

%}.

    ^ Float fromIEEE32Bit: anInteger

    "

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

    "

    "Modified (comment): / 21-06-2017 / 09:36:34 / cg"

!

fromInteger:anInteger

    "return a new longFloat, given an integer value"

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    if (anInteger.isSmallInteger()) {

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

    }

#else

    OBJ newFloat;

    if (__isSmallInteger(anInteger)) {

	LONGFLOAT_t f = (LONGFLOAT_t)__smallIntegerVal(anInteger);

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

	RETURN (newFloat);

    }

#endif /* not SCHTEAM */

%}.