"

 COPYRIGHT (c) 1996 by Claus Gittinger

 COPYRIGHT (c) 2018 Jan Vrany

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

	instanceVariableNames:''

	classVariableNames:'DefaultPrintFormat Pi E Epsilon'

	poolDictionaries:''

	category:'Magnitude-Numbers'

!

!ShortFloat primitiveDefinitions!

%{

#include <stdio.h>

#include <errno.h>

#ifndef __OPTIMIZE__

# define __OPTIMIZE__

#endif

#define __USE_ISOC9X 1

#define __USE_ISOC99 1

#include <math.h>

#ifndef INT32

# define INT32 int

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

# ifndef isnanf

#  define isnanf(x)      \

	(((unsigned int *)(&x))[0] == 0xFFC00000)

# endif

# ifndef isPositiveInfinityf

#  define isPositiveInfinityf(x)      \

	(((unsigned int *)(&x))[0] == 0x7F800000)

# endif

# ifndef isNegativeInfinityf

#  define isNegativeInfinityf(x)      \

	(((unsigned int *)(&x))[0] == 0xFF800000)

# endif

# ifndef isinff

#  define isinff(x)      \

	((((unsigned int *)(&x))[0] & 0x7FFFFFFF) == 0x7F800000)

# endif

# ifndef isfinitef

#  define isfinitef(x) (!isinff(x) && !isnanf(x))

# endif

# define NO_ASINH

# define NO_ACOSH

# define NO_ATANH

# ifdef __BORLANDC__

#  define NO_FMODF

#  define NO_MODFF

# endif

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

#ifndef isfinitef

# define isfinitef(x) isfinite(x)

#endif

#ifndef isnanf

# define isnanf(x) isnan(x)

#endif

%}

! !

!ShortFloat class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1996 by Claus Gittinger

 COPYRIGHT (c) 2018 Jan Vrany

	      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.

    They use the C-compilers 'float' format, which is usually the IEEE single float format.

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

    ShortFloats give you 32 bit floats.

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

    ST-80's Floats respectively. The reason was to make ST/X's floats compatible

    to bothe visualWorks and other smalltalks, which use C-doubles for the Float class.

    Thus, STX's Float precision is not worse than that of other ST's.

    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 some of 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.

    Mixed mode arithmetic:

	shortFloat op shortFloat   -> shortFloat

	shortFloat op fix         -> shortFloat

	shortFloat op fraction    -> shortFloat

	shortFloat op integer     -> shortFloat

	shortFloat op longFloat   -> longFloat

	shortFloat op float       -> float

	shortFloat op complex     -> complex

    Representation:

	    32bit single precision IEEE floats

	    23 bit mantissa,

	    8 bit exponent,

	    6 decimal digits (approx)

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

    [author:]

	Claus Gittinger

    [see also:]

	Number

	Float LongFloat Fraction FixedPoint Integer Complex

	FloatArray DoubleArray

"

! !

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

%}

!

coerce:aNumber

    "convert the argument aNumber into an instance of the receiver's class and return it."

    ^ aNumber asShortFloat.

!

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,

     especially for mass-data."

