Float.st
author Stefan Vogel <sv@exept.de>
Mon, 30 Jun 2014 16:19:53 +0200
changeset 16661 9d23b8a1005d
parent 16658 1c653a0a7e4d
child 16667 a659a8f95304
permissions -rw-r--r--
class: Float changed: #epsilon
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
175
82ba8d2e3569 *** empty log message ***
claus
parents: 142
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
5411
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
    12
"{ Package: 'stx:libbasic' }"
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
    13
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
    14
LimitedPrecisionReal variableByteSubclass:#Float
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    15
	instanceVariableNames:''
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
    16
	classVariableNames:'DefaultPrintFormat Pi E Halfpi HalfpiNegative Twopi
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
    17
		RadiansPerDegree Ln2 Ln10 Sqrt2 Epsilon'
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    18
	poolDictionaries:''
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    19
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    22
!Float primitiveDefinitions!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    23
%{
14751
991d38458125 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 14728
diff changeset
    24
#include <stdio.h>
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    25
#include <errno.h>
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    26
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
    27
#ifndef __OPTIMIZE__
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
    28
# define __OPTIMIZE__
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
    29
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
    30
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
    31
#define __USE_ISOC9X 1
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
    32
#define __USE_ISOC99 1
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
    33
#include <math.h>
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
    34
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    35
/*
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    36
 * on some systems errno is a macro ... check for it here
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    37
 */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    38
#ifndef errno
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    39
 extern errno;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    40
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
    41
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
    42
#if !defined (WIN32)
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
    43
# include <locale.h>
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
    44
#endif
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
    45
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    46
#if defined (_AIX)
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    47
# include <float.h>
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    48
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
    49
2395
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    50
#if defined(IRIX)
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    51
# include <nan.h>
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    52
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
    53
2397
dd6979979e67 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2396
diff changeset
    54
#if defined(LINUX)
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
    55
# ifndef NAN
5822
4e56f8aadda5 Get nan.h from bits/nan.h for Linux
Stefan Vogel <sv@exept.de>
parents: 5557
diff changeset
    56
#  include <bits/nan.h>
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
    57
# endif
2396
646ea118eaf8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2395
diff changeset
    58
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
    59
2399
5d47ec6834a8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2398
diff changeset
    60
#if defined(solaris) || defined(sunos)
2398
652c9f2a13fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
    61
# include <nan.h>
652c9f2a13fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
    62
#endif
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    63
3129
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    64
/*
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    65
 * sigh - some systems define that stuff; others dont.
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    66
 * (AIX even declares them as macros, so an external decl
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    67
 *  will not work below ...
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    68
 */
3240
29ebc1071762 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    69
#if !defined(_AIX) && !defined(NEXT3)
3129
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    70
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    71
# ifdef acos
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    72
  double acos();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    73
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    74
# ifdef asin
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    75
  double asin();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    76
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    77
# ifndef atan
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    78
  double atan();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    79
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    80
# ifndef cos
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    81
  double cos();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    82
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    83
# ifndef sin
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    84
  double sin();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    85
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    86
# ifndef pow
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    87
  double pow();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    88
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    89
# ifndef log
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    90
  double log();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    91
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    92
# ifndef exp
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    93
  double exp();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    94
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    95
# ifndef sqrt
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    96
  double sqrt();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    97
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    98
# ifndef tan
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
    99
  double tan();
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
   100
# endif
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
   101
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
   102
#endif /* not AIX */
d38fc293dbf9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3128
diff changeset
   103
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   104
#ifdef WIN32
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   105
/*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   106
 * no finite(x) ?
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   107
 * no isnan(x) ?
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   108
 */
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   109
# ifndef isnan
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   110
#  define isnan(x)      \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   111
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   112
	 (((unsigned int *)(&x))[1] == 0xFFF80000))
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   113
# endif
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   114
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   115
# ifndef isPositiveInfinity
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   116
#  define isPositiveInfinity(x) \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   117
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   118
	 (((unsigned int *)(&x))[1] == 0x7FF00000))
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   119
# endif
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   120
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   121
# ifndef isNegativeInfinity
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   122
#  define isNegativeInfinity(x) \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   123
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   124
	 (((unsigned int *)(&x))[1] == 0xFFF00000))
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   125
# endif
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   126
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   127
# ifndef isinf
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   128
#  define isinf(x) \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   129
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   130
	 ((((unsigned int *)(&x))[1] & 0x7FF00000) == 0x7FF00000))
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   131
# endif
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   132
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   133
# ifndef isfinite
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   134
#  define isfinite(x) (!isinf(x) && !isnan(x))
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   135
# endif
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
   136
7411
45c19db66503 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7410
diff changeset
   137
# define NO_ASINH
45c19db66503 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7410
diff changeset
   138
# define NO_ACOSH
45c19db66503 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7410
diff changeset
   139
# define NO_ATANH
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   140
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   141
# ifdef __MINGW__
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   142
#  include <string.h>
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   143
# endif
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   144
8984
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   145
#endif /* WIN32 */
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   146
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   147
#ifdef solaris
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   148
# ifndef isfinite
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   149
#  define isfinite(f) finite((double)(f))
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   150
# endif
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   151
#endif
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   152
3414
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3399
diff changeset
   153
#ifdef realIX
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   154
# ifndef isfinite
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   155
#  define isfinite(x)     1
3414
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3399
diff changeset
   156
# endif
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3399
diff changeset
   157
#endif
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3399
diff changeset
   158
3241
259bdd31694b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3240
diff changeset
   159
#ifndef NEXT3
259bdd31694b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3240
diff changeset
   160
# ifndef ceil
259bdd31694b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3240
diff changeset
   161
double ceil();
259bdd31694b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3240
diff changeset
   162
double floor();
259bdd31694b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3240
diff changeset
   163
# endif
259bdd31694b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3240
diff changeset
   164
#endif
259bdd31694b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3240
diff changeset
   165
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   166
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   167
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   168
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   169
!Float class methodsFor:'documentation'!
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   170
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   171
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   172
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   173
 COPYRIGHT (c) 1988 by Claus Gittinger
175
82ba8d2e3569 *** empty log message ***
claus
parents: 142
diff changeset
   174
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   175
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   176
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   177
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   178
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   179
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   180
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   181
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   182
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   183
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
   184
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   185
documentation
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   186
"
15016
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   187
    Floats represent rational numbers with limited precision.
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   188
    They use the C-compilers 'double' format, which is usually the 8byte IEE double float format.
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   189
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   190
    Floats give you 64 bit floats.
15016
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   191
    In contrast to ShortFloats (32bit) and LongFloats (>=64bit).
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   192
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   193
    WARNING:
16632
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   194
        The layout of Float instances is known by the runtime system and the compiler;
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   195
        you may not add instance variables here.
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   196
        Also, subclassing is complicated by the fact, that the VM creates floats/shortFloats,
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   197
        and does some float-checks by an identity compare with the Float-class.
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   198
        (i.e. your subclasses instances may not be recognized as float-like objects,
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   199
         thus mixed mode arithmetic will always coerce them, effectively slowing things down).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   201
    Notice, that Floats are defined as Byte-array to prevent the garbage collector
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   202
    from going into the value ... otherwise I needed a special case in many places.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   203
16632
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   204
    Also notice, that ST/X Floats are what Doubles are in ST-80. The reason for doing this
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   205
    was to be compatible to both Digitalk, Squeak AND ParcPlace smalltalk implementations
6674
c383bfa3dc8c documentation comment
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
   206
    (ParcPlace uses a 4-byte Float and an 8-byte Double class, in contrast to
15016
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   207
     Digitalk and Squeak, which have an 8-byte Float class).
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   208
    Thus, by providing an 8-byte Float class, code would not loose precicion
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   209
    (although some memory is wasted when porting from VW).
6674
c383bfa3dc8c documentation comment
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
   210
    Notice that ST/X provides an alias called Double, and an extra ShortFloat class, which has 4-byte
c383bfa3dc8c documentation comment
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
   211
    instances.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   212
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1879
diff changeset
   213
    Mixed mode arithmetic:
16632
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   214
        float op float       -> float
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   215
        float op fix         -> float
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   216
        float op fraction    -> float
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   217
        float op integer     -> float
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   218
        float op shortFloat  -> float
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   219
        float op longFloat   -> longFloat
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   220
        float op complex     -> complex
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1879
diff changeset
   221
7405
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   222
    Representation:
16632
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   223
            64bit double precision IEE floats
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   224
            53 bit mantissa,
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   225
            11 bit exponent,
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   226
            15 decimal digits (approx)
7405
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   227
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   228
    Range and Precision of Storage Formats: see LimitedPrecisionReal >> documentation
85
claus
parents: 77
diff changeset
   229
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   230
    [author:]
16632
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   231
        Claus Gittinger
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7373
diff changeset
   232
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   233
    [see also:]
16632
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   234
        Number
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   235
        ShortFloat LongFloat Fraction FixedPoint Integer Complex
871ced71895b class: Float
Stefan Vogel <sv@exept.de>
parents: 16447
diff changeset
   236
        FloatArray DoubleArray
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   237
"
2215
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   238
!
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   239
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   240
errorHandling
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   241
"
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   242
    Floating point error handling and signalling depends on the systems
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   243
    (actually: the C-runtime systems) ability to handle floating point errors.
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   244
    Most systems report errors by raising an OS floatingPoint exception,
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   245
    which is mapped to a fpExceptionInterrupt in ST/X.
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   246
    However, some systems do return NaN as result.
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   247
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   248
    Currently, ST/X does not care specially for these systems - it maybe added
2215
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   249
    easily, if there is sufficient customer interest, though.
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   250
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   251
    Try:
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
   252
	|f1 f2|
2215
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   253
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
   254
	f1 := 1.0.
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
   255
	f2 := 0.0.
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
   256
	f1 / f2
2215
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   257
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   258
    or:
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
   259
	2 arcSin
2215
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   260
"
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   261
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   262
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   263
!Float class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   264
a27a279701f8 Initial revision
claus
parents:
diff changeset
   265
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
   266
    "return a new float - here we return 0.0
a27a279701f8 Initial revision
claus
parents:
diff changeset
   267
     - floats are usually NOT created this way ...
a27a279701f8 Initial revision
claus
parents:
diff changeset
   268
     Its implemented here to allow things like binary store & load
a27a279701f8 Initial revision
claus
parents:
diff changeset
   269
     of floats. (but even this support will go away eventually, its not
a27a279701f8 Initial revision
claus
parents:
diff changeset
   270
     a good idea to store the bits of a float - the reader might have a
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   271
     totally different representation - so floats will eventually be
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
   272
     binary stored in a device independent format."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   273
a27a279701f8 Initial revision
claus
parents:
diff changeset
   274
%{  /* NOCONTEXT */
1206
9d23c1f5e4d3 use quicker MKFLOAT in FLoat>>basicNew
Claus Gittinger <cg@exept.de>
parents: 1198
diff changeset
   275
    OBJ newFloat;
9d23c1f5e4d3 use quicker MKFLOAT in FLoat>>basicNew
Claus Gittinger <cg@exept.de>
parents: 1198
diff changeset
   276
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
   277
    __qMKFLOAT(newFloat, 0.0);
1206
9d23c1f5e4d3 use quicker MKFLOAT in FLoat>>basicNew
Claus Gittinger <cg@exept.de>
parents: 1198
diff changeset
   278
    RETURN (newFloat);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   279
%}
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
   280
!
1206
9d23c1f5e4d3 use quicker MKFLOAT in FLoat>>basicNew
Claus Gittinger <cg@exept.de>
parents: 1198
diff changeset
   281
16447
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
   282
coerce:aNumber
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
   283
    ^ aNumber asFloat.
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
   284
!
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
   285
4295
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   286
fastFromString:aString at:startIndex
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   287
    "return the next Float from the string starting at startIndex.
4295
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   288
     No spaces are skipped.
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   289
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   290
     This is a specially tuned entry (using a low-level C-call), which
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   291
     returns garbage if the argument string is not a valid float number.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   292
     It has been added to allow high speed string decomposition into numbers,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   293
     especially for mass-data."
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   294
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   295
%{   /* NOCONTEXT */
12478
e8051030cda6 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 12423
diff changeset
   296
     if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   297
	char *cp = (char *)(__stringVal(aString));
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   298
	int idx = __intVal(startIndex) - 1;
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   299
	double atof();
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   300
	double val;
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   301
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   302
	if ((unsigned)idx < __stringSize(aString)) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   303
	    val = atof(cp + idx);
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   304
	    RETURN (__MKFLOAT(val));
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   305
	}
4295
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   306
     }
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   307
%}.
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   308
     self primitiveFailed.
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   309
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   310
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   311
     Float fastFromString:'123.45' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   312
     Float fastFromString:'123.45' at:2
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   313
     Float fastFromString:'123.45E4' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   314
     Float fastFromString:'hello123.45E4' at:6
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   315
     Float fastFromString:'12345' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   316
     Float fastFromString:'12345' at:2
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   317
     Float fastFromString:'12345' at:3
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   318
     Float fastFromString:'12345' at:4
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   319
     Float fastFromString:'12345' at:5
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   320
     Float fastFromString:'12345' at:6
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   321
     Float fastFromString:'12345' at:0
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   322
     Float fastFromString:'hello123.45E4' at:1
4295
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   323
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   324
     Time millisecondsToRun:[
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   325
	100000 timesRepeat:[
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   326
	    Float readFrom:'123.45'
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   327
	]
4295
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   328
     ]
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   329
    "
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   330
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   331
    "
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   332
     Time millisecondsToRun:[
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   333
	100000 timesRepeat:[
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   334
	    Float fastFromString:'123.45' at:1
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   335
	]
4295
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   336
     ]
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   337
    "
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   338
!
4adf74ef8e3e added fastFromString:
Claus Gittinger <cg@exept.de>
parents: 3955
diff changeset
   339
