LongFloat.st
author Claus Gittinger <cg@exept.de>
Sat, 25 Sep 1999 15:20:37 +0200
changeset 4814 7825b9141f01
parent 4455 2d31d0d986be
child 4825 4c77d43433d1
permissions -rw-r--r--
changes to allow compilation under win32 (does not like strings beginning with a cr - how comes this ?)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 1999 by eXept Software AG
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	      All Rights Reserved
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
LimitedPrecisionReal variableByteSubclass:#LongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
	instanceVariableNames:''
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
	classVariableNames:''
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	poolDictionaries:''
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	category:'Magnitude-Numbers'
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
!LongFloat primitiveDefinitions!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
%{
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
#include <errno.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
#ifndef __OPTIMIZE__
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
# define __OPTIMIZE__
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
#endif
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    28
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
#include <math.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
/*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 * on some systems errno is a macro ... check for it here
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
#ifndef errno
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
 extern errno;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
#if defined (_AIX)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
# include <float.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
#if defined(IRIX)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
# include <nan.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
#if defined(LINUX)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
# include <nan.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
#if defined(solaris) || defined(sunos)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
# include <nan.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
#ifdef WIN32
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
/*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
 * no finite(x) ?
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
 * no isnan(x) ?
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
 */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
# ifndef finite 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
#  define finite(x)     1
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
# endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
# ifndef isnan
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
#  define isnan(x)      0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
# endif
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    62
#endif /* WIN32 */
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
#ifdef realIX
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
/*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
 * no finite(x)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
 */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
# ifndef finite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
#  define finite(x)     1
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
# endif
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    71
#endif /* realIX */
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
#ifdef WIN32
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
# define LONGFLOAT      long double
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
#endif
4168
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
    76
#if defined(__GNUC__) && defined(i386)
4250
5546439c3c5b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4168
diff changeset
    77
# define LONGFLOAT      long double
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    80
/*
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    81
 * on systems which do not support long doubles, fall back to Float
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    82
 * arithmetic
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    83
 */
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    84
#ifndef LONGFLOAT
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    85
# define LONGFLOAT       double
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    86
# define LONGFLOAT_CLASS  Float
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    87
# define LONGFLOAT_GLOBAL @global(Float)
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    88
#else
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    89
# define LONGFLOAT_CLASS LongFloat
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    90
# define LONGFLOAT_GLOBAL @global(LongFloat)
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    91
#endif
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    92
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    93
struct __longfloatstruct {
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    94
	HEADER
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    95
#ifdef __NEED_DOUBLE_ALIGN
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    96
	__FILLTYPE_DOUBLE       f_filler;
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    97
#endif
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    98
	LONGFLOAT               f_longfloatvalue;
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    99
};
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   100
#define __LongFloatInstPtr(obj)      ((struct __longfloatstruct *)(__objPtr(obj)))
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   101
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   102
#ifndef __longFloatVal
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   103
# define __longFloatVal(o) \
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   104
	__LongFloatInstPtr(o)->f_longfloatvalue
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   105
#endif
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   106
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
#ifndef __qMKLFLOAT
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
# define __qMKLFLOAT(__newFloat__, __fVal__) \
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
    { \
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   110
	__qNew(__newFloat__ , sizeof(struct __longfloatstruct)); \
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
	if (__newFloat__) { \
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   112
	    __qClass(__newFloat__) = LONGFLOAT_GLOBAL; \
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   113
	    __LongFloatInstPtr(__newFloat__)->f_longfloatvalue = (LONGFLOAT)(__fVal__); \
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
	} \
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
    }
4168
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   116
#endif
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   117
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   118
#ifndef __isLongFloat
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   119
# define __isLongFloat(o) \
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   120
	(__qClass(o) == @global(LongFloat))
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   121
#endif
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   122
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
%}
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
!LongFloat class methodsFor:'documentation'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
copyright
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
 COPYRIGHT (c) 1999 by eXept Software AG
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
	      All Rights Reserved
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
 This software is furnished under a license and may be used
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
 only in accordance with the terms of that license and with the
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
 inclusion of the above copyright notice.   This software may not
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
 be provided or otherwise made available to, or used by, any
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
 other person.  No title to or ownership of the software is
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
 hereby transferred.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
