"

 COPYRIGHT (c) 1996 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' }"

LimitedPrecisionReal variableByteSubclass:#ShortFloat

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Magnitude-Numbers'

!

!ShortFloat primitiveDefinitions!

%{

#include <errno.h>

#ifndef __OPTIMIZE__

# define __OPTIMIZE__

#endif

#define __USE_ISOC9X 1

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

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

%}

! !

!ShortFloat class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1996 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

"

    ShortFloats represent rational numbers with limited precision. In ST/X, Float uses

    the underlying C-compilers double implementation, while ShortFloats are

    mapped onto C-floats.

    Therefore instances of Float are usually represented by the 8-byte IEE 

    double precision float format, while ShortFloats use 4byte IEE format.

    (but there is no guaranty).

    Notice, that ST/X Floats are what Doubles are in ST-80 and ShortFloats are

    ST-80's Floats respectively.

    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 shortFloat 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 its float-checks by an identity compare with the ShortFloat-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).

    This may be changed, to use a flag bit in the class.

    [author:]

	Claus Gittinger

    [see also:]

	Number

	Float Fraction FixedPoint Integer

"

! !

!ShortFloat class methodsFor:'instance creation'!

basicNew

    "return a new shortFloat - here we return 0.0

     - shortFloats are usually NOT created this way ...

     Its implemented here to allow things like binary store & load

     of shortFloats. (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;

    __qMKSFLOAT(newFloat, 0.0);

    RETURN (newFloat);

%}

!

fastFromString:aString at:startIndex

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

     No spaces are skipped.

     This is a specially tuned entry (using a low-level C-call), which

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

     It has been added to allow higher speed string decomposition into

     numbers."

%{

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

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

	int idx = __intVal(startIndex) - 1;

	double atof();

	double val;

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

	    val = atof(cp + idx);

	    RETURN (__MKSFLOAT(val));

	}

     }

%}.

     self primitiveFailed.

    "

     ShortFloat fastFromString:'123.45' at:1  

     ShortFloat fastFromString:'123.45' at:2  

     ShortFloat fastFromString:'123.45E4' at:1  

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

     ShortFloat fastFromString:'12345' at:1  

     ShortFloat fastFromString:'12345' at:2  

     ShortFloat fastFromString:'12345' at:3  

     ShortFloat fastFromString:'12345' at:4  

     ShortFloat fastFromString:'12345' at:5  

     ShortFloat fastFromString:'12345' at:6  

     ShortFloat fastFromString:'12345' at:0  

     ShortFloat fastFromString:'hello123.45E4' at:1  

     Time millisecondsToRun:[

	100000 timesRepeat:[

	    ShortFloat readFrom:'123.45'

	]

     ]

    "

    "

     Time millisecondsToRun:[

	100000 timesRepeat:[

	    ShortFloat fastFromString:'123.45' at:1  

	]

     ]

    "

!

readFrom:aStringOrStream

    "read a shortFloat from a string"

    |num|

    num := super readFrom:aStringOrStream onError:[self error:'conversion error for: ' , self name].

    num notNil ifTrue:[  

	num := num asShortFloat

    ].

    ^ num 

    "

     ShortFloat readFrom:'0.1'

     ShortFloat readFrom:'0'    

     ShortFloat readFrom:'.123' 

     ShortFloat readFrom:'-.123'   

     ShortFloat readFrom:'1e4'  

    "

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

!

readFrom:aStringOrStream onError:exceptionBlock

    "read a shortFloat from a string"

    |num|

    num := super readFrom:aStringOrStream onError:nil.

    num isNil ifTrue:[  

	^ exceptionBlock value

    ].

    ^ num asShortFloat

    "

     ShortFloat readFrom:'0.1'

     ShortFloat readFrom:'0'

     ShortFloat readFrom:'.123'

    "

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

! !

!ShortFloat class methodsFor:'constants'!

pi

    "return the constant pi as ShortFloat"

    ^ 3.14159265358979323846264338327950288419716939937510582097494459 asShortFloat

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

!

precision

   "answer the precision of a Float

    This is an IEEE float, only the fraction from the normalized mantissa is stored 

    and so there is a hidden bit and the mantissa is actually represented 

    by 24 binary digits"

    ^  24

!

radix

   "answer the radix of a Float

    This is an IEEE float, which is represented as binary"

    ^  2

!

unity

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

    ^ 1.0 asShortFloat

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

!

zero

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

    ^ 0.0 asShortFloat

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

! !

!ShortFloat 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 == ShortFloat

    "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

! !

!ShortFloat methodsFor:'arithmetic'!