%{   /* NOCONTEXT */

     if (__isStringLike(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

	]

     ]

    "

!

fromIEEE32Bit: anInteger

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

%{  /* NOCONTEXT */

    REGISTER union {

	unsigned int    i;

	float           f;

    } r;

    r.i = __unsignedLongIntVal( anInteger );

    RETURN( __MKSFLOAT(r.f) );

%}

    "

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

    "

!

fromNumber:aNumber

    ^aNumber asShortFloat

! !

!ShortFloat class methodsFor:'accessing'!

defaultPrintFormat

    ^ DefaultPrintFormat

!

defaultPrintFormat:aString

    DefaultPrintFormat := aString.

!

epsilon

    Epsilon isNil ifTrue:[

	Epsilon := self computeEpsilon.

    ].

    ^ Epsilon

! !

!ShortFloat class methodsFor:'binary storage'!

readBinaryIEEESingleFrom:aStream

    "read a float value from the binary stream, aStream,

     interpreting the next bytes as an IEEE formatted 4-byte float.

     The bytes are read in the native byte order (i.e.lsb on intel)"

    |f|

    f := ShortFloat basicNew.

    self readBinaryIEEESingleFrom:aStream into:f MSB:(UninterpretedBytes isBigEndian).

    ^ f

    "not part of libboss, as this is also used by others (TIFFReader)"

    "Created: / 16-04-1996 / 21:00:35 / cg"

    "Modified: / 23-08-2006 / 16:01:47 / cg"

!

readBinaryIEEESingleFrom:aStream MSB:msbFirst

    "read a float value from the binary stream, aStream,

     interpreting the next bytes as an IEEE formatted 4-byte float.

     The bytes are read in the soecified byte order"

    |f|

    f := ShortFloat basicNew.

    self readBinaryIEEESingleFrom:aStream into:f MSB:msbFirst.

    ^ f

    "not part of libboss, as this is also used by others (TIFFReader)"

    "Created: / 16-04-1996 / 21:00:35 / cg"

    "Modified: / 23-08-2006 / 16:01:47 / cg"

!

readBinaryIEEESingleFrom:aStream into:aBasicNewShortFloat

    "read a float value from the binary stream, aStream,

     interpreting the next bytes as an IEEE formatted 4-byte float.

     The bytes are read in the native byte order (i.e.lsb on intel)"

    ^ self readBinaryIEEESingleFrom:aStream into:aBasicNewShortFloat MSB:(UninterpretedBytes isBigEndian)

    "Modified: / 23-08-2006 / 16:01:52 / cg"

!

readBinaryIEEESingleFrom:aStream into:aBasicNewShortFloat MSB:msb

    "read a float value from the binary stream, aStream,

     interpreting the next bytes as an IEEE formatted 4-byte float.

     If msb is true, the stream bytes are most-significant-first."

    aBasicNewShortFloat class == self ifFalse:[self error:'no a ShortFloat'].

    "

     this implementation is wrong: does not work on non-IEEE machines

     (to date all machines where ST/X is running on use

      IEEE float format. Need more here, when porting ST/X to 370's)

    "

    self isIEEEFormat ifFalse:[self error:'unsupported operation'].

    (UninterpretedBytes isBigEndian == msb) ifFalse:[

	"swap the bytes"

	4 to:1 by:-1 do:[:i |

	    aBasicNewShortFloat basicAt:i put:(aStream next)

	].

	^ self

    ].

    1 to:4 do:[:i |

	aBasicNewShortFloat basicAt:i put:aStream next

    ]

    "not part of libboss, as this is also used by others (TIFFReader)"

    "Modified: / 23-08-2006 / 16:01:52 / cg"

!

storeBinaryIEEESingle:aFloat on:aStream

    "store aFloat as an IEEE formatted 4-byte float

     onto the binary stream, aStream.

     The bytes are written in the native byte order (i.e.lsb on intel)"

    self storeBinaryIEEESingle:aFloat on:aStream MSB:(UninterpretedBytes isBigEndian).

!

storeBinaryIEEESingle:aFloat on:aStream MSB:msb

    "store aFloat as an IEEE formatted 4-byte float

     onto the binary stream, aStream.

     If msb is true, the stream bytes are written most-significant-first."

    |float|

    float := aFloat asShortFloat.

    "

     this implementation is wrong: does not work on non-IEEE machines

     (to date all machines where ST/X is running on use

      IEEE float format. Need more here, when porting ST/X to 370's)

    "

    self isIEEEFormat ifFalse:[self error:'unsupported operation'].

    (UninterpretedBytes isBigEndian == msb) ifFalse:[

	"swap the bytes"

	4 to:1 by:-1 do:[:i |

	    aStream nextPut:(float basicAt:i).

	].

	^ self

    ].

    1 to:4 do:[:i |

	aStream nextPut:(float basicAt:i).

    ]

    "not part of libboss, as this is also used by others (TIFFReader)"

    "Modified: / 23-08-2006 / 16:01:55 / cg"

! !

!ShortFloat class methodsFor:'class initialization'!

initialize

    DefaultPrintFormat := '.7'.  "/ print 7 valid digits

    "

     self initialize

    "

! !

!ShortFloat class methodsFor:'constants'!

e

    "return the constant e as ShortFloat"

    E isNil ifTrue:[

	E := Float e asShortFloat

    ].

    ^ E

!