documentation
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
    LongFloats represent rational numbers with limited precision. In ST/X, Float uses
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
    the underlying C-compilers double implementation, while LongFloats are
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
    mapped onto C-long doubles.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
    Therefore instances of Float are usually represented by the 8-byte IEE 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
    double precision float format (64 bits), while LongFloats use 10byte extended IEE format
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
    (80 bits).
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
    But there is no guaranty - on systems which do not support long doubles,
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
    LongFloats are represented as Doubles.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
    [author:]
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
	Claus Gittinger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
    [see also:]
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
	Number
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
	Float ShortFloat Fraction FixedPoint Integer
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
!LongFloat class methodsFor:'instance creation'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
basicNew
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
    "return a new longFloat - here we return 0.0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
     - LongFloats are usually NOT created this way ...
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
     Its implemented here to allow things like binary store & load
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
     of longFloats. (but even this support will go away eventually, its not
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
     a good idea to store the bits of a float - the reader might have a
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
     totally different representation - so floats will eventually be 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
     binary stored in a device independent format."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
    __qMKLFLOAT(newFloat, 0.0);   /* OBJECT ALLOCATION */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
    RETURN (newFloat);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
%}
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
readFrom:aStringOrStream onError:exceptionBlock
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
    "read a longFloat from a string"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
    |num|
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
    num := super readFrom:aStringOrStream onError:nil.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
    num isNil ifTrue:[  
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
	^ exceptionBlock value
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
    ].
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
    ^ num asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
     LongFloat readFrom:'0.1'
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
     LongFloat readFrom:'0'
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
    "Modified: / 7.1.1998 / 16:17:59 / cg"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
!LongFloat class methodsFor:'constants'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
pi
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
    "return the constant pi as LongFloat"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
    ^ 3.14159 asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
    "Modified: 23.4.1996 / 09:26:31 / cg"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
unity
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
    "return the neutral element for multiplication (1.0) as LongFloat"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
    ^ 1.0 asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
    "Modified: 23.4.1996 / 09:26:51 / cg"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
zero
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
    "return the neutral element for addition (0.0) as LongFloat"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
    ^ 0.0 asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
    "Modified: 23.4.1996 / 09:26:45 / cg"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
!LongFloat class methodsFor:'queries'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
isBuiltInClass
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
    "return true if this class is known by the run-time-system.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
     Here, true is returned for myself, false for subclasses."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
    ^ self == LongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
    "Modified: 23.4.1996 / 16:00:23 / cg"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