* aNumber

    "return the product of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    float result;

    double dResult;

    if (__isSmallInteger(aNumber)) {

	result = __shortFloatVal(self) * (float)(__intVal(aNumber));

retResult:

	__qMKSFLOAT(newFloat, result);

	RETURN ( newFloat );

    } else if (__isShortFloat(aNumber)) {

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

	goto retResult;

    } else if (__isFloatLike(aNumber)) {

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

	__qMKFLOAT(newFloat, dResult);

	RETURN ( newFloat );

    }

%}.

    ^ aNumber productFromShortFloat:self

!

+ aNumber

    "return the sum of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    float result;

    double dResult;

    if (__isSmallInteger(aNumber)) {

	result = __shortFloatVal(self) + (float)(__intVal(aNumber));

retResult:

	__qMKSFLOAT(newFloat, result);

	RETURN ( newFloat );

    } else if (__isShortFloat(aNumber)) {

	result = __shortFloatVal(self) + __shortFloatVal(aNumber);

	goto retResult;

    } else if (__isFloatLike(aNumber)) {

	dResult = (double) __shortFloatVal(self) + __floatVal(aNumber);

	__qMKFLOAT(newFloat, dResult);

	RETURN ( newFloat );

    }

%}.

    ^ aNumber sumFromShortFloat:self

!

- aNumber

    "return the difference of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    float result;

    double dResult;

    if (__isSmallInteger(aNumber)) {

	result = __shortFloatVal(self) - (float)(__intVal(aNumber));

retResult:

	__qMKSFLOAT(newFloat, result);

	RETURN ( newFloat );

    } else if (__isShortFloat(aNumber)) {

	result = __shortFloatVal(self) - __shortFloatVal(aNumber);

	goto retResult;

    } else if (__isFloatLike(aNumber)) {

	dResult = (double) __shortFloatVal(self) - __floatVal(aNumber);

	__qMKFLOAT(newFloat, dResult);

	RETURN ( newFloat );

    }

%}.

    ^ aNumber differenceFromShortFloat:self

!

/ aNumber

    "return the quotient of the receiver and the argument, aNumber"

%{  /* NOCONTEXT */

    OBJ newFloat;

    float result, val;

    double dResult, dVal;

    if (__isSmallInteger(aNumber)) {

        if (aNumber != __MKSMALLINT(0)) {

            result = __shortFloatVal(self) / (float)(__intVal(aNumber));

retResult:

            __qMKSFLOAT(newFloat, result);

            RETURN ( newFloat );

        }

    } else if (__isShortFloat(aNumber)) {

        val = __shortFloatVal(aNumber);

        if (val != 0.0) {

            result = __shortFloatVal(self) / val;

            goto retResult;

        }

    } else if (__isFloatLike(aNumber)) {

        dVal = __floatVal(aNumber);

        if (dVal != 0.0) {

            dResult = (double) __shortFloatVal(self) / dVal;

            __qMKFLOAT(newFloat, dResult);

            RETURN ( newFloat );

        }

    }

%}.

    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[

        "

         No, you shalt not divide by zero

        "

        ^ DivisionByZeroSignal raiseRequestWith:thisContext.

    ].

    ^ aNumber quotientFromShortFloat:self

!

negated

    "return myself negated"

%{  /* NOCONTEXT */

    OBJ newFloat;

    float rslt = - __shortFloatVal(self);

    __qMKSFLOAT(newFloat, rslt);

    RETURN ( newFloat );

%}.

    ^ 0.0 - self

!

uncheckedDivide:aNumber

    "return the quotient of the receiver and the argument, aNumber

     Do not check for divide by zero (return NaN or infinity)"

%{  /* NOCONTEXT */

    OBJ newFloat;

    float result, val;

    double dResult, dVal;

    if (__isSmallInteger(aNumber)) {

	result = __shortFloatVal(self) / (float)(__intVal(aNumber));

retResult:

	__qMKSFLOAT(newFloat, result);

	RETURN ( newFloat );

    } else if (__isShortFloat(aNumber)) {

	val = __shortFloatVal(aNumber);

	result = __shortFloatVal(self) / val;

	goto retResult;

    } else if (__isFloatLike(aNumber)) {

	dVal = __floatVal(aNumber);

	dResult = (double) __shortFloatVal(self) / dVal;

	__qMKFLOAT(newFloat, dResult);

	RETURN ( newFloat );

    }

%}.

    ^ aNumber quotientFromShortFloat:self

    "

      0.0 asShortFloat uncheckedDivide:0

      1.0 asShortFloat uncheckedDivide:0.0

    "

! !

!ShortFloat methodsFor:'coercing & converting'!

asFloat

    "return a Float with same value as the receiver"

%{  /* NOCONTEXT */

    OBJ newFloat;

    double dVal = (double)__shortFloatVal(self);

    __qMKFLOAT(newFloat, dVal);