LongFloat.st
author Claus Gittinger <cg@exept.de>
Tue, 19 Oct 1999 22:01:44 +0200
changeset 4924 9bec9689f646
parent 4825 4c77d43433d1
child 5120 13143fbcbdf8
permissions -rw-r--r--
reverse - 50% speedup on i386; 30% on all others
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
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    29
#define __USE_ISOC9X 1
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
#include <math.h>
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
/*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 * 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
    34
 */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
#ifndef errno
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
 extern errno;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
#if defined (_AIX)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
# include <float.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    42
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
#if defined(IRIX)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
# include <nan.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    46
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
#if defined(LINUX)
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    48
# ifndef NAN
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    49
#  include <nan.h>
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    50
# endif
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    52
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
#if defined(solaris) || defined(sunos)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
# include <nan.h>
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
#ifdef WIN32
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
/*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
 * no finite(x) ?
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
 * no isnan(x) ?
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
 */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
# ifndef finite 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
#  define finite(x)     1
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
# endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
# ifndef isnan
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
#  define isnan(x)      0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
# 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
    68
#endif /* WIN32 */
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
#ifdef realIX
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
/*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
 * no finite(x)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
 */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
# ifndef finite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
#  define finite(x)     1
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
# 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
    77
#endif /* realIX */
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
#ifdef WIN32
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
# define LONGFLOAT      long double
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
#endif
4168
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
    82
#if defined(__GNUC__) && defined(i386)
4250
5546439c3c5b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4168
diff changeset
    83
# define LONGFLOAT      long double
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    86
/*
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    87
 * 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
    88
 * arithmetic
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    89
 */
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    90
#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
    91
# 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
    92
# 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
    93
# 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
    94
#else
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    95
# 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
    96
# 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
    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
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
    99
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
   100
	HEADER
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   101
#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
   102
	__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
   103
#endif
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   104
	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
   105
};
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   106
#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
   107
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   108
#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
   109
# 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
   110
	__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
   111
#endif
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   112
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
#ifndef __qMKLFLOAT
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
# define __qMKLFLOAT(__newFloat__, __fVal__) \
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
    { \
4253
768802bc61a4 longFloat class falls back to float on systems that do not support them
Claus Gittinger <cg@exept.de>
parents: 4250
diff changeset
   116
	__qNew(__newFloat__ , sizeof(struct __longfloatstruct)); \
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
	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
   118
	    __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
   119
	    __LongFloatInstPtr(__newFloat__)->f_longfloatvalue = (LONGFLOAT)(__fVal__); \
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
	} \
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
    }
4168
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   122
#endif
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   123
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   124
#ifndef __isLongFloat
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   125
# define __isLongFloat(o) \
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   126
	(__qClass(o) == @global(LongFloat))
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   127
#endif
02df84a8e1d4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4165
diff changeset
   128
4165
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
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
!LongFloat class methodsFor:'documentation'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
copyright
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
 COPYRIGHT (c) 1999 by eXept Software AG
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
	      All Rights Reserved
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
 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
   140
 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
   141
 inclusion of the above copyright notice.   This software may not
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
 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
   143
 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
   144
 hereby transferred.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
documentation
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
    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
   151
    the underlying C-compilers double implementation, while LongFloats are
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
    mapped onto C-long doubles.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
    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
   154
    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
   155
    (80 bits).
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
    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
   157
    LongFloats are represented as Doubles.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
    [author:]
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
	Claus Gittinger
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
    [see also:]
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
	Number
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
	Float ShortFloat Fraction FixedPoint Integer
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
!LongFloat class methodsFor:'instance creation'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
basicNew
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
    "return a new longFloat - here we return 0.0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
     - LongFloats are usually NOT created this way ...
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
     Its implemented here to allow things like binary store & load
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
     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
   176
     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
   177
     totally different representation - so floats will eventually be 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
     binary stored in a device independent format."
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
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
    __qMKLFLOAT(newFloat, 0.0);   /* OBJECT ALLOCATION */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
    RETURN (newFloat);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