isIEEEFormat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
    "return true, if this machine represents floats in IEEE format.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
     Currently, no support is provided for non-ieee machines
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
     to convert their floats into this (which is only relevant,
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
     if such a machine wants to send floats as binary to some other
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
     machine).
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
     Machines with non-IEEE format are VAXed and IBM370-type systems
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
     (among others). Today, most systems use IEEE format floats."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
    ^ true "/ this may be a lie
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
!LongFloat methodsFor:'arithmetic'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
* aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
    "return the product of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
    LONGFLOAT result;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
	result = __longFloatVal(self) * (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
	result = __longFloatVal(self) * __longFloatVal(aNumber);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
	result = __longFloatVal(self) * (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
	result = __longFloatVal(self) * (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   273
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
    ^ aNumber productFromLongFloat:self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
+ aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
    "return the sum of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
    LONGFLOAT result;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
	result = __longFloatVal(self) + (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
	result = __longFloatVal(self) + __longFloatVal(aNumber);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
	result = __longFloatVal(self) + (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
	result = __longFloatVal(self) + (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
    ^ aNumber sumFromLongFloat:self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
- aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
    "return the difference of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
    LONGFLOAT result;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   315
	result = __longFloatVal(self) - (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   316
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   318
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
	result = __longFloatVal(self) - __longFloatVal(aNumber);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   321
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   322
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
	result = __longFloatVal(self) - (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   324
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   325
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   326
	result = __longFloatVal(self) - (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   327
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   328
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   329
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   330
    ^ aNumber differenceFromLongFloat:self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   332
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
/ aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   334
    "return the quotient of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   335
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   336
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   337
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
    LONGFLOAT result, val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
    if (__isSmallInteger(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   342
        if (aNumber != __MKSMALLINT(0)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   343
            result = __longFloatVal(self) / (LONGFLOAT)(__intVal(aNumber));
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
retResult:
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   345
            __qMKLFLOAT(newFloat, result);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   346
            RETURN ( newFloat );
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   347
        }
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   348
    } else if (__isLongFloat(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   349
        val = __longFloatVal(aNumber);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   350
        if (val != 0.0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   351
            result = __longFloatVal(self) / val;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   352
            goto retResult;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   353
        }
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   354
    } else if (__isFloatLike(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   355
        val = (LONGFLOAT)(__floatVal(aNumber));
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   356
        if (val != 0.0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   357
            result = __longFloatVal(self) / val;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   358
            goto retResult;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   359
        }
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
    } else if (__isShortFloat(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   361
        val = (LONGFLOAT)(__shortFloatVal(aNumber));
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   362
        if (val != 0.0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   363
            result = __longFloatVal(self) / val;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   364
            goto retResult;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   365
        }
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   366
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   367
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   368
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   369
        "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   370
         No, you shalt not divide by zero
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   371
        "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   372
        ^ DivisionByZeroSignal raiseRequest.
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   373
    ].
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   374
    ^ aNumber quotientFromLongFloat:self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   375
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   376
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   377
negated
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   378
    "return myself negated"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   379
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   380
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   381
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   382
    LONGFLOAT rslt = - __longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   383
4250
5546439c3c5b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4168
diff changeset
   384
    __qMKLFLOAT(newFloat, rslt);
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   385
    RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   386
%}
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   387
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   388
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   389
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   390
uncheckedDivide:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
    "return the quotient of the receiver and the argument, aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   392
     Do not check for divide by zero (return NaN or infinity)"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   393
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   394
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   395
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   396
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   397
    LONGFLOAT result, val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   398
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   399
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   400
	result = __longFloatVal(self) / (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   401
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   402
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   403
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
	result = __longFloatVal(self) / __longFloatVal(aNumber);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   406
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   407
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   408
	val = (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   409
	result = __longFloatVal(self) / val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   412
	val = (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   413
	result = __longFloatVal(self) / val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   414
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   415
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
    ^ aNumber quotientFromLongFloat:self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
      0.0 asLongFloat uncheckedDivide:0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
      1.0 asLongFloat uncheckedDivide:0.0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   422
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   424
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   425
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   426
!LongFloat methodsFor:'coercion and converting'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
asFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
    "return a Float with same value as the receiver"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   430
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   431
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
    double dVal = (double)__longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
    __qMKFLOAT(newFloat, dVal);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   437
    RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   438
%}
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   439
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   440
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   441
     1.0 asLongFloat 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   442
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   443
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   444
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   445
asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
    "return an integer with same value - might truncate"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   447
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   448
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   449
    LONGFLOAT fVal;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   450
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
    fVal = __longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
    if ((fVal >= (LONGFLOAT)_MIN_INT) && (fVal <= (LONGFLOAT)_MAX_INT)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
	RETURN ( __MKSMALLINT( (INT)fVal) );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
    ^ super asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   457
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   458
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
     12345.0 asLongFloat asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
     1e15 asLongFloat asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
    "return a LongFloat with same value as the receiver - thats me"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
    ^ self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   470
asShortFloat
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   471
    "return a ShortFloat with same value as the receiver"
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   472
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   473
%{  /* NOCONTEXT */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   474
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   475
    OBJ newFloat;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   476
    float fVal = (float)__longFloatVal(self);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   477
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   478
    __qMKSFLOAT(newFloat, fVal);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   479
    RETURN ( newFloat );
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   480
%}
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   481
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   482
    "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   483
     1.0 asLongFloat asShortFloat  
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   484
    "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   485
!
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   486
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
generality
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   488
    "return the generality value - see ArithmeticValue>>retry:coercing:"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   489
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
    ^ 90
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   492
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   493
!LongFloat methodsFor:'comparing'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
< aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
    "return true, if the argument is greater"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
	RETURN ( (__longFloatVal(self) < (LONGFLOAT)(__intVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   503
    if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   504
	RETURN ( (__longFloatVal(self) < __longFloatVal(aNumber)) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   505
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   506
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
	RETURN ( (__longFloatVal(self) < (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   508
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   509
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
	RETURN ( (__longFloatVal(self) < (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   511
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   512
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   513
    ^ aNumber lessFromLongFloat:self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   514
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   515
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
     1.0 asLongFloat > (1/3)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   517
     1.0 asLongFloat > (1/3) asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   518
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   520
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   521
<= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   522
    "return true, if the argument is greater or equal"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   524
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   525
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   526
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   527
	RETURN ( (__longFloatVal(self) <= (LONGFLOAT)(__intVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   528
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   529
    if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   530
	RETURN ( (__longFloatVal(self) <= __longFloatVal(aNumber)) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   531
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   532
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   533
	RETURN ( (__longFloatVal(self) <= (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   534
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   535
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   536
	RETURN ( (__longFloatVal(self) <= (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   537
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   538
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   539
    ^ self retry:#<= coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   540
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   541
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   542
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   543
= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
    "return true, if the arguments value are equal by value"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   545
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   546
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   547
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   548
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
	RETURN ( (__longFloatVal(self) == (LONGFLOAT)(__intVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   550
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   551
    if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   552
	RETURN ( (__longFloatVal(self) == __longFloatVal(aNumber)) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   553
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   554
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   555
	RETURN ( (__longFloatVal(self) == (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   556
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   557
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
	RETURN ( (__longFloatVal(self) == (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   559
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   560
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
    ^ self retry:#= coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   562
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   563
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
> aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
    "return true, if the argument is less"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   569
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   570
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   571
	RETURN ( (__longFloatVal(self) > (LONGFLOAT)(__intVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   573
    if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   574
	RETURN ( (__longFloatVal(self) > __longFloatVal(aNumber)) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   575
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   576
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   577
	RETURN ( (__longFloatVal(self) > (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   578
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   579
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   580
	RETURN ( (__longFloatVal(self) > (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   581
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   582
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   583
    ^ self retry:#> coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   584
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   585
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
>= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
    "return true, if the argument is less or equal"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   588
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   590
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   591
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
	RETURN ( (__longFloatVal(self) >= (LONGFLOAT)(__intVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
    if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   595
	RETURN ( (__longFloatVal(self) >= __longFloatVal(aNumber)) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   596
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   597
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   598
	RETURN ( (__longFloatVal(self) >= (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   599
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   600
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   601
	RETURN ( (__longFloatVal(self) >= (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   602
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   603
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   604
    ^ self retry:#>= coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   605
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   606
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   607
hash
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   608
    "return a number for hashing; redefined, since floats compare
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   609
     by numeric value (i.e. 3.0 = 3), therefore 3.0 hash must be the same
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   610
     as 3 hash."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   611
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   612
    |i|
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   614
    (self >= SmallInteger minVal and:[self <= SmallInteger maxVal]) ifTrue:[
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   615
	i := self asInteger.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   616
	self = i ifTrue:[
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
	    ^ i hash
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   618
	].
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   619
    ].
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   620
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
     mhmh take some of my value-bits to hash on
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   624
    ^ (((self basicAt:4) bitAnd:16r3F) bitShift:24) +
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
      ((self basicAt:3) bitShift:16) +
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
      ((self basicAt:2) bitShift:8) +
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   627
      (self basicAt:1)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   628
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   629
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   630
     1.2345 hash      
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   631
     1.2345 asLongFloat hash 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   632
     1.0 hash             
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   633
     1.0 asLongFloat hash  
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   634
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   635
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   636
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   637
~= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   638
    "return true, if the arguments value are not equal"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   639
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   641
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   642
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
	RETURN ( (__longFloatVal(self) != (LONGFLOAT)(__intVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   644
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   645
    if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   646
	RETURN ( (__longFloatVal(self) != __longFloatVal(aNumber)) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   647
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   648
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   649
	RETURN ( (__longFloatVal(self) != (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   650
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   651
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   652
	RETURN ( (__longFloatVal(self) != (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   653
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   654
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   655
    ^ self retry:#~= coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   656
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   657
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   658
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   659
!LongFloat methodsFor:'printing & storing'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   660
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   661
printString
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   662
    "return a printed representation of the receiver
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   663
     LimitedPrecisonReal and its subclasses use #printString instead of
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   664
     #printOn: as basic print mechanism."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   665
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   666
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   667
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   668
    char buffer[64];
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   669
    REGISTER char *cp;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   670
    OBJ s;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   671
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   672
    /*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   673
     * actually only needed on sparc: since thisContext is
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   674
     * in a global register, which gets destroyed by printf,
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   675
     * manually save it here - very stupid ...
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
    __BEGIN_PROTECT_REGISTERS__
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   678
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   679
    sprintf(buffer, "%.6LG", __longFloatVal(self));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   680
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   681
    __END_PROTECT_REGISTERS__
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   682
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   683
    /* 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   684
     * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   685
     * (i.e. look if string contains '.' or 'e' and append '.0' if not)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   686
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   687
    for (cp = buffer; *cp; cp++) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   688
	if ((*cp == '.') || (*cp == 'e')) break;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   689
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   690
    if (! *cp) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   691
	*cp++ = '.';
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   692
	*cp++ = '0';
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   693
	*cp = '\0';
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   695
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   696
    s = __MKSTRING(buffer COMMA_SND);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   697
    if (s != nil) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
	RETURN (s);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   702
     memory allocation (for the new string) failed.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
     When we arrive here, there was no memory, even after a garbage collect.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
     This means, that the VM wanted to get some more memory from the
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   705
     OS, which was not kind enough to give it.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   706
     Bad luck - you should increase the swap space on your machine.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   707
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   708
    ^ ObjectMemory allocationFailureSignal raise.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
!LongFloat methodsFor:'special access'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
exponent
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
    "extract a normalized floats exponent.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
     The returned value depends on the float-representation of
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
     the underlying machine and is therefore highly unportable.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
     This is not for general use.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
     This assumes that the mantissa is normalized to
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
     0.5 .. 1.0 and the floats value is mantissa * 2^exp"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
#if 0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
    double frexp();
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
    double frac;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   726
    INT exp;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   728
    errno = 0;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   729
    frac = frexp( (double)(__shortFloatVal(self)), &exp);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   730
    if (errno == 0) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   731
	RETURN (__MKSMALLINT(exp));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   732
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
    ^ self primitiveFailed
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
     1.0 asLongFloat exponent    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
     1.0 asLongFloat exponent    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
     0.5 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
     0.25 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
     0.00000011111 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   744
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
mantissa
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
    "extract a normalized floats mantissa.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   748
     The returned value depends on the float-representation of
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
     the underlying machine and is therefore highly unportable.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
     This is not for general use.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
     This assumes that the mantissa is normalized to
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
     0.5 .. 1.0 and the floats value is mantissa * 2^exp"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   755
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   756
#if 0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
    double frexp();
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
    double frac;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
    INT exp;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
    errno = 0;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
    frac = frexp( (double)(__shortFloatVal(self)), &exp);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
    if (errno == 0) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
	RETURN (__MKFLOAT(frac));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   767
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
    ^ self primitiveFailed
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
     1.0 asLongFloat exponent    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   772
     1.0 asLongFloat mantissa
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   773
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   774
     0.5 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
     0.5 asLongFloat mantissa   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   776
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   777
     0.25 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
     0.25 asLongFloat mantissa   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   779
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
     0.00000011111 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   781
     0.00000011111 asLongFloat mantissa   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   782
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   783
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
!LongFloat methodsFor:'testing'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   788
    "return true, if the receiver is a finite float 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   789
     i.e. not NaN and not infinite."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   790
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   791
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   792
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
    double dV = (double) __longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
    /*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   796
     * notice: on machines which do not provide
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
     * a finite() macro or function (WIN32), 
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4253
diff changeset
   798
     * this may always ret true here ...
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   799
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   800
    if (finite(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   801
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   802
    ^false
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   804
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   805
	1.0 asLongFloat isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   806
	(0.0 asLongFloat uncheckedDivide: 0.0) isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   807
	(1.0 asLongFloat uncheckedDivide: 0.0) isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   808
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   809
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   810
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   811
isNaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   812
    "return true, if the receiver is an invalid float (NaN - not a number).
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   813
     These are not created by ST/X float operations (they raise an exception);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   814
     however, inline C-code could produce them ..."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   815
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   816
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   817
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   818
    double dV = (double)(__longFloatVal(self));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   819
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   820
    /*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   821
     * notice: on machines which do not provide
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   822
     * a finite() macro or function (WIN32), 
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4253
diff changeset
   823
     * this may always ret false here ...
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   824
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   825
    if (isnan(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   826
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   827
#if 0 /* Currently all our systems support isnan()
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
       * If not, you have to fix librun/jinterpret.c also.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   829
       */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   830
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   831
    /*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   832
     * sigh - every vendor is playing its own game here ...
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   833
     * Q: what are standards worth, anyway ?
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   834
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   835
#ifdef IS_NAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   836
    if (IS_NAN(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   840
#ifdef IS_QNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
    if (IS_QNAN(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   842
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
#ifdef FLT_SNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
    if (dV == FLT_SNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   849
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
#ifdef FLT_QNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
    if (dV == FLT_QNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   853
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
#ifdef _SNANF
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
    if (dV == _SNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   858
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   859
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   860
#ifdef _QNANF
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   861
    if (dV == _QNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   862
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   863
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   864
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   865
#ifdef IsPosNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   866
    if IsPosNAN(dV) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   867
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   868
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   869
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   870
#ifdef IsNegNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   871
    if IsNegNAN(dV) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   872
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   873
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   874
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   875
#ifdef NAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   876
    if (dV == NAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   877
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   878
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   879
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
#ifdef NaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
    if (NaN(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   883
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   884
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   885
#endif /* 0 */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   886
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   887
    ^ false
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   888
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   889
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   890
	1.0 asLongFloat isNaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   891
	(0.0 asLongFloat uncheckedDivide: 0.0) isNaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   892
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   893
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   894
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   895
negative
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   896
    "return true if the receiver is less than zero"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   897
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   898
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   899
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   900
    RETURN ( (__longFloatVal(self) < 0.0) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   901
%}
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   902
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   903
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   904
positive
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   905
    "return true if the receiver is greater or equal to zero"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   906
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   907
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   908
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   909
    RETURN ( (__longFloatVal(self) >= 0.0) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   910
%}
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   911
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   912
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   913
strictlyPositive
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   914
    "return true if the receiver is greater than zero"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   915
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   916
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   917
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   918
    RETURN ( (__longFloatVal(self) > 0.0) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   919
%}
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   920
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   921
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   922
!LongFloat methodsFor:'truncation and rounding'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   923
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   924
floor
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   925
    "return the integer nearest the receiver towards negative infinity."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   926
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   927
    |val|
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   928
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   929
    ^ val asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   930
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   931
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   932
     0.5 asLongFloat floor           
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   933
     -0.5 asLongFloat floor     
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   934
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   935
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   936
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   937
fractionPart
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   938
    "extract the after-decimal fraction part.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   939
     the floats value is 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   940
	float truncated + float fractionalPart"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   941
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   942
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   943
#if 0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   944
    double modf();
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   945
    double frac, trunc;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   946
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   947
    errno = 0;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   948
    frac = modf((double)(__shortFloatVal(self)), &trunc);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   949
    if (errno == 0) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   950
	RETURN (__MKSFLOAT(frac));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   951
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   952
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   953
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   954
    ^ self primitiveFailed
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   955
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   956
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   957
     1.0 asLongFloat fractionalPart    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   958
     0.5 asLongFloat fractionalPart    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   959
     0.25 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   960
     3.14159 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   961
     12345673.14159 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   962
     123456731231231231.14159 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   963
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   964
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   965
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   966
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   967
!LongFloat class methodsFor:'documentation'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   968
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   969
version
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   970
    ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.6 1999-07-26 09:10:56 stefan Exp $'
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   971
! !