"

 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 LongFloatZero LongFloatOne Pi E Epsilon'

	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

#if defined (_AIX)

# include <float.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

#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] == 0xFFFF))

# endif

# ifndef isnan

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

#  include <string.h>

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

#if defined(__GNUC__) || defined(WIN32)

# define LONGFLOAT      long double

# 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_pow      powl

#  define LONG_isnan    isnanl

#  define LONG_isfinite isfinitel

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

/*

 * on systems which do not support long doubles, fall back to double

 * arithmetic

 */

#ifndef LONGFLOAT

# define LONGFLOAT        double

# define LONGFLOAT_CLASS  Float

# define LONGFLOAT_GLOBAL @global(Float)

#else

# define LONGFLOAT_CLASS  LongFloat

# define LONGFLOAT_GLOBAL @global(LongFloat)

#endif

struct __longfloatstruct {

	STX_OBJ_HEADER

#ifdef __NEED_DOUBLE_ALIGN

	__FILLTYPE_DOUBLE       f_filler;

#endif

	LONGFLOAT               f_longfloatvalue;

};

#define __LongFloatInstPtr(obj)      ((struct __longfloatstruct *)(__objPtr(obj)))

#ifndef __longFloatVal

# define __longFloatVal(o) \

	__LongFloatInstPtr(o)->f_longfloatvalue

#endif

#ifndef __qMKLFLOAT

# define __qMKLFLOAT(__newFloat__, __fVal__) \

    { \

	__qNew(__newFloat__ , sizeof(struct __longfloatstruct)); \

	if (__newFloat__) { \

	    __objPtr(__newFloat__)->o_class = LONGFLOAT_GLOBAL; \

	    __LongFloatInstPtr(__newFloat__)->f_longfloatvalue = (LONGFLOAT)(__fVal__); \

	} \

    }

#endif

#ifndef __isLongFloat

# define __isLongFloat(o) \

	(__Class(o) == @global(LongFloat))

#endif

#ifndef __qIsLongFloat

# define __qIsLongFloat(o) \

	(__qClass(o) == @global(LongFloat))

#endif

%}

! !

!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-compilers 'long double' format, which is usually

    mapped to the IEEE extended float or IEEE quad float format.

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

    LongFloats give you 80 bit floats (extended) or 128 bit floats (quad).

    The actual number of bits depends on the underlying CPU.

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

    to another.

    NO GARANTY:

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

        represented as 'doubles'.

    Representation:

        gcc-x386:

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

            64 bit mantissa,

            16 bit exponent,

            19 decimal digits (approx)

        borland-i386 (WIN32):

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

            64 bit mantissa,

            16 bit exponent,

            19 decimal digits (approx)

        gcc-sparc:

            128bit quad 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

"

! !

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

    OBJ newFloat;

    if (sizeof(LONGFLOAT) == sizeof(double)) {

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

    } else {

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

    }

    RETURN (newFloat);

%}

!

coerce:aNumber

    ^ aNumber asLongFloat.

!

fromFloat:aFloat

    "return a new longFloat, given a float value"

%{  /* NOCONTEXT */

    OBJ newFloat;

    LONGFLOAT f;

    if (sizeof(LONGFLOAT) == sizeof(double)) {

	RETURN (aFloat);

    }

    if (__isFloatLike(aFloat)) {

	f = (LONGFLOAT)(__floatVal(aFloat));

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

	RETURN (newFloat);

    }

%}.

    self error:'invalid argumnet'

    "

     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;

    r.i = __unsignedLongIntVal( anInteger );

    __qMKLFLOAT(newFloat, r.f);

    RETURN( newFloat );

%}

    "

        LongFloat fromIEEE32Bit:(#[64 73 15 219] asInteger)

    "

!

fromInteger:anInteger

    "return a new longFloat, given a float value"

%{  /* NOCONTEXT */

    OBJ newFloat;

    LONGFLOAT f;

    if (__isSmallInteger(anInteger)) {

	f = (LONGFLOAT)(__smallIntegerVal(anInteger));

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

	RETURN (newFloat);

    }

%}.

    ^ super fromInteger:anInteger

    "

     LongFloat fromInteger:123

     LongFloat fromInteger:(100 factorial)

     (100 factorial) asFloat

    "

!

fromShortFloat:aFloat

    "return a new longFloat, given a shortFloat value"

%{  /* NOCONTEXT */

    OBJ newFloat;

    LONGFLOAT f;

    if (__isShortFloat(aFloat)) {

	f = (LONGFLOAT)(__shortFloatVal(aFloat));

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

	RETURN (newFloat);

    }

%}.

    self error:'invalid argumnet'

    "

     LongFloat fromShortFloat:(123.0 asShortFloat)

     LongFloat fromShortFloat:122

    "

! !

!LongFloat class methodsFor:'accessing'!

defaultPrintFormat

    ^ DefaultPrintFormat

!

defaultPrintFormat:something

    DefaultPrintFormat := something.

!

epsilon

    ^ Epsilon

! !

!LongFloat class methodsFor:'class initialization'!

initialize

    "do not write a literal constant here - we cannot depend on the underlying C-compiler here..."

    Pi isNil ifTrue:[

        DefaultPrintFormat := '.19'.  "/ 19 valid digits

        Epsilon := self computeEpsilon.

        "/ enough digits for 128bit IEEE quads

        Pi := self readFrom:'3.1415926535897932384626433832795029'. "/ 3.14159265358979323846264338327950288419716939937510582097494459q

        E  := self readFrom:'2.7182818284590452353602874713526625'.

    ].

    "

     Pi := nil.

     self initialize

    "

    "

     DefaultPrintFormat := '.19'.

     LongFloat pi printString.

     DefaultPrintFormat := '.9'.

     LongFloat pi printString.

     DefaultPrintFormat := '.6'.

     LongFloat pi printString.

    "

! !

!LongFloat class methodsFor:'constants'!

e

    "return the constant e as LongFloat"

    ^ E

!

pi

    "return the constant pi as LongFloat"

    ^ Pi

!

unity

    "return the neutral element for multiplication (1.0) as LongFloat"

    LongFloatOne isNil ifTrue:[

	LongFloatOne := 1.0 asLongFloat.

    ].

    ^ LongFloatOne

    "Modified: 23.4.1996 / 09:26:51 / cg"

!

zero

    "return the neutral element for addition (0.0) as LongFloat"

    LongFloatZero isNil ifTrue:[

	LongFloatZero := 0.0 asLongFloat

    ].

    ^ LongFloatZero

    "Modified: 23.4.1996 / 09:26:45 / cg"

! !

!LongFloat class methodsFor:'queries'!

exponentCharacter

    ^ $q