%}
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
readFrom:aStringOrStream onError:exceptionBlock
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
    "read a longFloat from a string"
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|
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
    num := super readFrom:aStringOrStream onError:nil.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
    num isNil ifTrue:[  
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
	^ exceptionBlock value
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
    ^ num asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
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
     LongFloat readFrom:'0.1'
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
     LongFloat readFrom:'0'
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
    "Modified: / 7.1.1998 / 16:17:59 / cg"
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
!LongFloat class methodsFor:'constants'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
pi
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
    "return the constant pi as LongFloat"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
    ^ 3.14159 asLongFloat
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
    "Modified: 23.4.1996 / 09:26:31 / cg"
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
unity
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
    "return the neutral element for multiplication (1.0) as LongFloat"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
    ^ 1.0 asLongFloat
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
    "Modified: 23.4.1996 / 09:26:51 / cg"
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
zero
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
    "return the neutral element for addition (0.0) as LongFloat"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
    ^ 0.0 asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
    "Modified: 23.4.1996 / 09:26:45 / cg"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
! !
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
!LongFloat class methodsFor:'queries'!
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
isBuiltInClass
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
    "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
   237
     Here, true is returned for myself, false for subclasses."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
    ^ self == LongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
    "Modified: 23.4.1996 / 16:00:23 / cg"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
isIEEEFormat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
    "return true, if this machine represents floats in IEEE format.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
     Currently, no support is provided for non-ieee machines
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
     to convert their floats into this (which is only relevant,
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
     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
   249
     machine).
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
     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
   251
     (among others). Today, most systems use IEEE format floats."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
    ^ true "/ this may be a lie
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
!LongFloat methodsFor:'arithmetic'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
* aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
    "return the product of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
    LONGFLOAT result;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
	result = __longFloatVal(self) * (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
	result = __longFloatVal(self) * __longFloatVal(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
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
	result = __longFloatVal(self) * (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
	result = __longFloatVal(self) * (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
    }
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
    ^ aNumber productFromLongFloat:self
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
+ aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
    "return the sum of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
    LONGFLOAT result;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
	result = __longFloatVal(self) + (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
	result = __longFloatVal(self) + __longFloatVal(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
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
	result = __longFloatVal(self) + (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
	result = __longFloatVal(self) + (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
    }
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
    ^ aNumber sumFromLongFloat:self
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
- aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
    "return the difference of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   315
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   316
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   318
    LONGFLOAT result;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   321
	result = __longFloatVal(self) - (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   322
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   324
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   325
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   326
	result = __longFloatVal(self) - __longFloatVal(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
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   329
	result = __longFloatVal(self) - (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   330
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   332
	result = __longFloatVal(self) - (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   334
    }
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
    ^ aNumber differenceFromLongFloat:self
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
/ aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
    "return the quotient of the receiver and the argument, aNumber"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   342
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   345
    LONGFLOAT result, val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   346
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   347
    if (__isSmallInteger(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   348
        if (aNumber != __MKSMALLINT(0)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   349
            result = __longFloatVal(self) / (LONGFLOAT)(__intVal(aNumber));
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   350
retResult:
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   351
            __qMKLFLOAT(newFloat, result);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   352
            RETURN ( newFloat );
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 (__isLongFloat(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   355
        val = __longFloatVal(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 (__isFloatLike(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   361
        val = (LONGFLOAT)(__floatVal(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
    } else if (__isShortFloat(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   367
        val = (LONGFLOAT)(__shortFloatVal(aNumber));
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   368
        if (val != 0.0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   369
            result = __longFloatVal(self) / val;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   370
            goto retResult;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   371
        }
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   372
    }
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 == 0) or:[aNumber = 0.0]) ifTrue:[
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   375
        "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   376
         No, you shalt not divide by zero
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   377
        "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   378
        ^ DivisionByZeroSignal raiseRequest.
4165
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
    ^ aNumber quotientFromLongFloat:self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   381
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   382
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   383
negated
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   384
    "return myself negated"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   385
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   386
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   387
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   388
    LONGFLOAT rslt = - __longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   389
4250
5546439c3c5b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4168
diff changeset
   390
    __qMKLFLOAT(newFloat, rslt);
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
    RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   392
%}
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
!
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
uncheckedDivide:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   397
    "return the quotient of the receiver and the argument, aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   398
     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
   399
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   400
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   401
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   402
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   403
    LONGFLOAT result, val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
    if (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   406
	result = __longFloatVal(self) / (LONGFLOAT)(__intVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   407
retResult:
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   408
	__qMKLFLOAT(newFloat, result);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   409
	RETURN ( newFloat );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
    } else if (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
	result = __longFloatVal(self) / __longFloatVal(aNumber);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   412
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   413
    } else if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   414
	val = (LONGFLOAT)(__floatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   415
	result = __longFloatVal(self) / val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
    } else if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
	val = (LONGFLOAT)(__shortFloatVal(aNumber));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
	result = __longFloatVal(self) / val;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
	goto retResult;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
    }
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
    ^ aNumber quotientFromLongFloat:self
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
      0.0 asLongFloat uncheckedDivide:0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
      1.0 asLongFloat uncheckedDivide:0.0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
!LongFloat methodsFor:'coercion and converting'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
asFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
    "return a Float with same value as the receiver"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   437
%{  /* NOCONTEXT */
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
    OBJ newFloat;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   440
    double dVal = (double)__longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   441
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   442
    __qMKFLOAT(newFloat, dVal);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   443
    RETURN ( newFloat );
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   447
     1.0 asLongFloat 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   448
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   449
!
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
asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
    "return an integer with same value - might truncate"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
    LONGFLOAT fVal;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   457
    fVal = __longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   458
    if ((fVal >= (LONGFLOAT)_MIN_INT) && (fVal <= (LONGFLOAT)_MAX_INT)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
	RETURN ( __MKSMALLINT( (INT)fVal) );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
    }
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
    ^ super asInteger
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
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
     12345.0 asLongFloat asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
     1e15 asLongFloat asInteger
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
    "
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
    "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
   472
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
    ^ self
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   476
asShortFloat
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   477
    "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
   478
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   479
%{  /* NOCONTEXT */
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
    OBJ newFloat;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   482
    float fVal = (float)__longFloatVal(self);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   483
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   484
    __qMKSFLOAT(newFloat, fVal);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   485
    RETURN ( newFloat );
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   486
%}
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   487
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   488
    "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   489
     1.0 asLongFloat asShortFloat  
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   490
    "
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   491
!
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4305
diff changeset
   492
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   493
generality
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
    "return the generality value - see ArithmeticValue>>retry:coercing:"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
    ^ 90
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
!LongFloat methodsFor:'comparing'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
< aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
    "return true, if the argument is greater"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   503
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   504
%{  /* NOCONTEXT */
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 (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
	RETURN ( (__longFloatVal(self) < (LONGFLOAT)(__intVal(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 (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
	RETURN ( (__longFloatVal(self) < __longFloatVal(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
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   513
	RETURN ( (__longFloatVal(self) < (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
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
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
	RETURN ( (__longFloatVal(self) < (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   517
    }
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
    ^ aNumber lessFromLongFloat:self
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
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   522
     1.0 asLongFloat > (1/3)
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
     1.0 asLongFloat > (1/3) asLongFloat
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   524
    "
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   527
<= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   528
    "return true, if the argument is greater or equal"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   529
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   530
%{  /* NOCONTEXT */
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 (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   533
	RETURN ( (__longFloatVal(self) <= (LONGFLOAT)(__intVal(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 (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   536
	RETURN ( (__longFloatVal(self) <= __longFloatVal(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
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   539
	RETURN ( (__longFloatVal(self) <= (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
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
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   542
	RETURN ( (__longFloatVal(self) <= (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   543
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   545
    ^ self retry:#<= coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   546
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   550
    "return true, if the arguments value are equal by value"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   551
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   552
%{  /* NOCONTEXT */
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 (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   555
	RETURN ( (__longFloatVal(self) == (LONGFLOAT)(__intVal(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 (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
	RETURN ( (__longFloatVal(self) == __longFloatVal(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
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
	RETURN ( (__longFloatVal(self) == (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
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
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
	RETURN ( (__longFloatVal(self) == (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
    ^ self retry:#= coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   571
> aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
    "return true, if the argument is less"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   573
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   574
%{  /* NOCONTEXT */
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 (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   577
	RETURN ( (__longFloatVal(self) > (LONGFLOAT)(__intVal(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 (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   580
	RETURN ( (__longFloatVal(self) > __longFloatVal(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
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   583
	RETURN ( (__longFloatVal(self) > (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
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
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
	RETURN ( (__longFloatVal(self) > (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
    }
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
    ^ self retry:#> coercing:aNumber
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
>= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
    "return true, if the argument is less or equal"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   595
%{  /* NOCONTEXT */
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 (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   598
	RETURN ( (__longFloatVal(self) >= (LONGFLOAT)(__intVal(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 (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   601
	RETURN ( (__longFloatVal(self) >= __longFloatVal(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
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   604
	RETURN ( (__longFloatVal(self) >= (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
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
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   607
	RETURN ( (__longFloatVal(self) >= (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   608
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   609
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   610
    ^ self retry:#>= coercing:aNumber
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
hash
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   614
    "return a number for hashing; redefined, since floats compare
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   615
     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
   616
     as 3 hash."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   618
    |i|
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
    (self >= SmallInteger minVal and:[self <= SmallInteger maxVal]) ifTrue:[
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
	i := self asInteger.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
	self = i ifTrue:[
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
	    ^ i hash
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   624
	].
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
    ].
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   627
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   628
     mhmh take some of my value-bits to hash on
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
    ^ (((self basicAt:4) bitAnd:16r3F) bitShift:24) +
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   631
      ((self basicAt:3) bitShift:16) +
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   632
      ((self basicAt:2) bitShift:8) +
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   633
      (self basicAt:1)
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
     1.2345 hash      
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   637
     1.2345 asLongFloat hash 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   638
     1.0 hash             
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   639
     1.0 asLongFloat hash  
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
    "
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
~= aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   644
    "return true, if the arguments value are not equal"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   645
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   646
%{  /* NOCONTEXT */
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 (__isSmallInteger(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   649
	RETURN ( (__longFloatVal(self) != (LONGFLOAT)(__intVal(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 (__isLongFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   652
	RETURN ( (__longFloatVal(self) != __longFloatVal(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
    if (__isFloatLike(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   655
	RETURN ( (__longFloatVal(self) != (LONGFLOAT)(__floatVal(aNumber))) ? true : false );
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
    if (__isShortFloat(aNumber)) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   658
	RETURN ( (__longFloatVal(self) != (LONGFLOAT)(__shortFloatVal(aNumber))) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   659
    }
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
    ^ self retry:#~= coercing:aNumber
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   662
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   663
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   664
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   665
!LongFloat methodsFor:'printing & storing'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   666
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   667
printString
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   668
    "return a printed representation of the receiver
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   669
     LimitedPrecisonReal and its subclasses use #printString instead of
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   670
     #printOn: as basic print mechanism."
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
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   673
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   674
    char buffer[64];
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   675
    REGISTER char *cp;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
    OBJ s;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
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
     * actually only needed on sparc: since thisContext is
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   680
     * in a global register, which gets destroyed by printf,
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   681
     * manually save it here - very stupid ...
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
    __BEGIN_PROTECT_REGISTERS__
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   684
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   685
    sprintf(buffer, "%.6LG", __longFloatVal(self));
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
    __END_PROTECT_REGISTERS__
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   688
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
     * 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
   691
     * (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
   692
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   693
    for (cp = buffer; *cp; cp++) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
	if ((*cp == '.') || (*cp == 'e')) break;
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
    if (! *cp) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   697
	*cp++ = '.';
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
	*cp++ = '0';
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
	*cp = '\0';
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
    s = __MKSTRING(buffer COMMA_SND);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
    if (s != nil) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
	RETURN (s);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   705
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   706
%}.
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
     memory allocation (for the new string) failed.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
     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
   710
     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
   711
     OS, which was not kind enough to give it.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
     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
   713
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
    ^ ObjectMemory allocationFailureSignal raise.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
!LongFloat methodsFor:'special access'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
exponent
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
    "extract a normalized floats exponent.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
     The returned value depends on the float-representation of
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
     the underlying machine and is therefore highly unportable.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
     This is not for general use.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
     This assumes that the mantissa is normalized to
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
     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
   726
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   728
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   729
#if 0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   730
    double frexp();
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   731
    double frac;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   732
    INT exp;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
    errno = 0;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
    frac = frexp( (double)(__shortFloatVal(self)), &exp);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
    if (errno == 0) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
	RETURN (__MKSMALLINT(exp));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
    ^ self primitiveFailed
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
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
     1.0 asLongFloat exponent    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
     1.0 asLongFloat exponent    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
     0.5 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
     0.25 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   748
     0.00000011111 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
mantissa
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
    "extract a normalized floats mantissa.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
     The returned value depends on the float-representation of
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   755
     the underlying machine and is therefore highly unportable.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   756
     This is not for general use.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
     This assumes that the mantissa is normalized to
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
     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
   759
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
#if 0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
    double frexp();
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
    double frac;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
    INT exp;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   767
    errno = 0;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
    frac = frexp( (double)(__shortFloatVal(self)), &exp);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
    if (errno == 0) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
	RETURN (__MKFLOAT(frac));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   772
#endif
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
    ^ self primitiveFailed
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
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
     1.0 asLongFloat exponent    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
     1.0 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.5 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   781
     0.5 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
     0.25 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
     0.25 asLongFloat mantissa   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
     0.00000011111 asLongFloat exponent   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
     0.00000011111 asLongFloat mantissa   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   788
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   789
! !
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
!LongFloat methodsFor:'testing'!
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
isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
    "return true, if the receiver is a finite float 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
     i.e. not NaN and not infinite."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   796
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   799
    double dV = (double) __longFloatVal(self);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   800
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
     * notice: on machines which do not provide
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
     * a finite() macro or function (WIN32), 
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4253
diff changeset
   804
     * this may always ret true here ...
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   805
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   806
    if (finite(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   807
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   808
    ^false
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
	1.0 asLongFloat isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   812
	(0.0 asLongFloat uncheckedDivide: 0.0) isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   813
	(1.0 asLongFloat uncheckedDivide: 0.0) isFinite
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   814
    "
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   817
isNaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   818
    "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
   819
     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
   820
     however, inline C-code could produce them ..."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   821
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   822
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   823
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   824
    double dV = (double)(__longFloatVal(self));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   825
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
     * notice: on machines which do not provide
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
     * a finite() macro or function (WIN32), 
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4253
diff changeset
   829
     * this may always ret false here ...
4165
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
    if (isnan(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   832
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   833
#if 0 /* Currently all our systems support isnan()
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   834
       * If not, you have to fix librun/jinterpret.c also.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   835
       */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   836
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
    /*
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
     * sigh - every vendor is playing its own game here ...
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
     * Q: what are standards worth, anyway ?
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   840
     */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
#ifdef IS_NAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   842
    if (IS_NAN(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
#ifdef IS_QNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
    if (IS_QNAN(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   849
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
#ifdef FLT_SNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
    if (dV == FLT_SNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   853
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
#ifdef FLT_QNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
    if (dV == FLT_QNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   858
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   859
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   860
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   861
#ifdef _SNANF
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   862
    if (dV == _SNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   863
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   864
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   865
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   866
#ifdef _QNANF
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   867
    if (dV == _QNAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   868
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   869
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   870
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   871
#ifdef IsPosNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   872
    if IsPosNAN(dV) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   873
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   874
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   875
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   876
#ifdef IsNegNAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   877
    if IsNegNAN(dV) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   878
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   879
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
#ifdef NAN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
    if (dV == NAN) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   883
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   884
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   885
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   886
#ifdef NaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   887
    if (NaN(dV)) { RETURN (true); }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   888
    RETURN (false);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   889
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   890
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   891
#endif /* 0 */
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
    ^ false
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
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   896
	1.0 asLongFloat isNaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   897
	(0.0 asLongFloat uncheckedDivide: 0.0) isNaN
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   898
    "
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   901
negative
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   902
    "return true if the receiver is less than zero"
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
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   905
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   906
    RETURN ( (__longFloatVal(self) < 0.0) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   907
%}
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   910
positive
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   911
    "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
   912
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   913
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   914
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   915
    RETURN ( (__longFloatVal(self) >= 0.0) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   916
%}
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   919
strictlyPositive
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   920
    "return true if the receiver is greater than zero"
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
%{  /* NOCONTEXT */
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
    RETURN ( (__longFloatVal(self) > 0.0) ? true : false );
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   925
%}
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   928
!LongFloat methodsFor:'truncation and rounding'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   929
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   930
floor
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   931
    "return the integer nearest the receiver towards negative infinity."
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   932
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   933
    |val|
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
    ^ val asInteger
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
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   938
     0.5 asLongFloat floor           
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   939
     -0.5 asLongFloat floor     
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   940
    "
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
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   943
fractionPart
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   944
    "extract the after-decimal fraction part.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   945
     the floats value is 
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   946
	float truncated + float fractionalPart"
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   947
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   948
%{  /* NOCONTEXT */
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   949
#if 0
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   950
    double modf();
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   951
    double frac, trunc;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   952
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   953
    errno = 0;
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   954
    frac = modf((double)(__shortFloatVal(self)), &trunc);
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   955
    if (errno == 0) {
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   956
	RETURN (__MKSFLOAT(frac));
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   957
    }
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   958
#endif
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   959
%}.
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   960
    ^ self primitiveFailed
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   961
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   962
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   963
     1.0 asLongFloat fractionalPart    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   964
     0.5 asLongFloat fractionalPart    
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   965
     0.25 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   966
     3.14159 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   967
     12345673.14159 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   968
     123456731231231231.14159 asLongFloat fractionalPart   
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   969
    "
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   970
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   971
! !
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   972
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   973
!LongFloat class methodsFor:'documentation'!
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   974
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   975
version
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
   976
    ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.7 1999-09-27 10:32:32 cg Exp $'
4165
6d83608a7584 initial - not yet tested/released
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   977
! !