"

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

LimitedPrecisionReal variableByteSubclass:#LongFloat

	instanceVariableNames:''

	classVariableNames:'DefaultPrintFormat LongFloatZero LongFloatOne Pi E'

	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 isPositiveInfinity(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

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

# endif  /* defined(linux) || defined(WIN32) */

# if defined(linux)

#  define LONG_asinh    asinhl

#  define LONG_acosh    acoshl

#  define LONG_atanh    atanhl

# endif /* linux */

# 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 IEE extended float or IEE 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, longFloat code is not guaranteed to be portable).

    NO GARANTY:

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

	represented as 'doubles'.

    Representation:

	gcc-i386:

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

	    64 bit mantissa,

	    16 bit exponent,

	    19 decimal digits (approx)

	borland-i386 (WIN32):

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

	    64 bit mantissa,

	    16 bit exponent,

	    19 decimal digits (approx)

	gcc-sparc:

	    128bit quad IEE 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);

%}

!

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

    "

!

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

    "

!

readFrom:aStringOrStream onError:exceptionBlock

    "read a longFloat from a string"

    |num|

    num := super readFrom:aStringOrStream onError:nil.

    num isNil ifTrue:[

	^ exceptionBlock value

    ].

    ^ num asLongFloat

    "

     LongFloat readFrom:'0.1'

     LongFloat readFrom:'0'

    "

    "Modified: / 7.1.1998 / 16:17:59 / cg"

! !

!LongFloat class methodsFor:'accessing'!

defaultPrintFormat

    ^ DefaultPrintFormat

!

defaultPrintFormat:something

    DefaultPrintFormat := something.

! !

!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

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

!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned for myself, false for subclasses."

    ^ self == LongFloat

    "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

!