15016
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   340
fromIEEE32Bit: anInteger
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   341
    "creates a double, given the four native float bytes as an integer"
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   342
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   343
%{  /* NOCONTEXT */
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   344
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   345
    REGISTER union {
15264
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
   346
	unsigned int    i;
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
   347
	float           f;
15016
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   348
    } r;
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   349
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   350
    r.i = __unsignedLongIntVal( anInteger );
15017
d16c28f26b4f class: Float
Claus Gittinger <cg@exept.de>
parents: 15016
diff changeset
   351
    RETURN( __MKFLOAT((double)(r.f)) );
15016
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   352
%}
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   353
!
27471b4d9776 class: Float
Claus Gittinger <cg@exept.de>
parents: 15013
diff changeset
   354
3279
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   355
fromVAXFloatBytes:b1 b2:b2 b3:b3 b4:b4
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   356
    "creates a double, given the four vax float bytes to an ieee double.
3427
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   357
     For NaNs and Infinity, nil is returned.
3279
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   358
    "
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   359
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   360
%{  /* NOCONTEXT */
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   361
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   362
    REGISTER union {
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   363
	unsigned char   b[4];
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   364
	unsigned int    l;
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   365
	float           f;
3279
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   366
    } r;
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   367
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
   368
#ifdef __LSBFIRST__
3279
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   369
    r.b[3] = __intVal( b2 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   370
    r.b[2] = __intVal( b1 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   371
    r.b[1] = __intVal( b4 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   372
    r.b[0] = __intVal( b3 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   373
#else
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   374
    r.b[0] = __intVal( b2 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   375
    r.b[1] = __intVal( b1 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   376
    r.b[2] = __intVal( b4 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   377
    r.b[3] = __intVal( b3 );
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   378
#endif
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   379
    if( (r.l & 0xff800000) != 0x80000000 )
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   380
    {
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   381
	if( (r.l & 0x7f800000) > 0x01000000 )
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   382
	    r.l -= 0x01000000;
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   383
	else
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   384
	    r.l = 0;
3279
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   385
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
   386
	RETURN( __MKFLOAT(r.f) );
3279
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   387
    }
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   388
%}.
09d2ccf1bed2 added #fromVAXFloatBytes
ca
parents: 3244
diff changeset
   389
    ^ nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   390
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   391
12916
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   392
!Float class methodsFor:'accessing'!
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   393
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   394
defaultPrintFormat
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   395
    ^ DefaultPrintFormat
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   396
!
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   397
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   398
defaultPrintFormat:something
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   399
    DefaultPrintFormat := something.
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   400
!
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   401
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   402
epsilon
16661
9d23b8a1005d class: Float
Stefan Vogel <sv@exept.de>
parents: 16658
diff changeset
   403
    ^ Epsilon
12916
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   404
! !
a32796fca6ed #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12723
diff changeset
   405
16447
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
   406
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   407
!Float class methodsFor:'binary storage'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   408
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   409
readBinaryIEEEDoubleFrom:aStream
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   410
    "read a float from the binary stream, aStream,
14925
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   411
     interpreting the next bytes as an IEEE formatted 8-byte float.
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   412
     The bytes are read in the native byte order (i.e.lsb on intel)"
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   413
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   414
    |f|
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   415
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   416
    f := self basicNew.
15013
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   417
    self readBinaryIEEEDoubleFrom:aStream into:f MSB:(UninterpretedBytes isBigEndian).
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   418
    ^ f
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   419
9637
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   420
    "not part of libboss, as this is also used by others (TIFFReader)"
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   421
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   422
    "Created: / 16-04-1996 / 20:59:59 / cg"
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   423
    "Modified: / 23-08-2006 / 16:00:42 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   424
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   425
15013
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   426
readBinaryIEEEDoubleFrom:aStream MSB:msbFirst
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   427
    "read a float from the binary stream, aStream,
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   428
     interpreting the next bytes as an IEEE formatted 8-byte float.
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   429
     The bytes are read in the specified byte order"
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   430
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   431
    |f|
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   432
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   433
    f := self basicNew.
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   434
    self readBinaryIEEEDoubleFrom:aStream into:f MSB:msbFirst.
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   435
    ^ f
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   436
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   437
    "not part of libboss, as this is also used by others (TIFFReader)"
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   438
!
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   439
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   440
readBinaryIEEEDoubleFrom:aStream into:aFloat
14923
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   441
    "read the receiver's value from the binary stream, aStream,
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   442
     interpreting the next bytes as an IEEE formatted 8-byte float.
14925
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   443
     The bytes are read in the native byte order (i.e.lsb on intel)"
14923
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   444
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   445
    ^ self readBinaryIEEEDoubleFrom:aStream into:aFloat MSB:(UninterpretedBytes isBigEndian)
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   446
!
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   447
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   448
readBinaryIEEEDoubleFrom:aStream into:aFloat MSB:msb
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   449
    "read the receiver's value from the binary stream, aStream,
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   450
     interpreting the next bytes as an IEEE formatted 8-byte float.
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   451
     If msb is true, the stream bytes are most-significant-first."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   452
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   453
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   454
     this implementation is wrong: does not work on non-IEEE machines
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   455
     (to date all machines where ST/X is running on use
14923
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   456
      IEEE float format. Will need more here, when porting ST/X to 370's)
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   457
    "
3427
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   458
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   459
14923
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   460
    (UninterpretedBytes isBigEndian == msb) ifFalse:[
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   461
	"swap the bytes"
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   462
	8 to:1 by:-1 do:[:i |
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   463
	    aFloat basicAt:i put:(aStream next)
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   464
	].
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   465
	^ self
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   466
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   467
    1 to:8 do:[:i |
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   468
	aFloat basicAt:i put:aStream next
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   469
    ]
9637
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   470
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   471
    "not part of libboss, as this is also used by others (TIFFReader)"
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   472
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   473
    "Modified: / 23-08-2006 / 16:00:37 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   474
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   475
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   476
storeBinaryIEEEDouble:aFloat on:aStream
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   477
    "store aFloat as an IEEE formatted 8-byte float
14925
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   478
     onto the binary stream, aStream.
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   479
     The bytes are written in the native byte order (i.e.lsb on intel)"
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   480
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   481
    self storeBinaryIEEEDouble:aFloat on:aStream MSB:(UninterpretedBytes isBigEndian)
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   482
!
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   483
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   484
storeBinaryIEEEDouble:aFloat on:aStream MSB:msb
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   485
    "store aFloat as an IEEE formatted 8-byte float
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   486
     onto the binary stream, aStream.
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   487
     If msb is true, the stream bytes are written most-significant-first."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   488
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   489
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   490
     this implementation is wrong: does not work on non-IEEE machines
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   491
     (to date all machines where ST/X is running on use
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   492
      IEEE float format. Need more here, when porting ST/X to 370's)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   493
    "
3427
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   494
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   495
14925
046356fde326 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14923
diff changeset
   496
    (UninterpretedBytes isBigEndian == msb) ifFalse:[
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   497
	"swap the bytes"
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   498
	8 to:1 by:-1 do:[:i |
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   499
	    aStream nextPut:(aFloat basicAt:i).
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   500
	].
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   501
	^ self
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   502
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   503
    1 to:8 do:[:i |
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14926
diff changeset
   504
	aStream nextPut:(aFloat basicAt:i).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   505
    ].
9637
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   506
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   507
    "not part of libboss, as this is also used by others (TIFFReader)"
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   508
3e3866fb16e9 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9150
diff changeset
   509
    "Modified: / 23-08-2006 / 16:00:47 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   510
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   511
7441
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   512
!Float class methodsFor:'class initialization'!
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   513
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   514
initialize
14105
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   515
    Pi isNil ifTrue:[
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   516
        DefaultPrintFormat := '.15'.  "/ print 15 valid digits
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   517
        Pi := 3.14159265358979323846264338327950288419716939937510582097494459.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   518
        Halfpi := Pi / 2.0.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   519
        HalfpiNegative := Halfpi negated.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   520
        Twopi := Pi * 2.0.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   521
        E := 2.7182818284590452353602874713526625.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   522
        Sqrt2 := 1.41421356237309504880168872420969808.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   523
        RadiansPerDegree := Pi / 180.0.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   524
        Ln2 := 0.69314718055994530941723212145817657.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   525
        Ln10 := 10.0 ln.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
   526
        Epsilon := self computeEpsilon.
14105
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   527
    ].
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   528
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   529
    "
14105
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   530
     Pi := nil.
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   531
     self initialize
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   532
    "
7441
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   533
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   534
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   535
     DefaultPrintFormat := '.9'.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   536
     Float pi printString.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   537
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   538
     DefaultPrintFormat := '.6'.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   539
     Float pi printString.
7441
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   540
    "
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   541
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   542
    "Modified: / 07-06-2007 / 21:17:53 / cg"
7441
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   543
! !
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
   544
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   545
!Float class methodsFor:'constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   546
3945
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   547
NaN
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   548
    "return the constant NaN (not a Number).
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   549
     Do not use (yet) - for now, this is only defined for a
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   550
     few selected architectures."
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   551
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   552
%{  /* NOCONTEXT */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
   553
#if defined(LINUX) && defined(__i386__)
3955
ebf11ebe113e NAN for suseV6 nan.h
Claus Gittinger <cg@exept.de>
parents: 3945
diff changeset
   554
# ifdef NAN
ebf11ebe113e NAN for suseV6 nan.h
Claus Gittinger <cg@exept.de>
parents: 3945
diff changeset
   555
    RETURN (__MKFLOAT(NAN));
ebf11ebe113e NAN for suseV6 nan.h
Claus Gittinger <cg@exept.de>
parents: 3945
diff changeset
   556
# else
3945
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   557
    RETURN (__MKFLOAT(_SNAN));
3955
ebf11ebe113e NAN for suseV6 nan.h
Claus Gittinger <cg@exept.de>
parents: 3945
diff changeset
   558
# endif
3945
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   559
#endif
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   560
%}.
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   561
    ^ super NaN
3945
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   562
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   563
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   564
     Float NaN
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   565
     Float NaN + 0.0
3945
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   566
     Float NaN + Float NaN
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   567
     0.0 + Float NaN
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   568
    "
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   569
!
1745e97364cb added preliminary version of NaN
Claus Gittinger <cg@exept.de>
parents: 3903
diff changeset
   570
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   571
e
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   572
    "return the constant e as Float"
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   573
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   574
    "/ dont expect this many valid digits on all machines;
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   575
    "/ The actual precision is very CPU specific.
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   576
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
   577
    ^ 2.7182818284590452353602874713526625
6341
19a407a314da Raise more specific signals.
Stefan Vogel <sv@exept.de>
parents: 6335
diff changeset
   578
!
19a407a314da Raise more specific signals.
Stefan Vogel <sv@exept.de>
parents: 6335
diff changeset
   579
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   580
ln2
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   581
    "/ dont expect this many valid digits on all machines;
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   582
    "/ The actual precision is very CPU specific.
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   583
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   584
    ^ 0.69314718055994530941723212145817657.
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   585
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   586
    "Created: / 07-06-2007 / 21:11:55 / cg"
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   587
!
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   588
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   589
pi
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   590
    "return the constant pi as Float"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   591
3244
9ba0abc1d217 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3241
diff changeset
   592
    "/ dont expect this many valid digits on all machines;
9ba0abc1d217 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3241
diff changeset
   593
    "/ The actual precision is very CPU specific.
9ba0abc1d217 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3241
diff changeset
   594
6063
Claus Gittinger <cg@exept.de>
parents: 5986
diff changeset
   595
    ^ 3.14159265358979323846264338327950288419716939937510582097494459
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   596
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   597
    "Modified: 23.4.1996 / 09:27:02 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   598
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   599
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   600
sqrt2
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   601
    "/ dont expect this many valid digits on all machines;
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   602
    "/ The actual precision is very CPU specific.
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   603
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   604
    ^ 1.41421356237309504880168872420969808
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   605
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   606
    "Created: / 07-06-2007 / 21:12:33 / cg"
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   607
!
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
   608
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   609
unity
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   610
    "return the neutral element for multiplication (1.0) as Float"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   611
a27a279701f8 Initial revision
claus
parents:
diff changeset
   612
    ^ 1.0
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   613
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   614
    "Modified: 23.4.1996 / 09:27:09 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   615
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   616
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   617
zero
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   618
    "return the neutral element for addition (0.0) as Float"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   619
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   620
    ^ 0.0
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   621
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
   622
    "Modified: 23.4.1996 / 09:27:15 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   623
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   624
14105
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   625
!Float class methodsFor:'misc'!
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   626
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   627
getFPUControl
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   628
    "get the fpu control word."
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   629
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   630
%{
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   631
#ifdef __BORLANDC__
14106
900bb7bce82f *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 14105
diff changeset
   632
    unsigned int _control87();
900bb7bce82f *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 14105
diff changeset
   633
14105
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   634
    int result = _control87(0, 0);
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   635
    RETURN(__MKSMALLINT(result));
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   636
#endif
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   637
%}
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   638
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   639
    "
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   640
	self getFPUControl
14105
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   641
    "
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   642
!
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   643
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   644
setFPUControl
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   645
    "set the fpu control word.
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   646
     We want 64 bit precision for long double here"
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   647
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   648
%{
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   649
#ifdef __BORLANDC__
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   650
#include <float.h>
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   651
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   652
    // Set precision to long double / 64bit
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   653
    int result = _control87(PC_64, MCW_PC);
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   654
    RETURN(__MKSMALLINT(result));
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   655
#endif
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   656
%}
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   657
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   658
    "
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
   659
	self setFPUControl
14105
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   660
    "
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   661
! !
Stefan Vogel <sv@exept.de>
parents: 13146
diff changeset
   662
16447
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
   663
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   664
!Float class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 1
diff changeset
   665
6898
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   666
exponentCharacter
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   667
    ^ $d
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   668
!
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   669
4655
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   670
hasSharedInstances
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   671
    "return true if this class has shared instances, that is, instances
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   672
     with the same value are identical.
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   673
     Although not really shared, floats should be treated
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   674
     so, to be independent of the implementation of the arithmetic methods."
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   675
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   676
    ^ true
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   677
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   678
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   679
!
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   680
3
24d81bf47225 *** empty log message ***
claus
parents: 1
diff changeset
   681
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   682
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   683
     Here, true is returned for myself, false for subclasses."
3
24d81bf47225 *** empty log message ***
claus
parents: 1
diff changeset
   684
24d81bf47225 *** empty log message ***
claus
parents: 1
diff changeset
   685
    ^ self == Float
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   686
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   687
    "Modified: 23.4.1996 / 15:59:04 / cg"
3427
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   688
!
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   689
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   690
isIEEEFormat
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   691
    "return true, if this machine represents floats in IEEE format.
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   692
     Currently, no support is provided for non-ieee machines
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   693
     to convert their floats into this (which is only relevant,
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   694
     if such a machine wants to send floats as binary to some other
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   695
     machine).
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   696
     Machines with non-IEEE format are VAXed and IBM370-type systems
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   697
     (among others). Today, most systems use IEEE format floats."
14923
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   698
%{
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   699
#ifdef __s390__
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   700
    RETURN(false);
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   701
#endif
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   702
%}.
3427
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   703
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   704
    ^ true "/ this may be a lie
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   705
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   706
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   707
numBitsInExponent
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   708
    "answer the number of bits in the exponent
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   709
     This is an IEEE float, where 11 bits are available:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   710
	seeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   711
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   712
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   713
    ^ 11
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   714
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   715
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   716
numBitsInMantissa
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   717
    "answer the number of bits in the mantissa.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   718
     This is an IEEE double, where 52 bits (the hidden one is not counted here) are available:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   719
	seeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   720
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   721
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   722
     ^ 52
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   723
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   724
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   725
precision
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   726
    "answer the precision of a Float (in bits)
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   727
     This is an IEEE double, where only the fraction from the normalized mantissa is stored
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   728
     and so there is a hidden bit and the mantissa is actually represented
9150
550cef1b935a comment
Claus Gittinger <cg@exept.de>
parents: 9124
diff changeset
   729
     by 53 binary digits (although only 52 are needed in the binary representation)"
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   730
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   731
    ^  53
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   732
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   733
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   734
radix
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   735
    "answer the radix of a Floats exponent
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   736
     This is an IEEE float, which is represented as binary"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
   737
8635
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8422
diff changeset
   738
    ^ 2 "must be careful here, whenever ST/X is used on VAX or a 370"
3
24d81bf47225 *** empty log message ***
claus
parents: 1
diff changeset
   739
! !
24d81bf47225 *** empty log message ***
claus
parents: 1
diff changeset
   740
15013
f049844b9f0a class: Float
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   741
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   742
!Float methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   743
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   744
* aNumber
11733
fe4717d35e0c comment
Claus Gittinger <cg@exept.de>
parents: 11721
diff changeset
   745
    "return the product of the receiver and the argument."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   746
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   747
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   748
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   749
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   750
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   751
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   752
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   753
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   754
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   755
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   756
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   757
     */
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   758
    OBJ newFloat;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   759
    double result;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   760
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   761
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   762
	result = __floatVal(self) * (double)(__intVal(aNumber));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   763
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   764
	__qMKFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   765
	RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   766
    }
14689
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   767
    /* knowing that aNumber is not a SmallInt, we only need to check for nil;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   768
     * then can use qIsXXX macros which saves us some checks
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   769
     */
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   770
    if (aNumber != nil) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   771
	if (__qIsFloatLike(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   772
	    result = __floatVal(self) * __floatVal(aNumber);
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   773
	    goto retResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   774
	}
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   775
	if (__qIsShortFloat(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   776
	    result = __floatVal(self) * (double)(__shortFloatVal(aNumber));
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   777
	    goto retResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   778
	}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   779
    }
3530
a1af5dafc3ee float op shortFloat added inline.
Claus Gittinger <cg@exept.de>
parents: 3472
diff changeset
   780
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   781
    ^ aNumber productFromFloat:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   782
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
   783
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   784
+ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   785
    "return the sum of the receiver and the argument, aNumber"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   786
a27a279701f8 Initial revision
claus
parents:
diff changeset
   787
%{  /* NOCONTEXT */
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
   788
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   789
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   790
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   791
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   792
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   793
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   794
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   795
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   796
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   797
     */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   798
    OBJ newFloat;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   799
    double result;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   800
250
a5deb61ffdac *** empty log message ***
claus
parents: 224
diff changeset
   801
    if (__isSmallInteger(aNumber)) {
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
   802
	result = __floatVal(self) + (double)(__intVal(aNumber));
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   803
retResult:
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
   804
	__qMKFLOAT(newFloat, result);
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
   805
	RETURN ( newFloat );
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   806
    }
14689
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   807
    /* knowing that aNumber is not a SmallInt, we only need to check for nil;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   808
     * then can use qIsXXX macros which saves us some checks
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   809
     */
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   810
    if (aNumber != nil) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   811
	if (__qIsFloatLike(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   812
	    result = __floatVal(self) + __floatVal(aNumber);
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   813
	    goto retResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   814
	}
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   815
	if (__qIsShortFloat(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   816
	    result = __floatVal(self) + (double)(__shortFloatVal(aNumber));
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   817
	    goto retResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   818
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   819
    }
3530
a1af5dafc3ee float op shortFloat added inline.
Claus Gittinger <cg@exept.de>
parents: 3472
diff changeset
   820
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   821
    ^ aNumber sumFromFloat:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   822
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   823
a27a279701f8 Initial revision
claus
parents:
diff changeset
   824
- aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   825
    "return the difference of the receiver and the argument, aNumber"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   826
a27a279701f8 Initial revision
claus
parents:
diff changeset
   827
%{  /* NOCONTEXT */
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
   828
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   829
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   830
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   831
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   832
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   833
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   834
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   835
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   836
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   837
     */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   838
    OBJ newFloat;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   839
    double result;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   840
250
a5deb61ffdac *** empty log message ***
claus
parents: 224
diff changeset
   841
    if (__isSmallInteger(aNumber)) {
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
   842
	result = __floatVal(self) - (double)(__intVal(aNumber));
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   843
retResult:
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
   844
	__qMKFLOAT(newFloat, result);
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
   845
	RETURN ( newFloat );
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   846
    }
14689
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   847
    /* knowing that aNumber is not a SmallInt, we only need to check for nil;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   848
     * then can use qIsXXX macros which saves us some checks
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   849
     */
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   850
    if (aNumber != nil) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   851
	if (__qIsFloatLike(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   852
	    result = __floatVal(self) - __floatVal(aNumber);
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   853
	    goto retResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   854
	}
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   855
	if (__qIsShortFloat(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   856
	    result = __floatVal(self) - (double)(__shortFloatVal(aNumber));
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   857
	    goto retResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   858
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   859
    }
3530
a1af5dafc3ee float op shortFloat added inline.
Claus Gittinger <cg@exept.de>
parents: 3472
diff changeset
   860
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   861
    ^ aNumber differenceFromFloat:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   862
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   863
a27a279701f8 Initial revision
claus
parents:
diff changeset
   864
/ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   865
    "return the quotient of the receiver and the argument, aNumber"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   866
a27a279701f8 Initial revision
claus
parents:
diff changeset
   867
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   868
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   869
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   870
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   871
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   872
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   873
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   874
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   875
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   876
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   877
     */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   878
    OBJ newFloat;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   879
    double result, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   880
250
a5deb61ffdac *** empty log message ***
claus
parents: 224
diff changeset
   881
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   882
	if (aNumber != __mkSmallInteger(0)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   883
	    result = __floatVal(self) / ( (double)__intVal(aNumber)) ;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   884
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   885
	    __qMKFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   886
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   887
	}
3530
a1af5dafc3ee float op shortFloat added inline.
Claus Gittinger <cg@exept.de>
parents: 3472
diff changeset
   888
    } else if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   889
	val = __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   890
	if (val != 0.0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   891
	    result = __floatVal(self) / val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   892
	    goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   893
	}
3530
a1af5dafc3ee float op shortFloat added inline.
Claus Gittinger <cg@exept.de>
parents: 3472
diff changeset
   894
    } else if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   895
	val = (double)(__shortFloatVal(aNumber));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   896
	if (val != 0.0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   897
	    result = __floatVal(self) / val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   898
	    goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   899
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   900
    }
3530
a1af5dafc3ee float op shortFloat added inline.
Claus Gittinger <cg@exept.de>
parents: 3472
diff changeset
   901
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   902
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   903
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   904
	 No, you shalt not divide by zero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   905
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
   906
	^ ZeroDivide raiseRequestWith:thisContext.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   907
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   908
    ^ aNumber quotientFromFloat:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   909
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   910
14923
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   911
abs
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   912
    "return the absolute value of the receiver
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   913
     reimplemented here for speed"
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   914
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   915
%{  /* NOCONTEXT */
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   916
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   917
    OBJ newFloat;
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   918
    double val =__floatVal(self);
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   919
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   920
    if (val < 0.0) {
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   921
	__qMKFLOAT(newFloat, -val);
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   922
	RETURN ( newFloat );
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   923
    }
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   924
    RETURN (self);
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   925
%}.
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   926
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   927
    "
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   928
     3.0 abs
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   929
     -3.0 abs
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   930
    "
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   931
!
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   932
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   933
negated
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   934
    "return myself negated"
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   935
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   936
%{  /* NOCONTEXT */
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   937
    OBJ newFloat;
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   938
    double rslt = - __floatVal(self);
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   939
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   940
    __qMKFLOAT(newFloat, rslt);
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   941
    RETURN ( newFloat );
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   942
%}.
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   943
!
d17a1105f17c class: Float
Claus Gittinger <cg@exept.de>
parents: 14751
diff changeset
   944
14689
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   945
rem: aNumber
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   946
    "return the floating point remainder of the receiver and the argument, aNumber"
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   947
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   948
%{  /* NOCONTEXT */
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   949
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   950
    /*
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   951
     * notice:
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   952
     * the following inline code handles some common cases,
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   953
     * and exists as an optimization, to speed up those cases.
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   954
     *
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   955
     * Conceptionally, (and for most other argument types),
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   956
     * mixed arithmetic is implemented by double dispatching
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   957
     * (see the message send at the bottom)
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   958
     */
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   959
    OBJ newFloat;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   960
    double result, val;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   961
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   962
    if (__isSmallInteger(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   963
	if (aNumber != __mkSmallInteger(0)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   964
	    val = (double)__intVal(aNumber);
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   965
computeResult:
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   966
	    result = fmod(__floatVal(self), val) ;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   967
	    __qMKFLOAT(newFloat, result);
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   968
	    RETURN ( newFloat );
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   969
	}
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   970
    } else if (__isFloatLike(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   971
	val = __floatVal(aNumber);
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   972
	if (val != 0.0) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   973
	    goto computeResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   974
	}
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   975
    } else if (__isShortFloat(aNumber)) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   976
	val = (double)(__shortFloatVal(aNumber));
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   977
	if (val != 0.0) {
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   978
	    goto computeResult;
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   979
	}
14720
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   980
#ifdef LONGFLOAT_KNOWN_HERE
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   981
    } else if (__isLongFloat(aNumber)) {
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   982
	long double lval;
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   983
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   984
	lval = (long double)(__longFloatVal(aNumber));
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   985
	if (val != 0.0) {
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   986
	    long double lResult;
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   987
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   988
	    lResult = fmodl((long double)(__floatVal(self)), lval);
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   989
	    __qMKLFLOAT(newFloat, lResult);
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   990
	    RETURN (newFloat);
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   991
	}
ca17582f4fba comment
Claus Gittinger <cg@exept.de>
parents: 14689
diff changeset
   992
#endif
14689
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   993
    }
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   994
%}.
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   995
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   996
	"
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   997
	 No, you shalt not divide by zero
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   998
	"
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
   999
	^ ZeroDivide raiseRequestWith:thisContext.
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
  1000
    ].
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
  1001
    ^ aNumber remainderFromFloat:self
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
  1002
!
f709732040c1 added rem: and a tiny performance speedup in other mixed-type arith messages
Claus Gittinger <cg@exept.de>
parents: 14672
diff changeset
  1003
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1004
uncheckedDivide:aNumber
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1005
    "return the quotient of the receiver and the argument, aNumber.
7471
c5d4bd612d9f comments
Claus Gittinger <cg@exept.de>
parents: 7441
diff changeset
  1006
     Do not check for divide by zero (return NaN or Infinity).
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1007
     This operation is provided for emulators of other languages/semantics,
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1008
     where no exception is raised for these results (i.e. Java).
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1009
     Its only defined if the arguments type is the same as the receivers."
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1010
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1011
%{  /* NOCONTEXT */
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1012
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1013
    OBJ newFloat;
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1014
    double result, val;
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1015
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1016
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1017
	result = __floatVal(self) / ( (double)__intVal(aNumber)) ;
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1018
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1019
	__qMKFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1020
	RETURN ( newFloat );
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1021
    }
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1022
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1023
	val = __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1024
	result = __floatVal(self) / val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1025
	goto retResult;
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1026
    }
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1027
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1028
	val = (double)(__shortFloatVal(aNumber));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1029
	result = __floatVal(self) / val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1030
	goto retResult;
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1031
    }
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1032
%}.
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1033
    ^ aNumber quotientFromFloat:self
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1034
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1035
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1036
      0.0 uncheckedDivide:0.0
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1037
      1.0 uncheckedDivide:0.0
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1038
      -1.0 uncheckedDivide:0.0
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1039
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1040
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1041
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1042
5238
f7a816a660a3 categories
Claus Gittinger <cg@exept.de>
parents: 5120
diff changeset
  1043
!Float methodsFor:'coercing & converting'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1044
3014
9934bb63d455 added #asDouble
ca
parents: 2892
diff changeset
  1045
asDouble
7429
3efb092371a3 comment
Claus Gittinger <cg@exept.de>
parents: 7420
diff changeset
  1046
    "ST80 compatibility: return a double with receivers value.
3efb092371a3 comment
Claus Gittinger <cg@exept.de>
parents: 7420
diff changeset
  1047
     our floats are the identical to ST80 doubles"
3014
9934bb63d455 added #asDouble
ca
parents: 2892
diff changeset
  1048
9934bb63d455 added #asDouble
ca
parents: 2892
diff changeset
  1049
    ^ self
9934bb63d455 added #asDouble
ca
parents: 2892
diff changeset
  1050
!
9934bb63d455 added #asDouble
ca
parents: 2892
diff changeset
  1051
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1052
asFloat
15020
d3c13efd316f class: Float
Claus Gittinger <cg@exept.de>
parents: 15017
diff changeset
  1053
    "return a float with same value - that's me"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1054
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1055
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1056
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1057
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1058
asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1059
    "return an integer with same value - might truncate"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1060
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1061
%{  /* NOCONTEXT */
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1062
    double dVal;
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1063
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1064
    dVal = __floatVal(self);
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
  1065
#ifdef WIN32
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1066
    if (! isnan(dVal))
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
  1067
#endif
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
  1068
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1069
	if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1070
	    RETURN ( __mkSmallInteger( (INT)dVal) );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1071
	}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1072
    }
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1073
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1074
    ^ super asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1075
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1076
    "12345.0 asInteger"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1077
    "1e15 asInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1078
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1079
5986
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1080
asLongFloat
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1081
    "return a longFloat with same value as receiver"
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1082
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1083
    ^ LongFloat fromFloat:self
5986
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1084
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1085
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1086
     123 asFloat asLongFloat
5986
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1087
    "
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1088
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1089
    "Created: / 7.9.2001 / 13:43:04 / cg"
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1090
    "Modified: / 7.9.2001 / 13:43:16 / cg"
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1091
!
3d8c2676e913 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  1092
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1093
asShortFloat
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1094
    "return a shortFloat with same value as receiver.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1095
     CAVEAT: should raise an error if the receiver exceeds the float range."
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1096
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1097
%{  /* NOCONTEXT */
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1098
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1099
    OBJ dummy = @global(ShortFloat);
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1100
    OBJ newFloat;
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1101
    float fVal = (float)__floatVal(self);
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1102
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1103
    __qMKSFLOAT(newFloat, fVal);
1198
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1104
    RETURN ( newFloat );
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1105
%}
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1106
!
284eeba6b719 docu & limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1107
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1108
asTrueFraction
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1109
    "Answer a fraction or integer that EXACTLY represents self,
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1110
     a double precision IEEE floating point number.
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1111
     Floats are stored in the same form on all platforms.
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1112
     (Does not handle gradual underflow or NANs.)
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1113
     By David N. Smith with significant performance
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1114
     improvements by Luciano Esteban Notarfrancesco.
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1115
     (Version of 11April97)"
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1116
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1117
    |shifty sign expPart exp fraction fractionPart result zeroBitsCount|
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1118
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6341
diff changeset
  1119
    self isFinite ifFalse:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1120
	^ self asMetaNumber
7441
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  1121
"/        ^ self class
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  1122
"/            raise:#domainErrorSignal
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  1123
"/            receiver:self
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  1124
"/            selector:#asTrueFraction
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  1125
"/            arguments:#()
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  1126
"/            errorString:'Cannot represent non-finite float as a fraction'.
6341
19a407a314da Raise more specific signals.
Stefan Vogel <sv@exept.de>
parents: 6335
diff changeset
  1127
    ].
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1128
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1129
    "Extract the bits of an IEEE double float "
6341
19a407a314da Raise more specific signals.
Stefan Vogel <sv@exept.de>
parents: 6335
diff changeset
  1130
    shifty := LargeInteger basicNew numberOfDigits:8.
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1131
    UninterpretedBytes isBigEndian ifTrue:[
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1132
"/        shifty := ((self longWordAt: 1) bitShift: 32) + (self longWordAt: 2).
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1133
	1 to:8 do:[:i | shifty digitAt:(9-i) put:(self basicAt:i)].
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1134
    ] ifFalse:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1135
	1 to:8 do:[:i | shifty digitAt:i put:(self basicAt:i)].
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1136
    ].
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1137
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1138
    " Extract the sign and the biased exponent "
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1139
    sign := (shifty bitShift: -63) = 0 ifTrue: [1] ifFalse: [-1].
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1140
    expPart := (shifty bitShift: -52) bitAnd: 16r7FF.
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1141
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1142
    " Extract fractional part; answer 0 if this is a true 0.0 value "
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1143
    fractionPart := shifty bitAnd:  16r000FFFFFFFFFFFFF.
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1144
    ( expPart=0 and: [ fractionPart=0 ] ) ifTrue: [ ^ 0  ].
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1145
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1146
    " Replace omitted leading 1 in fraction "
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1147
    fraction := fractionPart bitOr: 16r0010000000000000.
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1148
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1149
    "Unbias exponent: 16r3FF is bias; 52 is fraction width"
7480
74f8bf8628e2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7471
diff changeset
  1150
    exp := 16r3FF - expPart + 52.
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1151
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1152
    " Form the result. When exp>52, the exponent is adjusted by
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1153
      the number of trailing zero bits in the fraction to minimize
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1154
      the (huge) time otherwise spent in #gcd:. "
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1155
    exp negative ifTrue: [
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1156
	result := sign * (fraction bitShift: exp negated)
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1157
    ] ifFalse:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1158
	zeroBitsCount := fraction lowBit - 1.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1159
	exp := exp - zeroBitsCount.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1160
	exp <= 0 ifTrue: [
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1161
	    zeroBitsCount := zeroBitsCount + exp.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1162
	    "exp := 0."   " Not needed; exp not refernced again "
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1163
	    result := sign * (fraction bitShift:zeroBitsCount negated)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1164
	] ifFalse: [
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1165
	    result := Fraction
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1166
		    numerator: (sign * (fraction bitShift: zeroBitsCount negated))
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1167
		    denominator: (1 bitShift:exp)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1168
	]
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1169
    ].
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1170
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1171
    "Low cost validation omitted after extensive testing"
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1172
    "(result asFloat = self) ifFalse: [self error: 'asTrueFraction validation failed']."
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1173
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1174
    ^ result
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1175
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1176
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1177
     0.3 asTrueFraction
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1178
     1.25 asTrueFraction
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1179
     0.25 asTrueFraction
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1180
     -0.25 asTrueFraction
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1181
     3e37 asTrueFraction
6341
19a407a314da Raise more specific signals.
Stefan Vogel <sv@exept.de>
parents: 6335
diff changeset
  1182
     Float NaN asTrueFraction
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6341
diff changeset
  1183
     Float infinity asTrueFraction
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1184
    "
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1185
!
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1186
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1187
coerce:aNumber
11721
358878a3860c comment
Claus Gittinger <cg@exept.de>
parents: 11487
diff changeset
  1188
    "convert the argument aNumber into an instance of the receivers class and return it."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1189
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1190
    ^ aNumber asFloat
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1191
!
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1192
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1193
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1194
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1195
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1196
    ^ 80
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1197
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1198
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1199
!Float methodsFor:'comparing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1200
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1201
< aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1202
    "return true, if the argument is greater"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1203
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1204
%{  /* NOCONTEXT */
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1205
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1206
    /*
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1207
     * notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1208
     * the following inline code handles some common cases,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1209
     * and exists as an optimization, to speed up those cases.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1210
     *
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1211
     * Conceptionally, (and for most other argument types),
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1212
     * mixed arithmetic is implemented by double dispatching
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1213
     * (see the message send at the bottom)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1214
     */
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1215
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1216
	RETURN ( (__floatVal(self) < (double)(__intVal(aNumber))) ? true : false );
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1217
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1218
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1219
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1220
	    RETURN ( (__floatVal(self) < __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1221
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1222
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1223
	    RETURN ( (__floatVal(self) < (double)(__shortFloatVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1224
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1225
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1226
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1227
    ^ aNumber lessFromFloat:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1228
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1229
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1230
<= aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1231
    "return true, if the argument is greater or equal"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1232
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1233
%{  /* NOCONTEXT */
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1234
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1235
    /*
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1236
     * notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1237
     * the following inline code handles some common cases,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1238
     * and exists as an optimization, to speed up those cases.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1239
     *
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1240
     * Conceptionally, (and for most other argument types),
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1241
     * mixed arithmetic is implemented by double dispatching
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1242
     * (see the message send at the bottom)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1243
     */
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1244
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1245
	RETURN ( (__floatVal(self) <= (double)(__intVal(aNumber))) ? true : false );
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1246
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1247
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1248
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1249
	    RETURN ( (__floatVal(self) <= __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1250
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1251
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1252
	    RETURN ( (__floatVal(self) <= (double)(__shortFloatVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1253
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1254
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1255
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1256
    ^ self retry:#<= coercing:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1257
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1258
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1259
= aNumber
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1260
    "return true, if the argument represents the same numeric value
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1261
     as the receiver, false otherwise"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1262
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1263
%{  /* NOCONTEXT */
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1264
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1265
    /*
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1266
     * notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1267
     * the following inline code handles some common cases,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1268
     * and exists as an optimization, to speed up those cases.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1269
     *
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1270
     * Conceptionally, (and for most other argument types),
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1271
     * mixed arithmetic is implemented by double dispatching
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1272
     * (see the message send at the bottom)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1273
     */
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1274
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1275
	RETURN ( (__floatVal(self) == (double)(__intVal(aNumber))) ? true : false );
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1276
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1277
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1278
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1279
	    RETURN ( (__floatVal(self) == __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1280
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1281
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1282
	    RETURN ( (__floatVal(self) == (double)(__shortFloatVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1283
	}
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1284
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1285
	RETURN (false);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1286
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1287
%}.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1288
    ^ aNumber equalFromFloat:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1289
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1290
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1291
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1292
    "return true, if the argument is less"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1293
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1294
%{  /* NOCONTEXT */
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1295
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1296
    /*
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1297
     * notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1298
     * the following inline code handles some common cases,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1299
     * and exists as an optimization, to speed up those cases.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1300
     *
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1301
     * Conceptionally, (and for most other argument types),
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1302
     * mixed arithmetic is implemented by double dispatching
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1303
     * (see the message send at the bottom)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1304
     */
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1305
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1306
	RETURN ( (__floatVal(self) > (double)(__intVal(aNumber))) ? true : false );
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1307
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1308
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1309
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1310
	    RETURN ( (__floatVal(self) > __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1311
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1312
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1313
	    RETURN ( (__floatVal(self) > (double)(__shortFloatVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1314
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1315
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1316
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1317
    ^ self retry:#> coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1318
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1319
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1320
>= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1321
    "return true, if the argument is less or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1322
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1323
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1324
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1325
    /*
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1326
     * notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1327
     * the following inline code handles some common cases,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1328
     * and exists as an optimization, to speed up those cases.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1329
     *
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1330
     * Conceptionally, (and for most other argument types),
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1331
     * mixed arithmetic is implemented by double dispatching
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1332
     * (see the message send at the bottom)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1333
     */
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1334
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1335
	RETURN ( (__floatVal(self) >= (double)(__intVal(aNumber))) ? true : false );
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1336
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1337
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1338
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1339
	    RETURN ( (__floatVal(self) >= __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1340
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1341
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1342
	    RETURN ( (__floatVal(self) >= (double)(__shortFloatVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1343
	}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1344
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1345
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1346
    ^ self retry:#>= coercing:aNumber
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1347
!
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1348
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1349
hash
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1350
    "return a number for hashing; redefined, since floats compare
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1351
     by numeric value (i.e. 3.0 = 3), therefore 3.0 hash must be the same
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
  1352
     as 3 hash."
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1353
305
26b092c71935 *** empty log message ***
claus
parents: 283
diff changeset
  1354
    |i|
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1355
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1356
    (self >= SmallInteger minVal and:[self <= SmallInteger maxVal]) ifTrue:[
4655
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  1357
	i := self asInteger.
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  1358
	self = i ifTrue:[
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  1359
	    ^ i hash
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  1360
	].
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1361
    ].
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1362
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1363
    "
305
26b092c71935 *** empty log message ***
claus
parents: 283
diff changeset
  1364
     mhmh take some of my value-bits to hash on
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1365
    "
4590
3db3bf4615bd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4454
diff changeset
  1366
    ^ (((self basicAt:8) bitAnd:16r1F) bitShift:24) +
305
26b092c71935 *** empty log message ***
claus
parents: 283
diff changeset
  1367
      ((self basicAt:7) bitShift:16) +
26b092c71935 *** empty log message ***
claus
parents: 283
diff changeset
  1368
      ((self basicAt:6) bitShift:8) +
4592
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  1369
      (((self basicAt:5) + (self basicAt:1) + (self basicAt:2)) bitAnd:16rFF)
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1370
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1371
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1372
     3 hash
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1373
     3.0 hash
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1374
     3.1 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1375
     3.14159 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1376
     31.4159 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1377
     3.141591 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1378
     1.234567890123456 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1379
     1.234567890123457 hash
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1380
     Set withAll:#(3 3.0 99 99.0 3.1415)
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1381
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1382
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1383
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1384
isAlmostEqualTo:aNumber nEpsilon:nE 
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1385
    "return true, if the argument, aNumber represents almost the same numeric value
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1386
     as the receiver, false otherwise.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1387
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1388
     nE is the number of minimal float distances, that the numbers may differ and
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1389
     still be considered equal.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1390
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1391
     For background information why floats need this 
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1392
     read: http://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1393
    "
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1394
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1395
%{  /* NOCONTEXT */
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1396
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1397
    /*
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1398
     * notice:
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1399
     * the following inline code handles some common cases,
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1400
     * and exists as an optimization, to speed up those cases.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1401
     *
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1402
     * Conceptionally, (and for most other argument types),
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1403
     * mixed arithmetic is implemented by double dispatching
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1404
     * (see the message send at the bottom)
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1405
     */
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1406
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1407
#ifndef INT64
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1408
# define INT64 long long int
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1409
#endif
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1410
    INT64 ulpDiff;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1411
    union {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1412
        double d;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1413
        INT64 i;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1414
    } myself, otherFloat;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1415
    int nEpsilon;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1416
    double scaledEpsilon;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1417
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1418
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1419
    if (!__isSmallInteger(nE)) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1420
        goto tryHarder;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1421
    }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1422
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1423
    nEpsilon =  __intVal(nE);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1424
    scaledEpsilon = nEpsilon *__floatVal(@global(Epsilon));
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1425
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1426
    if (__isSmallInteger(aNumber)) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1427
        otherFloat.d = (double)(__intVal(aNumber));
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1428
    } else if (aNumber == nil) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1429
        RETURN(false)
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1430
    } else if (__qIsFloatLike(aNumber)) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1431
        otherFloat.d = (double)(__floatVal(aNumber));
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1432
    } else if (__qIsShortFloat(aNumber)) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1433
        otherFloat.d = (double)(__shortFloatVal(aNumber));
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1434
    } else {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1435
        goto tryHarder;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1436
    }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1437
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1438
    myself.d = __floatVal(self);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1439
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1440
    // Check if the numbers are really close -- needed
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1441
    // when comparing numbers near zero (ULP method below fails for numbers near 0!).
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1442
    if (fabs(myself.d - otherFloat.d) <= scaledEpsilon) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1443
        RETURN(true);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1444
    }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1445
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1446
    // if the signs differ, the numbers are different
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1447
    if (signbit(myself.d) != signbit(otherFloat.d)) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1448
        RETURN(false);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1449
    }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1450
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1451
    // compute the difference of the 'units in the last place" ULP
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1452
    // (if ulpDiff == 1, two floats are adjecant)
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1453
    ulpDiff = myself.i - otherFloat.i;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1454
    if (ulpDiff < 0) ulpDiff = -ulpDiff;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1455
    if (ulpDiff <= nEpsilon) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1456
        RETURN(true);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1457
    } else {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1458
        RETURN(false)
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1459
    }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1460
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1461
tryHarder:;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1462
%}.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1463
    ^ aNumber isAlmostEqualToFromFloat:self nEpsilon:nE
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1464
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1465
    "
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1466
        67329.234 isAlmostEqualTo:67329.23400000001 nEpsilon:1
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1467
        1.0 isAlmostEqualTo:1.0001 nEpsilon:1
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1468
        1.0 isAlmostEqualTo:-1.0 nEpsilon:1
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1469
        1 isAlmostEqualTo:1.000000000000001 nEpsilon:1
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1470
        1 isAlmostEqualTo:1.000000000000001 nEpsilon:10
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1471
        1.0 isAlmostEqualTo:1 nEpsilon:1
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1472
        1.0 isAlmostEqualTo:1 asFraction nEpsilon:1
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1473
    "
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1474
!
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1475
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1476
~= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1477
    "return true, if the arguments value are not equal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1478
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1479
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1480
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1481
    /*
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1482
     * notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1483
     * the following inline code handles some common cases,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1484
     * and exists as an optimization, to speed up those cases.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1485
     *
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1486
     * Conceptionally, (and for most other argument types),
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1487
     * mixed arithmetic is implemented by double dispatching
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1488
     * (see the message send at the bottom)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1489
     */
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1490
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1491
	RETURN ( (__floatVal(self) != (double)(__intVal(aNumber))) ? true : false );
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1492
    }
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1493
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1494
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1495
	    RETURN ( (__floatVal(self) != __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1496
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1497
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1498
	    RETURN ( (__floatVal(self) != (double)(__shortFloatVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1499
	}
3115
1ecfb9118163 dont check twice for nil (in compare ops)
Claus Gittinger <cg@exept.de>
parents: 3014
diff changeset
  1500
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1501
	RETURN ( true );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1502
    }
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1503
%}.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1504
    ^ super ~= aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1505
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1506
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1507
!Float methodsFor:'mathematical functions'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1508
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1509
exp
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1510
    "return e raised to the power of the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1511
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1512
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1513
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1514
    double rslt;
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1515
    OBJ newFloat;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1516
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  1517
    __threadErrno = 0;
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1518
    rslt = exp(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  1519
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  1520
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1521
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1522
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1523
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1524
	}
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1525
    }
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1526
%}.
3395
02f47135d80f pass messageSend as parameter to domainError exception
Claus Gittinger <cg@exept.de>
parents: 3279
diff changeset
  1527
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1528
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1529
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1530
	selector:#exp
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1531
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1532
	errorString:'bad receiver in exp'
6195
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6193
diff changeset
  1533
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6193
diff changeset
  1534
    "Modified: / 16.11.2001 / 14:14:29 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1535
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1536
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1537
ln
6193
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1538
    "return the natural logarithm of myself.
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1539
     Raises an exception, if the receiver is less or equal to zero."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1540
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1541
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1542
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1543
    double val, rslt;
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1544
    OBJ newFloat;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1545
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1546
    val = __floatVal(self);
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1547
6193
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1548
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1549
    if (val > 0.0)
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1550
#endif
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1551
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1552
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1553
	rslt = log(val);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1554
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1555
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1556
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1557
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1558
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1559
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1560
	}
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1561
    }
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1562
%}.
142
c7844287bddf *** empty log message ***
claus
parents: 131
diff changeset
  1563
    "
c7844287bddf *** empty log message ***
claus
parents: 131
diff changeset
  1564
     an invalid value for logarithm
c7844287bddf *** empty log message ***
claus
parents: 131
diff changeset
  1565
    "
3395
02f47135d80f pass messageSend as parameter to domainError exception
Claus Gittinger <cg@exept.de>
parents: 3279
diff changeset
  1566
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1567
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1568
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1569
	selector:#ln
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1570
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1571
	errorString:'bad receiver in ln'
6193
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1572
6195
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6193
diff changeset
  1573
    "Modified: / 16.11.2001 / 14:14:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1574
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1575
7373
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1576
log10
12583
4271383b5862 changed: #log10
Claus Gittinger <cg@exept.de>
parents: 12478
diff changeset
  1577
    "return the base-10 logarithm of myself.
7373
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1578
     Raises an exception, if the receiver is less or equal to zero."
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1579
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1580
%{  /* NOCONTEXT */
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1581
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1582
    double val, rslt;
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1583
    OBJ newFloat;
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1584
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1585
    val = __floatVal(self);
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1586
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1587
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1588
    if (val > 0.0)
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1589
#endif
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1590
    {
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1591
	__threadErrno = 0;
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1592
	rslt = log10(val);
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1593
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1594
	{
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1595
	    if (__threadErrno == 0) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1596
		__qMKFLOAT(newFloat, rslt);
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1597
		RETURN ( newFloat );
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1598
	    }
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1599
	}
7373
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1600
    }
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1601
%}.
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1602
    "
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1603
     an invalid value for logarithm
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1604
    "
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1605
    ^ self class
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1606
	raise:#domainErrorSignal
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1607
	receiver:self
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1608
	selector:#log10
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1609
	arguments:#()
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1610
	errorString:'bad receiver in log10'
7373
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1611
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1612
    "Modified: / 16.11.2001 / 14:14:33 / cg"
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1613
!
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
  1614
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1615
raisedTo:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1616
    "return self raised to the power of aNumber"
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  1617
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1618
    |n|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1619
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1620
    n := aNumber asFloat.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1621
%{
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1622
    double rslt;
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1623
    OBJ newFloat;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1624
283
a897d331b4c1 *** empty log message ***
claus
parents: 258
diff changeset
  1625
    if (__isFloatLike(n)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1626
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1627
	rslt = pow(__floatVal(self), __floatVal(n));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1628
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1629
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1630
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1631
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1632
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1633
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1634
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1635
    }
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1636
%}.
142
c7844287bddf *** empty log message ***
claus
parents: 131
diff changeset
  1637
    "
c7844287bddf *** empty log message ***
claus
parents: 131
diff changeset
  1638
     an invalid argument (not convertable to float ?)
c7844287bddf *** empty log message ***
claus
parents: 131
diff changeset
  1639
    "
3395
02f47135d80f pass messageSend as parameter to domainError exception
Claus Gittinger <cg@exept.de>
parents: 3279
diff changeset
  1640
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1641
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1642
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1643
	selector:#raisedTo:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1644
	arguments:(Array with:aNumber)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1645
	errorString:'bad receiver/arg in raisedTo:'
6195
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6193
diff changeset
  1646
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6193
diff changeset
  1647
    "Modified: / 16.11.2001 / 14:16:51 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1648
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1649
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1650
sqrt
6193
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1651
    "return the square root of myself.
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1652
     Raises an exception, if the receiver is less than zero."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1653
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1654
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1655
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1656
    double val, rslt;
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1657
    OBJ newFloat;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1658
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1659
    val = __floatVal(self);
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1660
6193
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1661
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
6189
f4bfc2dacdb7 win32: care for some math errors
Claus Gittinger <cg@exept.de>
parents: 6145
diff changeset
  1662
    if (val >= 0.0)
3889
3466554b639f manually check receiver for beeing >= 0 under WINDOWS
Claus Gittinger <cg@exept.de>
parents: 3632
diff changeset
  1663
#endif
3466554b639f manually check receiver for beeing >= 0 under WINDOWS
Claus Gittinger <cg@exept.de>
parents: 3632
diff changeset
  1664
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1665
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1666
	rslt = sqrt(val);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1667
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1668
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1669
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1670
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1671
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1672
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1673
	}
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1674
    }
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1675
%}.
3395
02f47135d80f pass messageSend as parameter to domainError exception
Claus Gittinger <cg@exept.de>
parents: 3279
diff changeset
  1676
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1677
	raise:#imaginaryResultSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1678
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1679
	selector:#sqrt
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1680
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1681
	errorString:'bad (negative) receiver in sqrt'
3399
4f45ebb7bc60 oops - linux does not set errNo on some domainErrors;
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1682
4f45ebb7bc60 oops - linux does not set errNo on some domainErrors;
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1683
    "
4f45ebb7bc60 oops - linux does not set errNo on some domainErrors;
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1684
     10 sqrt
4f45ebb7bc60 oops - linux does not set errNo on some domainErrors;
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1685
     -10 sqrt
4f45ebb7bc60 oops - linux does not set errNo on some domainErrors;
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1686
    "
6193
69f010509638 comments
Claus Gittinger <cg@exept.de>
parents: 6189
diff changeset
  1687
6195
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6193
diff changeset
  1688
    "Modified: / 16.11.2001 / 14:14:43 / cg"
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1689
! !
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1690
16447
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
  1691
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1692
!Float methodsFor:'printing & storing'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1693
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1694
printString
2358
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1695
    "return a printed representation of the receiver;
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1696
     if not specified otherwise (by setting DefaultPrintFormat),
3194
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3163
diff changeset
  1697
     6 valid digits are printed.
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3163
diff changeset
  1698
     LimitedPrecisonReal and its subclasses use #printString instead of
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3163
diff changeset
  1699
     #printOn: as basic print mechanism."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1700
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1701
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1702
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1703
    char buffer[64];
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1704
    REGISTER char *cp;
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1705
    OBJ s;
2358
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1706
    char *fmt;
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1707
    char fmtBuffer[20];
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1708
    int len;
2358
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1709
12478
e8051030cda6 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 12423
diff changeset
  1710
    if (__isStringLike(@global(DefaultPrintFormat))) {
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1711
	fmt = (char *) __stringVal(@global(DefaultPrintFormat));
2358
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1712
    } else {
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1713
	/*
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1714
	 * in case we get called before #initialize ...
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1715
	 */
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1716
	fmt = ".15";
2358
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1717
    }
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1718
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1719
    /*
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1720
     * build a printf format string
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1721
     */
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1722
    fmtBuffer[0] = '%';
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1723
    strncpy(fmtBuffer+1, fmt, 10);
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1724
#ifdef SYSV
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1725
    strcat(fmtBuffer, "lg");
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1726
#else
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1727
    strcat(fmtBuffer, "G");
6bdf2adfe9f5 defaultPrintFormat
Claus Gittinger <cg@exept.de>
parents: 2215
diff changeset
  1728
#endif
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1729
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1730
    __BEGIN_PROTECT_REGISTERS__
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1731
    len = snprintf(buffer, sizeof(buffer), fmtBuffer, __floatVal(self));
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1732
    __END_PROTECT_REGISTERS__
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1733
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1734
    if (len >= 0 && len < sizeof(buffer)-3) {
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1735
	/*
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1736
	 * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1737
	 * (i.e. look if string contains '.' or 'e' and append '.0' if not)
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1738
	 */
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1739
	for (cp = buffer; *cp; cp++) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1740
	    if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1741
	}
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1742
	if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1743
	    if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1744
		*cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1745
	    } else {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1746
		*cp++ = '.';
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1747
	    }
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1748
	    *cp++ = '0';
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1749
	    *cp = '\0';
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1750
	} else {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1751
	    if (cp && ((*cp == '.') || (*cp == ','))) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1752
		if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1753
		    *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1754
		}
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1755
	    }
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1756
	}
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1757
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1758
	s = __MKSTRING(buffer);
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1759
	if (s != nil) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1760
	    RETURN (s);
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1761
	}
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1762
    }
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1763
%}.
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1764
    "
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1765
     memory allocation (for the new string) failed.
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1766
     When we arrive here, there was no memory, even after a garbage collect.
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1767
     This means, that the VM wanted to get some more memory from the
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1768
     OS, which was not kind enough to give it.
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1769
     Bad luck - you should increase the swap space on your machine.
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1770
    "
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1771
    ^ ObjectMemory allocationFailureSignal raise.
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1772
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1773
    "
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1774
	1.0 printString
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1775
	1.234 printString
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1776
	1e10 printString
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1777
	1.2e3 printString
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1778
	1.2e30 printString
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1779
	(1.0 uncheckedDivide:0) printString
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1780
	(0.0 uncheckedDivide:0) printString
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1781
	self pi printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1782
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1783
	DecimalPointCharacter := $,.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1784
	1.234 printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1785
	1.0 printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1786
	1e10 printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1787
	1.2e3 printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1788
	1.2e30 printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1789
	(1.0 uncheckedDivide:0) printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1790
	(0.0 uncheckedDivide:0) printString.
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1791
	DecimalPointCharacter := $.
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1792
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1793
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1794
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1795
printfPrintString:formatString
7746
4a4208ef7699 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7724
diff changeset
  1796
    "non-standard: return a printed representation of the receiver
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1797
     as specified by formatString, which is defined by printf.
31
75f2b9f78be2 *** empty log message ***
claus
parents: 16
diff changeset
  1798
     If you use this, be aware, that specifying doubles differs on
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1799
     systems; on SYSV machines you have to give something like %lf,
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1800
     while on BSD systems the format string has to be %F.
31
75f2b9f78be2 *** empty log message ***
claus
parents: 16
diff changeset
  1801
     Also, the resulting string may not be longer than 255 bytes -
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1802
     since thats the (static) size of the buffer.
11926
295e8bb99fde changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11733
diff changeset
  1803
     This method is NONSTANDARD and may be removed without notice.
295e8bb99fde changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11733
diff changeset
  1804
     WARNNG: this goes directly to the C-printf function and may therefore me inherently unsafe.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1805
11926
295e8bb99fde changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11733
diff changeset
  1806
     Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1807
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
  1808
%{  /* STACK: 400 */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1809
    char buffer[256];
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1810
    OBJ s;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1811
    int len;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1812
12478
e8051030cda6 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 12423
diff changeset
  1813
    if (__isStringLike(formatString)) {
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1814
	/*
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1815
	 * actually only needed on sparc: since thisContext is
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1816
	 * in a global register, which gets destroyed by printf,
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1817
	 * manually save it here - very stupid ...
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1818
	 */
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1819
	__BEGIN_PROTECT_REGISTERS__
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1820
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1821
	len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __floatVal(self));
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1822
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1823
	__END_PROTECT_REGISTERS__
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1824
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1825
	if (len < 0) goto fail;
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1826
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1827
	s = __MKSTRING_L(buffer, len);
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1828
	if (s != nil) {
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1829
	    RETURN (s);
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  1830
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1831
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1832
fail: ;
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  1833
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1834
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1835
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1836
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1837
     Float pi printfPrintString:'%%lg -> %lg'
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1838
     Float pi printfPrintString:'%%lf -> %lf'
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8302
diff changeset
  1839
     Float pi printfPrintString:'%%7.15lg -> %7.15lg'
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1840
     Float pi printfPrintString:'%%7.5lf -> %7.5lf'
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1841
     Float pi printfPrintString:'%%G -> %G'
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1842
     Float pi printfPrintString:'%%F -> %F'
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1843
     Float pi printfPrintString:'%%7.5G -> %7.5G'
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1844
     Float pi printfPrintString:'%%7.5F -> %7.5F'
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  1845
    "
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1846
!
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1847
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1848
storeString
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1849
    "return a printed representation of the receiver;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1850
     all valid digits are printed.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1851
     LimitedPrecisonReal and its subclasses use #storeString instead of
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1852
     #storeOn: as basic print mechanism."
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1853
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1854
%{  /* NOCONTEXT */
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1855
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1856
    char buffer[64];
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1857
    REGISTER char *cp;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1858
    OBJ s;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1859
    int len;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1860
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1861
    __BEGIN_PROTECT_REGISTERS__
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1862
#ifdef SYSV
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1863
    len = snprintf(buffer, sizeof(buffer), "%.17lg", __floatVal(self));
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1864
#else
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1865
    len = snprintf(buffer, sizeof(buffer), "%.17G", __floatVal(self));
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1866
#endif
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1867
    __END_PROTECT_REGISTERS__
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1868
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1869
    if (len >= 0 && len < sizeof(buffer)-3) {
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1870
        /*
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1871
         * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1872
         * (i.e. look if string contains '.' or 'e' and append '.0' if not)
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1873
         */
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1874
        for (cp = buffer; *cp; cp++) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1875
            if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1876
        }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1877
        if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1878
            *cp++ = '.';
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1879
            *cp++ = '0';
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1880
            *cp = '\0';
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1881
        }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1882
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1883
        s = __MKSTRING(buffer);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1884
        if (s != nil) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1885
            RETURN (s);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1886
        }
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1887
    }
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1888
%}.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1889
    "
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1890
     memory allocation (for the new string) failed.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1891
     When we arrive here, there was no memory, even after a garbage collect.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1892
     This means, that the VM wanted to get some more memory from the
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1893
     OS, which was not kind enough to give it.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1894
     Bad luck - you should increase the swap space on your machine.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1895
    "
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1896
    ^ ObjectMemory allocationFailureSignal raise.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1897
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1898
    "
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1899
        1.0 storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1900
        1.234 storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1901
        1e10 storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1902
        1.2e3 storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1903
        1.2e30 storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1904
        Float pi storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1905
        (1.0 uncheckedDivide:0) storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1906
        (0.0 uncheckedDivide:0) storeString
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1907
9124
1bc6bb791bdc decimalPoint control
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1908
     notice that the storeString is NOT affected by DecimalPointCharacterForPrinting:
1bc6bb791bdc decimalPoint control
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1909
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1910
        DecimalPointCharacterForPrinting := $,.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1911
        1.234 storeString.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1912
        1.0 storeString.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1913
        1e10 storeString.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1914
        1.2e3 storeString.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1915
        1.2e30 storeString.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1916
        (1.0 uncheckedDivide:0) storeString.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1917
        (0.0 uncheckedDivide:0) storeString.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  1918
        DecimalPointCharacterForPrinting := $.
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  1919
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1920
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1921
11926
295e8bb99fde changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11733
diff changeset
  1922
7258
9ccdbee7d1ad method category rename
Claus Gittinger <cg@exept.de>
parents: 7217
diff changeset
  1923
!Float methodsFor:'private-accessing'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1924
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1925
basicAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1926
    "return an internal byte of the float.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1927
     The value returned here depends on byte order, float representation etc.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1928
     Therefore, this method should be used strictly private.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1929
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1930
     Notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1931
	the need to redefine this method here is due to the
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1932
	inability of many machines to store floats in non-double aligned memory.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1933
	Therefore, on some machines, the first 4 bytes of a float are left unused,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1934
	and the actual float is stored at index 5 .. 12.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1935
	To hide this at one place, this method knows about that, and returns
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1936
	values as if this filler wasnt present."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1937
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1938
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1939
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1940
    register int indx;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1941
    unsigned char *cp;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1942
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1943
    /*
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1944
     * notice the missing test for self being a nonNilObject -
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1945
     * this can be done since basicAt: is defined both in UndefinedObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1946
     * and SmallInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1947
     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1948
    if (__isSmallInteger(index)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1949
	indx = __intVal(index) - 1;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1950
	if (((unsigned)(indx)) < sizeof(double)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1951
	    cp = (unsigned char *)(& (__FloatInstPtr(self)->f_floatvalue));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1952
	    RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1953
	}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1954
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1955
%}.
7217
554bb9c2ba24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1956
    ^ self indexNotIntegerOrOutOfBounds:index
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1957
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1958
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1959
basicAt:index put:value
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1960
    "set an internal byte of the float.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1961
     The value to be stored here depends on byte order, float representation etc.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1962
     Therefore, this method should be used strictly private.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1963
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1964
     Notice:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1965
	the need to redefine this method here is due to the
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1966
	inability of many machines to store floats in non-double aligned memory.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1967
	Therefore, on some machines, the first 4 bytes of a float are left unused,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1968
	and the actual float is stored at index 5 .. 12.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1969
	To hide this at one place, this method knows about that, and returns
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1970
	values as if this filler wasnt present."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1971
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1972
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1973
    register int indx, val;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1974
    unsigned char *cp;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1975
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1976
    /*
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1977
     * notice the missing test for self being a nonNilObject -
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1978
     * this can be done since basicAt: is defined both in UndefinedObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1979
     * and SmallInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1980
     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1981
    if (__bothSmallInteger(index, value)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1982
	val = __intVal(value);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1983
	if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1984
	    indx = __intVal(index) - 1;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1985
	    if (((unsigned)(indx)) < sizeof(double)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1986
		cp = (unsigned char *)(& (__FloatInstPtr(self)->f_floatvalue));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1987
		cp[indx] = val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1988
		RETURN ( value );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1989
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1990
	}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1991
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1992
%}.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1993
    value isInteger ifFalse:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1994
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1995
	 the object to store should be an integer number
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1996
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  1997
	^ self elementNotInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1998
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  1999
    (value between:0 and:255) ifFalse:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2000
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2001
	 the object to store must be a bytes value
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2002
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2003
	^ self elementBoundsError:value
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2004
    ].
7217
554bb9c2ba24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2005
    ^ self indexNotIntegerOrOutOfBounds:index
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2006
!
4592
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2007
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2008
basicSize
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2009
    "return the size in bytes of the float.
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2010
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2011
     Notice:
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2012
        the need to redefine this method here is due to the
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2013
        inability of many machines to store floats in non-double aligned memory.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2014
        Therefore, on some machines, the first 4 bytes of a float are left unused,
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2015
        and the actual float is stored at index 5 .. 12.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2016
        To hide this at one place, this method knows about that, and returns
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2017
        values as if this filler wasn't present."
4592
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2018
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2019
%{  /* NOCONTEXT */
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2020
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2021
    RETURN (__mkSmallInteger(sizeof(double)));
4592
f68de0746dab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4590
diff changeset
  2022
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2023
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2024
16658
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2025
!Float methodsFor:'queries'!
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2026
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2027
nextFloat:count
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2028
    "answer the next float count places after (or before if count is negative) myself"
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2029
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2030
%{
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2031
#ifndef INT64
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2032
# define INT64 long long int
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2033
#endif
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2034
    union {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2035
        double d;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2036
        INT64 i;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2037
    } this;
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2038
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2039
    if (__isSmallInteger(count)) {
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2040
        this.d = __floatVal(self);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2041
        if (isfinite(this.d))
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2042
            this.i += __intVal(count);
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2043
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2044
        RETURN(__MKFLOAT(this.d));
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2045
    }
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2046
%}.
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2047
    self primitiveFailed:#badArgument
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2048
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2049
  "
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2050
     (1.0 nextFloat:1) storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2051
     (67329.234 nextFloat:1) storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2052
     (67329.234 asShortFloat nextFloat:1) storeString
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2053
     Float NaN nextFloat:100000
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2054
     Float infinity nextFloat:100000
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2055
  "
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2056
! !
1c653a0a7e4d class: Float
Stefan Vogel <sv@exept.de>
parents: 16632
diff changeset
  2057
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2058
!Float methodsFor:'special access'!
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2059
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2060
exponent
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2061
    "extract a normalized floats exponent.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2062
     The returned value depends on the float-representation of
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2063
     the underlying machine and is therefore highly unportable.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2064
     This is not for general use.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2065
     This assumes that the mantissa is normalized to
12423
a3c777accbb0 changed: #exponent
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  2066
     0.5 .. 1.0 and the float's value is: mantissa * 2^exp"
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2067
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2068
%{  /* NOCONTEXT */
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2069
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2070
    double frac;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2071
    int exp;
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2072
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2073
    frac = frexp(__floatVal(self), &exp);
14751
991d38458125 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 14728
diff changeset
  2074
    RETURN (__mkSmallInteger(exp));
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2075
%}.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2076
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2077
    "
14672
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2078
     1.0 exponent
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2079
     2.0 exponent
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2080
     3.0 exponent
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2081
     4.0 exponent
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2082
     0.5 exponent
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2083
     0.4 exponent
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2084
     0.25 exponent
8abd84f0951a setlocale once only in stxmain
Claus Gittinger <cg@exept.de>
parents: 14630
diff changeset
  2085
     0.2 exponent
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2086
     0.00000011111 exponent
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2087
    "
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2088
!
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2089
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2090
mantissa
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2091
    "extract a normalized floats mantissa.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2092
     The returned value depends on the float-representation of
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2093
     the underlying machine and is therefore highly unportable.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2094
     This is not for general use.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2095
     This assumes that the mantissa is normalized to
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2096
     0.5 .. 1.0 and the floats value is mantissa * 2^exp"
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2097
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2098
%{  /* NOCONTEXT */
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2099
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2100
    double frac;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2101
    int exp;
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2102
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2103
    frac = frexp(__floatVal(self), &exp);
14751
991d38458125 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 14728
diff changeset
  2104
    RETURN (__MKFLOAT(frac));
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2105
%}.
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2106
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2107
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2108
     1.0 exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2109
     1.0 mantissa
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2110
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2111
     0.25 exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2112
     0.25 mantissa
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2113
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2114
     0.00000011111 exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2115
     0.00000011111 mantissa
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2116
    "
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2117
! !
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2118
16447
8cd3042a7f31 class: Float
Stefan Vogel <sv@exept.de>
parents: 15264
diff changeset
  2119
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2120
!Float methodsFor:'testing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2121
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2122
isFinite
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2123
    "return true, if the receiver is a finite float
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2124
     i.e. not NaN and not infinite."
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2125
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2126
%{  /* NOCONTEXT */
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2128
    double dV = __floatVal(self);
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2129
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2130
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2131
     * notice: on machines which do not provide
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2132
     * a finite() macro or function (WIN32),
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
  2133
     * this may always ret true here ...
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2134
     */
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2135
    if (isfinite(dV)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2136
	RETURN (true);
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2137
    }
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2138
%}.
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
  2139
    ^ false
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2140
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2141
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2142
	1.0 isFinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2143
	Float NaN isFinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2144
	Float infinity isFinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2145
	(0.0 uncheckedDivide: 0.0) isFinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2146
	(1.0 uncheckedDivide: 0.0) isFinite
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2147
    "
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2148
!
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2149
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2150
isInfinite
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2151
    "return true, if the receiver is an infinite float (Inf).
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2152
     These are not created by ST/X float operations (they raise an exception);
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2153
     however, inline C-code could produce them ...
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2154
     Redefined here for speed"
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2155
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2156
%{  /* NOCONTEXT */
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2157
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2158
    double dV = __floatVal(self);
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2159
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2160
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2161
     * notice: on machines which do not provide
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2162
     * finite() & isnan() macros or functions (WIN32),
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4296
diff changeset
  2163
     * this may always ret false here ...
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2164
     */
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
  2165
#if defined(isinf)
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2166
    if (isinf(dV)) { RETURN (true); }
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2167
#else
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
  2168
    if (!isfinite(dV) && !isnan(dV)) { RETURN (true); }
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2169
#endif
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2170
%}.
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2171
    ^ false
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2172
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2173
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2174
	1.0 isInfinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2175
	(0.0 uncheckedDivide: 0.0) isInfinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2176
	(1.0 uncheckedDivide: 0.0) isInfinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2177
	(-1.0 uncheckedDivide: 0.0) isInfinite
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2178
    "
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2179
!
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2180
4655
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2181
isLiteral
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2182
    "return true, if the receiver can be used as a literal constant in ST syntax
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2183
     (i.e. can be used in constant arrays)"
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2184
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2185
    ^ true
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2186
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2187
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2188
!
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2189
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2190
isNaN
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2191
    "return true, if the receiver is an invalid float (NaN - not a number).
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2192
     These are not created by ST/X float operations (they raise an exception);
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2193
     however, inline C-code could produce them ..."
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2194
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2195
%{  /* NOCONTEXT */
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2196
3139
ca
parents: 3129
diff changeset
  2197
    double dV = (__floatVal(self));
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2198
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2199
    if (isnan(dV)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2200
	RETURN (true);
7420
633c9331da21 isnan for Win32
Claus Gittinger <cg@exept.de>
parents: 7411
diff changeset
  2201
    }
2392
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  2202
%}.
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  2203
    ^ false
3139
ca
parents: 3129
diff changeset
  2204
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2205
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2206
	1.0 isNaN
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2207
	(0.0 uncheckedDivide: 0.0) isNaN
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2208
	(1.0 uncheckedDivide: 0.0) isNaN
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2209
	(-1.0 uncheckedDivide: 0.0) isNaN
3146
4e46505d1d59 New #finite, fix #isNaN and #isInfinite.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2210
    "
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2211
!
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  2212
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2213
isNegativeZero
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2214
    "many systems have two float.Pnt zeros"
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2215
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2216
%{
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  2217
#if defined(__i386__) && defined(LINUX)
7441
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  2218
    unsigned int biasedExponent;
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  2219
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  2220
    biasedExponent = ((short *)(__ByteArrayInstPtr(self)->ba_element))[3] & 0xFF70;
17e37777f83b double dispatching
Claus Gittinger <cg@exept.de>
parents: 7429
diff changeset
  2221
    RETURN ((biasedExponent == 0x8000) ? true : false );
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2222
#endif
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2223
%}.
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2224
    ^ super isNegativeZero
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2225
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2226
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2227
     0.0 isNegativeZero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2228
     -0.0 isNegativeZero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2229
     -1.0 isNegativeZero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2230
     1.0 isNegativeZero
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2231
    "
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2232
!
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  2233
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2234
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2235
    "return true if the receiver is less than zero"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2236
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2237
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2238
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 809
diff changeset
  2239
    RETURN ( (__floatVal(self) < 0.0) ? true : false );
5411
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
  2240
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2241
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2242
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2243
numberOfBits
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2244
    "return the size (in bits) of the real;
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2245
     typically, 64 is returned here,
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2246
     but who knows ..."
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2247
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2248
%{  /* NOCONTEXT */
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2249
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2250
    RETURN (__mkSmallInteger (sizeof(double) * 8));
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2251
%}
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2252
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2253
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2254
     1.2 numberOfBits
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2255
     1.2 asShortFloat numberOfBits
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2256
    "
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2257
!
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2258
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2259
positive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2260
    "return true if the receiver is greater or equal to zero"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2261
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2262
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2263
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 809
diff changeset
  2264
    RETURN ( (__floatVal(self) >= 0.0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2265
%}
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2266
!
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2267
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2268
strictlyPositive
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2269
    "return true if the receiver is greater than zero"
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2270
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2271
%{  /* NOCONTEXT */
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2272
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2273
    RETURN ( (__floatVal(self) > 0.0) ? true : false );
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2274
%}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2275
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2276
4655
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2277
!Float methodsFor:'tracing'!
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2278
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4655
diff changeset
  2279
traceInto:aRequestor level:level from:referrer
4655
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2280
    "double dispatch into tracer, passing my type implicitely in the selector"
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2281
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4655
diff changeset
  2282
    ^ aRequestor traceFloat:self level:level from:referrer
4655
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2283
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2284
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2285
! !
b9405ca0bb4e added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
  2286
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2287
!Float methodsFor:'trigonometric'!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2288
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2289
arcCos
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2290
    "return the arccosine of the receiver (as radians).
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2291
     Raises an exception, if the receiver is not in -1..1"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2292
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2293
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2294
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2295
    double val, rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2296
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2297
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2298
    val = __floatVal(self);
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2299
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2300
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2301
    if ((val >= -1.0) && (val <= 1.0))
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2302
#endif
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2303
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2304
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2305
	rslt = acos(val);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2306
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2307
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2308
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2309
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2310
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2311
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2312
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2313
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2314
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2315
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2316
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2317
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2318
	selector:#arcCos
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2319
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2320
	errorString:'bad receiver in arcCos'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2321
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2322
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2323
     -10 arcCos
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2324
     1 arcCos
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2325
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2326
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2327
    "Modified: / 16.11.2001 / 14:14:13 / cg"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2328
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2329
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2330
arcCosh
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2331
    "return the hyperbolic arccosine of the receiver."
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2332
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2333
    |useFallBack|
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2334
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2335
%{
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2336
#ifdef NO_ACOSH
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2337
    useFallBack = true;
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2338
#else
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2339
    double val, rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2340
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2341
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2342
    val = __floatVal(self);
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2343
15264
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
  2344
# ifdef WIN32 /* don't know (yet) how to suppress the warnBox opened by win32 */
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2345
    if (val >= 1.0)
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2346
# endif
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2347
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2348
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2349
	rslt = acosh(val);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2350
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2351
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2352
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2353
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2354
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2355
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2356
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2357
    }
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2358
#endif
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2359
%}.
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2360
    useFallBack notNil ifTrue:[
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2361
	^ super arcCosh
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2362
    ].
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2363
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2364
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2365
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2366
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2367
	selector:#arcCosh
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2368
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2369
	errorString:'bad receiver in arcCosh'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2370
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2371
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2372
     -10.0 arcCosh
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2373
     1.0 arcCosh
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2374
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2375
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2376
    "Modified: / 16.11.2001 / 14:14:13 / cg"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2377
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2378
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2379
arcSin
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2380
    "return the arcsine of myself (I am interpreted as radians).
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2381
     Raises an exception, if the receiver is not in -1..1"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2382
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2383
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2384
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2385
    double val, rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2386
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2387
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2388
    val = __floatVal(self);
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2389
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2390
#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2391
    if ((val >= -1.0) && (val <= 1.0))
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2392
#endif
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2393
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2394
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2395
	rslt = asin(val);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2396
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2397
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2398
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2399
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2400
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2401
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2402
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2403
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2404
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2405
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2406
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2407
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2408
	selector:#arcSin
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2409
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2410
	errorString:'bad receiver in arcSin'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2411
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2412
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2413
     -10 arcSin
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2414
     1 arcSin
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2415
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2416
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2417
    "Modified: / 16.11.2001 / 14:14:18 / cg"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2418
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2419
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2420
arcSinh
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2421
    "return the hyperbolic arcsine of the receiver."
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2422
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2423
    |useFallBack|
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2424
%{
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2425
#ifdef NO_ASINH
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2426
    useFallBack = true;
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2427
#else
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2428
    double val, rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2429
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2430
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2431
    val = __floatVal(self);
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2432
15264
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
  2433
# ifdef WIN32 /* don't know (yet) how to suppress the warnBox opened by win32 */
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2434
    if (val >= 1.0)
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2435
# endif
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2436
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2437
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2438
	rslt = asinh(val);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2439
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2440
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2441
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2442
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2443
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2444
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2445
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2446
    }
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2447
#endif
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2448
%}.
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2449
    useFallBack notNil ifTrue:[
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2450
	^ super arcSinh
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2451
    ].
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2452
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2453
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2454
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2455
	selector:#arcSinh
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2456
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2457
	errorString:'bad receiver in arcSinh'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2458
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2459
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2460
     -10.0 arcSinh
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2461
     1.0 arcSinh
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2462
    "
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2463
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2464
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2465
arcTan
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2466
    "return the arctangent of the receiver (as radians)"
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2467
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2468
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2469
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2470
    double rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2471
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2472
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2473
    __threadErrno = 0;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2474
    rslt = atan(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2475
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2476
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2477
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2478
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2479
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2480
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2481
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2482
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2483
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2484
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2485
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2486
	selector:#arcTan
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2487
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2488
	errorString:'bad receiver in arcTan'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2489
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2490
    "Modified: / 16.11.2001 / 14:14:22 / cg"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2491
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2492
11487
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2493
arcTan2:x
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2494
    "return the atan2(self,x)"
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2495
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2496
%{  /* NOCONTEXT */
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2497
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2498
    double rslt;
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2499
    OBJ newFloat;
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2500
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2501
    if (__isFloat(x)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2502
	__threadErrno = 0;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2503
	rslt = atan2(__floatVal(self),__floatVal(x));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2504
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2505
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2506
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2507
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2508
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2509
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2510
	}
11487
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2511
    }
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2512
%}.
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2513
    x isFloat ifFalse:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2514
	^ self arcTan2:(x asFloat).
11487
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2515
    ].
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2516
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2517
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2518
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2519
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2520
	selector:#arcTan2:
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2521
	arguments:(Array with:x)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2522
	errorString:'bad receiver in arcTan2:'
11487
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2523
!
9195c17baa9e +arcTan2:
Claus Gittinger <cg@exept.de>
parents: 10604
diff changeset
  2524
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2525
arcTan: denominator
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2526
    (self = 0.0) ifTrue: [
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2527
	(denominator > 0.0)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2528
	    ifTrue: [ ^ 0 ]
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2529
	    ifFalse: [ ^ Pi ]
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2530
    ].
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2531
    (denominator = 0.0) ifTrue: [
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2532
	(self > 0.0)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2533
	    ifTrue: [ ^ Halfpi ]
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2534
	    ifFalse: [ ^ HalfpiNegative ]
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2535
    ].
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2536
    (denominator > 0)
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2537
	ifTrue: [ ^ (self / denominator) arcTan ]
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2538
	ifFalse: [ ^ ((self / denominator) arcTan) + Pi ]
10604
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2539
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2540
    "Created: / 07-06-2007 / 21:10:32 / cg"
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2541
    "Modified: / 11-06-2007 / 12:58:34 / cg"
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2542
!
2a9b9a20067a more constants
Claus Gittinger <cg@exept.de>
parents: 9651
diff changeset
  2543
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2544
arcTanh
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2545
    "return the hyperbolic arctangent of the receiver."
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2546
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2547
    |useFallBack|
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2548
%{
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2549
#ifdef NO_ATANH
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2550
    useFallBack = true;
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2551
#else
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2552
    double val, rslt;
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2553
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2554
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2555
    __threadErrno = 0;
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2556
    val = __floatVal(self);
15264
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
  2557
# ifdef WIN32 /* don't know (yet) how to suppress the warnBox opened by win32 */
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2558
    if ((val >= -1.0) && (val <= 1.0))
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2559
# endif
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2560
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2561
	rslt = atanh(__floatVal(self));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2562
	if (! isnan(rslt))  /* Currently all our systems support isnan() */
15264
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
  2563
#ifdef __osx__
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
  2564
	if (! isinf(rslt))
82b78761c585 osx fixes
Claus Gittinger <cg@exept.de>
parents: 15020
diff changeset
  2565
#endif
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2566
	{
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2567
	    if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2568
		__qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2569
		RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2570
	    }
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2571
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2572
    }
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2573
#endif
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2574
%}.
7410
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2575
    useFallBack notNil ifTrue:[
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2576
	^ super arcTanh
ba285982489a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7409
diff changeset
  2577
    ].
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2578
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2579
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2580
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2581
	selector:#arcTanh
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2582
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2583
	errorString:'bad receiver in arcTanh'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2584
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2585
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2586
cos
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2587
    "return the cosine of the receiver (interpreted as radians)"
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2588
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2589
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2590
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2591
    double rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2592
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2593
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2594
    __threadErrno = 0;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2595
    rslt = cos(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2596
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2597
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2598
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2599
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2600
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2601
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2602
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2603
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2604
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2605
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2606
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2607
	selector:#cos
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2608
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2609
	errorString:'bad receiver in cos'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2610
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2611
    "Modified: / 16.11.2001 / 14:14:26 / cg"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2612
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2613
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2614
cosh
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2615
    "return the hyperbolic cosine of the receiver"
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2616
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2617
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2618
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2619
    double rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2620
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2621
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2622
    __threadErrno = 0;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2623
    rslt = cosh(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2624
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2625
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2626
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2627
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2628
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2629
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2630
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2631
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2632
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2633
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2634
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2635
	selector:#cosh
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2636
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2637
	errorString:'bad receiver in cosh'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2638
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2639
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2640
sin
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2641
    "return the sine of the receiver (interpreted as radians)"
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2642
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2643
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2644
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2645
    double rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2646
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2647
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2648
    __threadErrno = 0;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2649
    rslt = sin(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2650
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2651
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2652
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2653
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2654
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2655
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2656
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2657
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2658
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2659
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2660
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2661
	selector:#sin
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2662
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2663
	errorString:'bad receiver in sin'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2664
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2665
    "Modified: / 16.11.2001 / 14:14:37 / cg"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2666
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2667
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2668
sinh
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2669
    "return the hyperbolic sine of the receiver"
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2670
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2671
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2672
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2673
    double rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2674
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2675
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2676
    __threadErrno = 0;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2677
    rslt = sinh(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2678
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2679
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2680
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2681
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2682
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2683
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2684
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2685
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2686
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2687
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2688
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2689
	selector:#sinh
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2690
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2691
	errorString:'bad receiver in sinh'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2692
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2693
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2694
tan
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2695
    "return the tangens of the receiver (interpreted as radians)"
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2696
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2697
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2698
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2699
    double rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2700
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2701
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2702
    __threadErrno = 0;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2703
    rslt = tan(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2704
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2705
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2706
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2707
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2708
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2709
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2710
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2711
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2712
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2713
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2714
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2715
	selector:#tan
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2716
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2717
	errorString:'bad receiver in tan'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2718
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2719
    "Modified: / 16.11.2001 / 14:14:49 / cg"
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2720
!
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2721
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2722
tanh
7391
55ca5a24162a added more math functions (hyperbolic)
Claus Gittinger <cg@exept.de>
parents: 7385
diff changeset
  2723
    "return the hyperbolic tangens of the receiver"
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2724
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2725
%{  /* NOCONTEXT */
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2726
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2727
    double rslt;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2728
    OBJ newFloat;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2729
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2730
    __threadErrno = 0;
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2731
    rslt = tanh(__floatVal(self));
7393
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2732
    if (! isnan(rslt))  /* Currently all our systems support isnan() */
23344038fa0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7391
diff changeset
  2733
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2734
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2735
	    __qMKFLOAT(newFloat, rslt);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2736
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2737
	}
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2738
    }
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2739
%}.
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2740
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2741
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2742
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2743
	selector:#tanh
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2744
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2745
	errorString:'bad receiver in tanh'
7385
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2746
! !
852e84340d2b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7381
diff changeset
  2747
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5436
diff changeset
  2748
!Float methodsFor:'truncation & rounding'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2749
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2750
ceiling
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2751
    "return the smallest integer which is greater or equal to the receiver."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2752
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2753
    |val|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2754
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2755
%{
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2756
    double dVal;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2757
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2758
    dVal = ceil(__floatVal(self));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2759
    /*
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2760
     * ST-80 (and X3J20) returns integer.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2761
     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2762
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2763
	RETURN ( __mkSmallInteger( (INT) dVal ) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2764
    }
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2765
    __qMKFLOAT(val, dVal);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2766
%}.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2767
    ^ val asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2768
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2769
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2770
ceilingAsFloat
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2771
    "return the smallest integer-valued float greater or equal to the receiver.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2772
     This is much like #ceiling, but avoids a (possibly expensive) conversion
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2773
     of the result to an integer.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2774
     It may be useful, if the result is to be further used in another float-operation."
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2775
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2776
%{  /* NOCONTEXT */
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2777
    double dVal;
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2778
    OBJ v;
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2779
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2780
    dVal = ceil(__floatVal(self));
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2781
    __qMKFLOAT(v, dVal);
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2782
    RETURN (v);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2783
%}
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2784
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2785
     0.5 ceilingAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2786
     -0.5 ceilingAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2787
     -1.5 ceilingAsFloat
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2788
    "
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2789
!
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2790
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2791
floor
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2792
    "return the integer nearest the receiver towards negative infinity."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2793
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2794
    |val|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2795
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2796
%{
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2797
    double dVal;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2798
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2799
    dVal = floor(__floatVal(self));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2800
    /*
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2801
     * ST-80 (and X3J20) returns integer.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2802
     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2803
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2804
	RETURN ( __mkSmallInteger( (INT) dVal ) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2805
    }
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2806
    __qMKFLOAT(val, dVal);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2807
%}.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2808
    ^ val asInteger
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2809
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2810
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2811
     0.5 floor
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2812
     0.5 floorAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2813
     -0.5 floor
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2814
     -0.5 floorAsFloat
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2815
    "
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2816
!
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2817
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2818
floorAsFloat
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2819
    "return the integer nearest the receiver towards negative infinity as a float.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2820
     This is much like #floor, but avoids a (possibly expensive) conversion
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2821
     of the result to an integer.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2822
     It may be useful, if the result is to be further used in another float-operation."
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2823
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2824
%{  /* NOCONTEXT */
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2825
    double dVal;
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2826
    OBJ v;
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2827
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2828
    dVal = floor(__floatVal(self));
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2829
    __qMKFLOAT(v, dVal);
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2830
    RETURN (v);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2831
%}
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2832
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2833
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2834
     0.5 floor
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2835
     0.5 floorAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2836
     -0.5 floor
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2837
     -0.5 floorAsFloat
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2838
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2839
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2840
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2841
fractionPart
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2842
    "extract the after-decimal fraction part.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2843
     such that (self truncated + self fractionPart) = self"
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2844
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2845
%{  /* NOCONTEXT */
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2846
14728
b947522816a7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14720
diff changeset
  2847
    double modf(double, double*);
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2848
    double frac, trunc;
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2849
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  2850
    __threadErrno = 0;
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2851
    frac = modf(__floatVal(self), &trunc);
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2852
    if (! isnan(frac)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2853
	if (__threadErrno == 0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2854
	    RETURN (__MKFLOAT(frac));
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2855
	}
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2856
    }
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2857
%}.
7403
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7393
diff changeset
  2858
    ^ self class
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2859
	raise:#domainErrorSignal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2860
	receiver:self
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2861
	selector:#fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2862
	arguments:#()
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2863
	errorString:'bad receiver in fractionPart'
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2864
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2865
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2866
     1.6 fractionPart + 1.6 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2867
     -1.6 fractionPart + -1.6 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2868
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2869
     1.0 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2870
     2.0 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2871
     3.0 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2872
     4.0 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2873
     0.5 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2874
     0.25 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2875
     3.14159 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2876
     12345673.14159 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2877
     123456731231231231.14159 fractionPart
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2878
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2879
     3.14159 fractionPart + 3.14159 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2880
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2881
     12345673.14159 fractionPart + 12345673.14159 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2882
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2883
     123456731231231231.14159 fractionPart + 123456731231231231.14159 truncated
3896
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2884
    "
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2885
!
ff8ef5f6f3e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3894
diff changeset
  2886
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2887
rounded
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2888
    "return the receiver rounded to the nearest integer"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2889
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2890
    |val|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2891
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2892
%{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2893
    double dVal;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2894
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2895
    dVal = __floatVal(self);
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2896
    if (dVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2897
	dVal = ceil(dVal - 0.5);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2898
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2899
	dVal = floor(dVal + 0.5);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2900
    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2901
    /*
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2902
     * ST-80 (and X3J20) returns integer.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2903
     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2904
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2905
	RETURN ( __mkSmallInteger( (INT) dVal ) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2906
    }
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2907
    __qMKFLOAT(val, dVal);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2908
%}.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7258
diff changeset
  2909
    ^ val asInteger
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2910
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2911
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2912
     0.4 rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2913
     0.5 rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2914
     0.6 rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2915
     -0.4 rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2916
     -0.5 rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2917
     -0.6 rounded
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2918
    "
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2919
!
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2920
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2921
roundedAsFloat
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2922
    "return the receiver rounded to the nearest integer as a float.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2923
     This is much like #rounded, but avoids a (possibly expensive) conversion
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2924
     of the result to an integer.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2925
     It may be useful, if the result is to be further used in another
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2926
     float-operation."
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2927
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2928
    |val|
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2929
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2930
%{  /* NOCONTEXT */
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2931
    double dVal;
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2932
    OBJ v;
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2933
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2934
    dVal = __floatVal(self);
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2935
    if (dVal < 0.0) {
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2936
	dVal = ceil(dVal - 0.5);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2937
    } else {
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2938
	dVal = floor(dVal + 0.5);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2939
    }
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2940
    __qMKFLOAT(v, dVal);
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2941
    RETURN (v);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2942
%}
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2943
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2944
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2945
     0.5 rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2946
     -0.5 rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2947
     0.5 roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2948
     -0.5 roundedAsFloat
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2949
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2950
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2951
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2952
truncated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2953
    "return the receiver truncated towards zero as an integer"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2954
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2955
    |val|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2956
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2957
%{
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2958
    double dVal;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2959
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 809
diff changeset
  2960
    dVal = __floatVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2961
    if (dVal < 0.0) {
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2962
	dVal = ceil(dVal);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2963
    } else {
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2964
	dVal = floor(dVal);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2965
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2966
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2967
    /*
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2968
     * ST-80 (and X3J20) returns integer.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2969
     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2970
    if ((dVal >= (double)_MIN_INT) && (dVal <= (double)_MAX_INT)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2971
	RETURN ( __mkSmallInteger( (INT) dVal ) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2972
    }
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2973
    __qMKFLOAT(val, dVal);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2974
%}.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  2975
    ^ val asInteger
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2976
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2977
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2978
     0.5 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2979
     -0.5 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2980
     0.5 truncatedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2981
     -0.5 truncatedAsFloat
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2982
    "
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2983
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2984
!
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2985
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2986
truncatedAsFloat
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2987
    "return the receiver truncated towards zero as a float.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2988
     This is much like #truncated, but avoids a (possibly expensive) conversion
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2989
     of the result to an integer.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  2990
     It may be useful, if the result is to be further used in another
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2991
     float-operation."
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2992
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2993
%{  /* NOCONTEXT */
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2994
    double dVal;
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  2995
    OBJ v;
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2996
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2997
    dVal = __floatVal(self);
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2998
    if (dVal < 0.0) {
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  2999
	dVal = ceil(dVal);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3000
    } else {
3127
590c7d2bb4b9 fixes isNAN (on linux); added #isInfinite
Claus Gittinger <cg@exept.de>
parents: 3118
diff changeset
  3001
	dVal = floor(dVal);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3002
    }
3163
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  3003
    __qMKFLOAT(v, dVal);
212a539ee379 added #readFrom: to avoid returning an int.
Claus Gittinger <cg@exept.de>
parents: 3146
diff changeset
  3004
    RETURN (v);
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3005
%}
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3006
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3007
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  3008
     0.5 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  3009
     -0.5 truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  3010
     0.5 truncatedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11926
diff changeset
  3011
     -0.5 truncatedAsFloat
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3012
    "
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3013
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  3014
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  3015
1879
26df273349c4 added ceilingAsFloat, floorAsFloat, truncatedAsFloat
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  3016
!Float class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  3017
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  3018
version
16661
9d23b8a1005d class: Float
Stefan Vogel <sv@exept.de>
parents: 16658
diff changeset
  3019
    ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.200 2014-06-30 14:19:53 stefan Exp $'
12423
a3c777accbb0 changed: #exponent
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  3020
!
a3c777accbb0 changed: #exponent
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  3021
a3c777accbb0 changed: #exponent
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  3022
version_CVS
16661
9d23b8a1005d class: Float
Stefan Vogel <sv@exept.de>
parents: 16658
diff changeset
  3023
    ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.200 2014-06-30 14:19:53 stefan Exp $'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 533
diff changeset
  3024
! !
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6674
diff changeset
  3025
14599
3c1e4683d2f6 class: Float
Stefan Vogel <sv@exept.de>
parents: 14298
diff changeset
  3026
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 2358
diff changeset
  3027
Float initialize!