ShortFloat.st
author Claus Gittinger <cg@exept.de>
Thu, 28 Nov 2019 16:21:35 +0100
changeset 25003 18856dfc86e4
parent 24986 0ba981e902f9
child 25016 cbd04064b803
permissions -rw-r--r--
fmin/fmax
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 1996 by Claus Gittinger
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
     3
	      All Rights Reserved
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
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
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
    14
"{ NameSpace: Smalltalk }"
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
    15
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
LimitedPrecisionReal variableByteSubclass:#ShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:''
21872
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
    18
	classVariableNames:'DefaultPrintFormat DefaultPrintfFormat Pi E Epsilon Ln10 NaN
24949
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
    19
		PositiveInfinity NegativeInfinity Phi Ln2'
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	poolDictionaries:''
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
	category:'Magnitude-Numbers'
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    24
!ShortFloat primitiveDefinitions!
24951
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    25
%{
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    26
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    27
#include <stdio.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    28
#include <errno.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    29
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    30
#ifndef __OPTIMIZE__
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    31
# define __OPTIMIZE__
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    32
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    33
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    34
#define __USE_ISOC9X 1
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    35
#define __USE_ISOC99 1
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    36
#include <math.h>
25003
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
    37
#include <float.h>
24951
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    38
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    39
#ifndef INT32
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    40
# define INT32 int
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    41
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    42
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    43
/*
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    44
 * on some systems errno is a macro ... check for it here
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    45
 */
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    46
#ifndef errno
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    47
 extern errno;
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    48
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    49
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    50
#if !defined (__win32__)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    51
# include <locale.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    52
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    53
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    54
#if defined (__aix__)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    55
# include <float.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    56
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    57
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    58
#if defined(__irix__)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    59
# include <nan.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    60
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    61
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    62
#if defined(__linux__)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    63
# ifndef NAN
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    64
#  include <bits/nan.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    65
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    66
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    67
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    68
#if defined(__solaris__) || defined(__sunos__)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    69
# include <nan.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    70
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    71
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    72
#ifdef __win32__
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    73
/*
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    74
 * no finite(x) ?
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    75
 * no isnan(x) ?
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    76
 */
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    77
# ifndef isnan
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    78
#  define isnan(x)      \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    79
	((((unsigned int *)(&x))[0] == 0x00000000) && \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    80
	 (((unsigned int *)(&x))[1] == 0xFFF80000))
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    81
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    82
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    83
# ifndef isPositiveInfinity
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    84
#  define isPositiveInfinity(x) \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    85
	((((unsigned int *)(&x))[0] == 0x00000000) && \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    86
	 (((unsigned int *)(&x))[1] == 0x7FF00000))
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    87
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    88
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    89
# ifndef isNegativeInfinity
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    90
#  define isNegativeInfinity(x) \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    91
	((((unsigned int *)(&x))[0] == 0x00000000) && \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    92
	 (((unsigned int *)(&x))[1] == 0xFFF00000))
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    93
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    94
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    95
# ifndef isinf
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    96
#  define isinf(x) \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    97
	((((unsigned int *)(&x))[0] == 0x00000000) && \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    98
	 ((((unsigned int *)(&x))[1] & 0x7FF00000) == 0x7FF00000))
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
    99
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   100
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   101
# ifndef isfinite
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   102
#  define isfinite(x) (!isinf(x) && !isnan(x))
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   103
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   104
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   105
# ifndef isnanf
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   106
#  define isnanf(x)      \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   107
	(((unsigned int *)(&x))[0] == 0xFFC00000)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   108
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   109
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   110
# ifndef isPositiveInfinityf
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   111
#  define isPositiveInfinityf(x)      \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   112
	(((unsigned int *)(&x))[0] == 0x7F800000)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   113
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   114
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   115
# ifndef isNegativeInfinityf
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   116
#  define isNegativeInfinityf(x)      \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   117
	(((unsigned int *)(&x))[0] == 0xFF800000)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   118
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   119
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   120
# ifndef isinff
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   121
#  define isinff(x)      \
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   122
	((((unsigned int *)(&x))[0] & 0x7FFFFFFF) == 0x7F800000)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   123
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   124
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   125
# ifndef isfinitef
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   126
#  define isfinitef(x) (!isinff(x) && !isnanf(x))
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   127
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   128
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   129
# define NO_ASINH
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   130
# define NO_ACOSH
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   131
# define NO_ATANH
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   132
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   133
# ifdef __BORLANDC__
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   134
#  define NO_FMODF
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   135
#  define NO_MODFF
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   136
#  define NO_LOG10F
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   137
#  define NO_LOGF
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   138
#  define NO_ABSF
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   139
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   140
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   141
# ifdef __MINGW__
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   142
#  ifndef _STRING_H_INCLUDED_
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   143
#   include <string.h>
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   144
#   define _STRING_H_INCLUDED_
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   145
#  endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   146
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   147
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   148
#endif /* __win32__ */
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   149
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   150
#ifdef __solaris__
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   151
# ifndef isfinite
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   152
#  define isfinite(f) finite((double)(f))
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   153
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   154
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   155
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   156
#ifdef __realIX__
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   157
# ifndef isfinite
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   158
#  define isfinite(x)     1
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   159
# endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   160
#endif /* realIX */
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   161
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   162
#ifndef isfinitef
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   163
# define isfinitef(x) isfinite(x)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   164
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   165
#ifndef isnanf
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   166
# define isnanf(x) isnan(x)
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   167
#endif
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   168
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   169
%}
Claus Gittinger <cg@exept.de>
parents: 24949
diff changeset
   170
! !
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
   171
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   172
!ShortFloat class methodsFor:'documentation'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
copyright
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
 COPYRIGHT (c) 1996 by Claus Gittinger
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   177
	      All Rights Reserved
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
 This software is furnished under a license and may be used
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
 only in accordance with the terms of that license and with the
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
 inclusion of the above copyright notice.   This software may not
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
 be provided or otherwise made available to, or used by, any
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
 other person.  No title to or ownership of the software is
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
 hereby transferred.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
documentation
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
"
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   192
    ShortFloats represent rational numbers with limited precision.
22785
1d67d6adbbe5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22491
diff changeset
   193
    They use the C-compiler's 'float' format, which is usually the IEEE single float format.
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   194
24459
d465826db5b5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24458
diff changeset
   195
    In contrast to Floats (which use the C-compiler's 64bit 'double' format),
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   196
    ShortFloats give you 32 bit floats.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
    Notice, that ST/X Floats are what Doubles are in ST-80 and ShortFloats are
14719
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
   199
    ST-80's Floats respectively. The reason was to make ST/X's floats compatible
24459
d465826db5b5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24458
diff changeset
   200
    to bothe VisualWorks and other Smalltalks, which use C-doubles for the Float class
22785
1d67d6adbbe5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22491
diff changeset
   201
    (i.e. VisualST and V'Age).
14719
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
   202
    Thus, STX's Float precision is not worse than that of other ST's.
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
   203
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
    WARNING:
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   205
	The layout of shortFloat instances is known by the runtime system and the compiler;
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   206
	you may not add instance variables here.
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   207
	Also, subclassing is complicated by the fact, that the VM creates floats/shortFloats,
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   208
	and does some of its float-checks by an identity compare with the ShortFloat-class.
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   209
	(i.e. your subclasses instances may not be recognized as float-like objects,
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   210
	 thus mixed mode arithmetic will always coerce them, effectively slowing things down).
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   211
	This may be changed, to use a flag bit in the class.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   213
    Mixed mode arithmetic:
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   214
	shortFloat op shortFloat   -> shortFloat
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   215
	shortFloat op fix         -> shortFloat
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   216
	shortFloat op fraction    -> shortFloat
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   217
	shortFloat op integer     -> shortFloat
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   218
	shortFloat op longFloat   -> longFloat
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   219
	shortFloat op float       -> float
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   220
	shortFloat op complex     -> complex
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   221
7405
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   222
    Representation:
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   223
	    32bit single precision IEEE floats
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   224
	    23 bit mantissa + 1 hidden bit, providing a precision of 24bits,
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   225
	    8 bit exponent,
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   226
	    6 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
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   229
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   230
    [author:]
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   231
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   232
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   233
    [see also:]
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   234
	Number
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   235
	Float LongFloat Fraction FixedPoint Integer Complex
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   236
	FloatArray DoubleArray
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   240
!ShortFloat class methodsFor:'instance creation'!
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   241
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   242
basicNew
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   243
    "return a new shortFloat - here we return 0.0
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   244
     - shortFloats are usually NOT created this way ...
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   245
     Its implemented here to allow things like binary store & load
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   246
     of shortFloats. (but even this support will go away eventually, its not
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   247
     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: 11924
diff changeset
   248
     totally different representation - so floats will eventually be
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   249
     binary stored in a device independent format."
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   250
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   251
%{  /* NOCONTEXT */
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   252
    OBJ newFloat;
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   253
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
   254
    __qMKSFLOAT(newFloat, 0.0);
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   255
    RETURN (newFloat);
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   256
%}
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   257
!
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   258
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   259
fastFromString:aString at:startIndex
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   260
    "return the next ShortFloat from the string starting at startIndex.
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   261
     No spaces are skipped.
23478
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   262
     Raises an exception, if the startIndex is not valid.
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   263
     Returns garbage if the argument string is not a valid float number.
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   264
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   265
     This is a specially tuned entry (using a low-level C-call to atof).
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   266
     It has been added to allow high speed string decomposition
23478
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   267
     into numbers, especially for mass-data (reading millions of floats)."
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   268
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   269
%{   /* NOCONTEXT */
12486
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
   270
     if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   271
	char *cp = (char *)(__stringVal(aString));
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   272
	int idx = __intVal(startIndex) - 1;
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   273
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   274
	if ((unsigned)idx < __stringSize(aString)) {
24975
fdf3a5b2f6b6 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24964
diff changeset
   275
#ifndef NO_STRTOF
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   276
	    float strtof(const char *, char**);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   277
	    float val = strtof(cp+idx, NULL);
24975
fdf3a5b2f6b6 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24964
diff changeset
   278
#else
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   279
# ifndef NO_STRTOD
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   280
	    double strtod(const char *, char**);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   281
	    double val = strtod(cp+idx, NULL);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   282
# else
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   283
	    double atof(const char *);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   284
	    double val = atof(cp + idx);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   285
# endif
24975
fdf3a5b2f6b6 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24964
diff changeset
   286
#endif
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   287
	    RETURN (__MKSFLOAT(val));
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   288
	}
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   289
     }
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   290
%}.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   291
     self primitiveFailed.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   292
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   293
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   294
     ShortFloat fastFromString:'123.45' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   295
     ShortFloat fastFromString:'123.45' at:2
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   296
     ShortFloat fastFromString:'123.45E4' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   297
     ShortFloat fastFromString:'hello123.45E4' at:6
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   298
     ShortFloat fastFromString:'12345' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   299
     ShortFloat fastFromString:'12345' at:2
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   300
     ShortFloat fastFromString:'12345' at:3
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   301
     ShortFloat fastFromString:'12345' at:4
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   302
     ShortFloat fastFromString:'12345' at:5
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   303
     ShortFloat fastFromString:'12345' at:6
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   304
     ShortFloat fastFromString:'12345' at:0
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   305
     ShortFloat fastFromString:'hello123.45E4' at:1
23478
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   306
    "
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   307
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   308
    "
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   309
     Time millisecondsToRun:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   310
	1000000 timesRepeat:[
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   311
	    ShortFloat readFrom:'123.45'
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   312
	]
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   313
     ]
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   314
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   315
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   316
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   317
     Time millisecondsToRun:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   318
	1000000 timesRepeat:[
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   319
	    ShortFloat fastFromString:'123.45' at:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   320
	]
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   321
     ]
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   322
    "
23475
a7369668089d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22922
diff changeset
   323
23478
33cb7a201308 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23475
diff changeset
   324
    "Modified (comment): / 27-10-2018 / 08:58:13 / Claus Gittinger"
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   325
!
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   326
15015
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   327
fromIEEE32Bit: anInteger
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   328
    "creates a float, given the four native float bytes as an integer"
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   329
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   330
%{  /* NOCONTEXT */
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   331
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   332
    REGISTER union {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   333
	unsigned int    i;
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   334
	float           f;
15015
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   335
    } r;
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   336
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   337
    r.i = __unsignedLongIntVal( anInteger );
15019
63c17b702b7c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 15018
diff changeset
   338
    RETURN( __MKSFLOAT(r.f) );
15015
b86b7390d9ed class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15014
diff changeset
   339
%}
17220
614c3a1d3c73 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16670
diff changeset
   340
614c3a1d3c73 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16670
diff changeset
   341
    "
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   342
	ShortFloat fromIEEE32Bit:(#[64 73 15 219] asInteger)
17220
614c3a1d3c73 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16670
diff changeset
   343
    "
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   344
! !
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   345
12915
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   346
!ShortFloat class methodsFor:'accessing'!
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   347
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   348
defaultPrintFormat
24953
13bc1e8b12ab #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24951
diff changeset
   349
    "/ by default, I will print 7 digits
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   350
    "/  ShortFloat pi   -> 3.141593
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   351
    "/  Float pi        -> 3.14159265358979
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   352
    "/  LongFloat pi    -> 3.141592653589793239
24953
13bc1e8b12ab #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24951
diff changeset
   353
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   354
    ^ DefaultPrintFormat
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   355
!
12915
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   356
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   357
defaultPrintFormat:aString
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   358
    DefaultPrintFormat := aString.
12915
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   359
! !
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   360
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   361
!ShortFloat class methodsFor:'binary storage'!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   362
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   363
readBinaryIEEESingleFrom:aStream
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   364
    "read a float value from the binary stream, aStream,
14924
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   365
     interpreting the next bytes as an IEEE formatted 4-byte float.
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   366
     The bytes are read in the native byte order (i.e.lsb on intel)"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   367
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   368
    |f|
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   369
21878
316b3400a392 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21872
diff changeset
   370
    f := self basicNew.
15012
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   371
    self readBinaryIEEESingleFrom:aStream into:f MSB:(UninterpretedBytes isBigEndian).
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   372
    ^ f
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   373
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   374
    "not part of libboss, as this is also used by others (TIFFReader)"
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   375
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   376
    "Created: / 16-04-1996 / 21:00:35 / cg"
21878
316b3400a392 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21872
diff changeset
   377
    "Modified: / 21-06-2017 / 10:38:31 / cg"
15012
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   378
!
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   379
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   380
readBinaryIEEESingleFrom:aStream MSB:msbFirst
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   381
    "read a float value from the binary stream, aStream,
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   382
     interpreting the next bytes as an IEEE formatted 4-byte float.
15014
f3fb1faff91f class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15012
diff changeset
   383
     The bytes are read in the soecified byte order"
15012
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   384
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   385
    |f|
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   386
21878
316b3400a392 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21872
diff changeset
   387
    f := self basicNew.
15012
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
   388
    self readBinaryIEEESingleFrom:aStream into:f MSB:msbFirst.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   389
    ^ f
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   390
9636
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   391
    "not part of libboss, as this is also used by others (TIFFReader)"
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   392
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   393
    "Created: / 16-04-1996 / 21:00:35 / cg"
21878
316b3400a392 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21872
diff changeset
   394
    "Modified: / 21-06-2017 / 10:38:35 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   395
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   396
19617
9ba857aed07d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19570
diff changeset
   397
readBinaryIEEESingleFrom:aStream into:aBasicNewShortFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   398
    "read a float value from the binary stream, aStream,
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   399
     interpreting the next bytes as an IEEE formatted 4-byte float.
14924
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   400
     The bytes are read in the native byte order (i.e.lsb on intel)"
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   401
19617
9ba857aed07d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19570
diff changeset
   402
    ^ self readBinaryIEEESingleFrom:aStream into:aBasicNewShortFloat MSB:(UninterpretedBytes isBigEndian)
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   403
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   404
    "Modified: / 23-08-2006 / 16:01:52 / cg"
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   405
!
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   406
19617
9ba857aed07d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19570
diff changeset
   407
readBinaryIEEESingleFrom:aStream into:aBasicNewShortFloat MSB:msb
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   408
    "read a float value from the binary stream, aStream,
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   409
     interpreting the next bytes as an IEEE formatted 4-byte float.
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   410
     If msb is true, the stream bytes are most-significant-first."
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   411
21878
316b3400a392 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21872
diff changeset
   412
    aBasicNewShortFloat class == self ifFalse:[self error:'not a ShortFloat'].
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   413
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   414
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   415
     this implementation is wrong: does not work on non-IEEE machines
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   416
     (to date all machines where ST/X is running on use
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   417
      IEEE float format. Need more here, when porting ST/X to 370's)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   418
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   419
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   420
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   421
    (UninterpretedBytes isBigEndian == msb) ifFalse:[
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
   422
	"swap the bytes"
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
   423
	4 to:1 by:-1 do:[:i |
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
   424
	    aBasicNewShortFloat basicAt:i put:(aStream next)
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
   425
	].
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
   426
	^ self
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   427
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   428
    1 to:4 do:[:i |
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
   429
	aBasicNewShortFloat basicAt:i put:aStream next
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   430
    ]
9636
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   431
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   432
    "not part of libboss, as this is also used by others (TIFFReader)"
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   433
21878
316b3400a392 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21872
diff changeset
   434
    "Modified: / 21-06-2017 / 10:36:28 / cg"
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   435
!
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   436
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   437
storeBinaryIEEESingle:aFloat on:aStream
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   438
    "store aFloat as an IEEE formatted 4-byte float
14924
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   439
     onto the binary stream, aStream.
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   440
     The bytes are written in the native byte order (i.e.lsb on intel)"
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   441
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   442
    self storeBinaryIEEESingle:aFloat on:aStream MSB:(UninterpretedBytes isBigEndian).
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   443
!
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   444
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   445
storeBinaryIEEESingle:aFloat on:aStream MSB:msb
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   446
    "store aFloat as an IEEE formatted 4-byte float
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   447
     onto the binary stream, aStream.
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   448
     If msb is true, the stream bytes are written most-significant-first."
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   449
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   450
    |float|
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   451
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   452
    float := aFloat asShortFloat.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   453
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   454
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   455
     this implementation is wrong: does not work on non-IEEE machines
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   456
     (to date all machines where ST/X is running on use
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   457
      IEEE float format. Need more here, when porting ST/X to 370's)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   458
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   459
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   460
14924
7115c6830ed8 allow saving in msb
Claus Gittinger <cg@exept.de>
parents: 14922
diff changeset
   461
    (UninterpretedBytes isBigEndian == msb) ifFalse:[
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14924
diff changeset
   462
	"swap the bytes"
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14924
diff changeset
   463
	4 to:1 by:-1 do:[:i |
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14924
diff changeset
   464
	    aStream nextPut:(float basicAt:i).
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14924
diff changeset
   465
	].
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14924
diff changeset
   466
	^ self
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   467
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   468
    1 to:4 do:[:i |
14931
0de2fc03f23a mingw fixes
Claus Gittinger <cg@exept.de>
parents: 14924
diff changeset
   469
	aStream nextPut:(float basicAt:i).
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   470
    ]
9636
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   471
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   472
    "not part of libboss, as this is also used by others (TIFFReader)"
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   473
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   474
    "Modified: / 23-08-2006 / 16:01:55 / cg"
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   475
! !
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   476
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   477
!ShortFloat class methodsFor:'class initialization'!
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   478
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   479
initialize
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   480
    DefaultPrintFormat := '.7'.  "/ print 7 valid digits
21868
f568817ef1d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21858
diff changeset
   481
    DefaultPrintfFormat := '%7f'.
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   482
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   483
    "
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   484
     self initialize
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   485
    "
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   486
! !
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
   487
21872
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   488
!ShortFloat class methodsFor:'coercing & converting'!
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   489
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   490
coerce:aNumber
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   491
    "convert the argument aNumber into an instance of the receiver's class and return it."
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   492
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   493
    ^ aNumber asShortFloat.
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   494
! !
873afa36c013 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21869
diff changeset
   495
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   496
!ShortFloat class methodsFor:'constants'!
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   497
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   498
NaN
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   499
    "return a shortFloat which represents not-a-Number (i.e. an invalid number)"
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   500
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   501
    NaN isNil ifTrue:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   502
	NaN := super NaN
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   503
    ].
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   504
    ^ NaN
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   505
24261
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   506
    "
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   507
     self NaN
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   508
    "
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   509
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   510
    "Created: / 20-06-2017 / 13:44:12 / cg"
24261
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   511
    "Modified (comment): / 06-06-2019 / 16:53:34 / Claus Gittinger"
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   512
!
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   513
7392
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   514
e
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   515
    "return the constant e as ShortFloat"
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   516
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   517
    E isNil ifTrue:[
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   518
	E := Float e asShortFloat
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   519
    ].
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   520
    ^ E
7392
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   521
!
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   522
24964
0236232a98e1 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24953
diff changeset
   523
eBias
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   524
    "Answer the exponent's bias;
24964
0236232a98e1 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24953
diff changeset
   525
     that is the offset of the zero exponent when stored"
0236232a98e1 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24953
diff changeset
   526
0236232a98e1 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24953
diff changeset
   527
    ^ 127
0236232a98e1 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24953
diff changeset
   528
!
0236232a98e1 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24953
diff changeset
   529
18128
ceba88f4f3f7 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18126
diff changeset
   530
emax
ceba88f4f3f7 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18126
diff changeset
   531
    "Answer the maximum exponent for this representation."
ceba88f4f3f7 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18126
diff changeset
   532
ceba88f4f3f7 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18126
diff changeset
   533
    ^127
ceba88f4f3f7 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18126
diff changeset
   534
!
ceba88f4f3f7 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18126
diff changeset
   535
18130
c014af8129f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18128
diff changeset
   536
emin
c014af8129f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18128
diff changeset
   537
    "Answer the minimum exponent for this representation."
c014af8129f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18128
diff changeset
   538
c014af8129f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18128
diff changeset
   539
    ^-126
c014af8129f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18128
diff changeset
   540
!
c014af8129f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18128
diff changeset
   541
25003
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   542
fmin
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   543
%{
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   544
    RETURN(__MKFLOAT(FLT_MIN));
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   545
%}.
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   546
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   547
    "
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   548
     ShortFloat fmin
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   549
    "
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   550
!
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   551
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   552
fmax
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   553
%{
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   554
    RETURN(__MKFLOAT(FLT_MAX));
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   555
%}.
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   556
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   557
    "
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   558
     ShortFloat fmax
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   559
    "
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   560
!
18856dfc86e4 fmin/fmax
Claus Gittinger <cg@exept.de>
parents: 24986
diff changeset
   561
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   562
infinity
24293
758f8a1703cc #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24284
diff changeset
   563
    "return a shortFloat which represents positive infinity (for my instances)"
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   564
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   565
    PositiveInfinity isNil ifTrue:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   566
	PositiveInfinity := Float infinity asShortFloat
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   567
    ].
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   568
    ^ PositiveInfinity
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   569
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   570
    "Created: / 20-06-2017 / 13:44:45 / cg"
24293
758f8a1703cc #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24284
diff changeset
   571
    "Modified (comment): / 08-06-2019 / 14:32:27 / Claus Gittinger"
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   572
!
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   573
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   574
ln10
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   575
    "return the natural logarithm of 10 as a shortFloat"
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   576
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   577
    Ln10 isNil ifTrue:[
21834
1fe471f18a2e oops - no log10f under win32
Claus Gittinger <cg@exept.de>
parents: 21829
diff changeset
   578
	Ln10 := Float ln10 asShortFloat
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   579
    ].
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   580
    ^ Ln10
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   581
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   582
    "
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   583
     self ln10
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   584
    "
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   585
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   586
    "Created: / 16-06-2017 / 11:09:37 / cg"
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   587
!
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   588
24949
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   589
ln2
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   590
    "return the natural logarithm of 2 as a shortFloat"
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   591
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   592
    Ln2 isNil ifTrue:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   593
	Ln2 := Float ln2 asShortFloat
24949
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   594
    ].
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   595
    ^ Ln2
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   596
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   597
    "
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   598
     self ln2
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   599
    "
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   600
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   601
    "Created: / 16-06-2017 / 11:09:37 / cg"
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   602
!
e83292eea636 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24947
diff changeset
   603
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   604
negativeInfinity
24303
8a479a66cb74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24293
diff changeset
   605
    "return a shortFloat which represents negative infinity (for my instances).
8a479a66cb74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24293
diff changeset
   606
     Warning: do not compare equal against infinities;
8a479a66cb74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24293
diff changeset
   607
     instead, check using isFinite or isInfinite"
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   608
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   609
    NegativeInfinity isNil ifTrue:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   610
	NegativeInfinity := Float negativeInfinity asShortFloat
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   611
    ].
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   612
    ^ NegativeInfinity
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   613
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   614
    "Created: / 20-06-2017 / 13:45:08 / cg"
24303
8a479a66cb74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24293
diff changeset
   615
    "Modified (comment): / 09-06-2019 / 12:57:11 / Claus Gittinger"
21858
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   616
!
5ae229caf43e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21850
diff changeset
   617
24933
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   618
phi
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   619
    "return the constant phi as ShortFloat"
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   620
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   621
    Phi isNil ifTrue:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   622
	Phi := Float phi asShortFloat
24933
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   623
    ].
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   624
    ^ Phi
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   625
!
13f40732617d #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24701
diff changeset
   626
7392
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   627
pi
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   628
    "return the constant pi as ShortFloat"
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   629
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   630
    Pi isNil ifTrue:[
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   631
	Pi := Float pi asShortFloat
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   632
    ].
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   633
    ^ Pi
7392
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   634
!
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   635
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   636
unity
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   637
    "return the neutral element for multiplication (1.0) as ShortFloat"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   638
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   639
    ^ 1.0 asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   641
    "Modified: 23.4.1996 / 09:26:51 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   642
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   644
zero
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   645
    "return the neutral element for addition (0.0) as ShortFloat"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   646
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   647
    ^ 0.0 asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   648
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   649
    "Modified: 23.4.1996 / 09:26:45 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   650
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   651
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   652
!ShortFloat class methodsFor:'queries'!
21149
b8ceb5aff633 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 20706
diff changeset
   653
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   654
defaultPrintPrecision
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   655
    "return the number of decimal digits printed by default"
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   656
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   657
    ^ 5
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   658
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   659
    "
21834
1fe471f18a2e oops - no log10f under win32
Claus Gittinger <cg@exept.de>
parents: 21829
diff changeset
   660
     ShortFloat defaultPrintPrecision
1fe471f18a2e oops - no log10f under win32
Claus Gittinger <cg@exept.de>
parents: 21829
diff changeset
   661
     Float defaultPrintPrecision
1fe471f18a2e oops - no log10f under win32
Claus Gittinger <cg@exept.de>
parents: 21829
diff changeset
   662
     LongFloat defaultPrintPrecision
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   663
    "
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   664
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   665
    "Created: / 17-06-2017 / 02:59:31 / cg"
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
   666
!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   667
24323
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   668
epsilon
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   669
    "return the maximum relative spacing of instances of mySelf
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   670
     (i.e. the value-delta of the least significant bit)"
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   671
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   672
    Epsilon isNil ifTrue:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   673
	Epsilon := self computeEpsilon.
24323
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   674
    ].
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   675
    ^ Epsilon
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   676
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   677
    "
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   678
     self epsilon
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   679
    "
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   680
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   681
    "Modified (comment): / 21-06-2017 / 13:56:47 / cg"
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   682
    "Modified (comment): / 10-05-2018 / 01:09:13 / stefan"
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   683
    "Modified (comment): / 10-06-2019 / 21:22:03 / Claus Gittinger"
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   684
!
e42ad2030cf5 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24303
diff changeset
   685
6898
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   686
exponentCharacter
24324
cbecbcd80faf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24323
diff changeset
   687
    "return the character used to print between mantissa an exponent.
cbecbcd80faf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24323
diff changeset
   688
     Also used by the scanner when reading numbers."
cbecbcd80faf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24323
diff changeset
   689
6898
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   690
    ^ $e
24324
cbecbcd80faf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24323
diff changeset
   691
cbecbcd80faf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24323
diff changeset
   692
    "Modified (comment): / 10-06-2019 / 21:27:52 / Claus Gittinger"
6898
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   693
!
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   694
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   695
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   696
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   697
     Here, true is returned for myself, false for subclasses."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
    ^ self == ShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   701
    "Modified: 23.4.1996 / 16:00:23 / cg"
3427
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   702
!
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   703
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   704
numBitsInExponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   705
    "answer the number of bits in the exponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   706
     This is an IEEE float, where 8 bits are available:
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
   707
	seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   708
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   709
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   710
    ^ 8
24204
673f36f5844d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24189
diff changeset
   711
673f36f5844d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24189
diff changeset
   712
    "
673f36f5844d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24189
diff changeset
   713
     1.0 asShortFloat numBitsInExponent
673f36f5844d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24189
diff changeset
   714
    "
673f36f5844d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24189
diff changeset
   715
673f36f5844d #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24189
diff changeset
   716
    "Modified (comment): / 28-05-2019 / 08:55:35 / Claus Gittinger"
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   717
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   718
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   719
numBitsInMantissa
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   720
    "answer the number of bits in the mantissa.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   721
     This is an IEEE float, where 23 bits (the hidden one is not counted here) are available:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   722
	seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   723
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   724
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   725
    ^ 23
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   726
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   727
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   728
precision
24261
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   729
    "answer the precision (the number of bits in the mantissa) of a ShortFloat (in bits)
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   730
     This is an IEEE float, where only the fraction from the normalized mantissa is stored
9149
3fb15c4d83d8 comment
Claus Gittinger <cg@exept.de>
parents: 9121
diff changeset
   731
     and so there is a hidden bit and the mantissa is actually represented by 24 binary digits
3fb15c4d83d8 comment
Claus Gittinger <cg@exept.de>
parents: 9121
diff changeset
   732
     (although only 23 are needed in the binary representation)"
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   733
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   734
    ^  24
19325
a7285364ffb1 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18852
diff changeset
   735
a7285364ffb1 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18852
diff changeset
   736
    "
a7285364ffb1 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18852
diff changeset
   737
     self numBitsInMantissa + 1
a7285364ffb1 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18852
diff changeset
   738
     self precision
a7285364ffb1 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18852
diff changeset
   739
    "
24261
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   740
471fee9a83c6 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24204
diff changeset
   741
    "Modified (comment): / 06-06-2019 / 13:23:53 / Claus Gittinger"
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   742
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   743
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   744
radix
24439
2701503c110a #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24330
diff changeset
   745
    "answer the radix of a ShortFloat's exponent
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   746
     This is an IEEE float, which is represented as binary"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   747
9149
3fb15c4d83d8 comment
Claus Gittinger <cg@exept.de>
parents: 9121
diff changeset
   748
    ^ 2 "must be careful here, whenever ST/X is used on a VAX or a 370"
24439
2701503c110a #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24330
diff changeset
   749
2701503c110a #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24330
diff changeset
   750
    "Modified (comment): / 19-07-2019 / 17:28:40 / Claus Gittinger"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
!ShortFloat methodsFor:'arithmetic'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   755
* aNumber
11730
eabe6364c89b comment
Claus Gittinger <cg@exept.de>
parents: 11720
diff changeset
   756
    "return the product of the receiver and the argument."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   765
	result = __shortFloatVal(self) * (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   767
	__qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   768
	RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   769
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   770
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   771
	result = __shortFloatVal(self) * __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   772
	goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   773
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   774
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   775
	dResult = (double) __shortFloatVal(self)* __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   776
	__qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   777
	RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   779
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
    ^ aNumber productFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   781
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   782
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   783
+ aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
    "return the sum of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   788
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   789
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   790
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   791
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   792
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   793
	result = __shortFloatVal(self) + (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   795
	__qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   796
	RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   797
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   798
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   799
	result = __shortFloatVal(self) + __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   800
	goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   801
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   802
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   803
	dResult = (double) __shortFloatVal(self) + __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   804
	__qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   805
	RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   806
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   807
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   808
    ^ aNumber sumFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   809
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   810
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   811
- aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   812
    "return the difference of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   813
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   814
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   815
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   816
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   817
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   818
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   819
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   820
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   821
	result = __shortFloatVal(self) - (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   822
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   823
	__qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   824
	RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   825
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   826
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   827
	result = __shortFloatVal(self) - __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   828
	goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   829
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   830
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   831
	dResult = (double) __shortFloatVal(self) - __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   832
	__qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   833
	RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   834
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   835
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   836
    ^ aNumber differenceFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
/ aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   840
    "return the quotient of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   842
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
    float result, val;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
    double dResult, dVal;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   849
	if (aNumber != __mkSmallInteger(0)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   850
	    result = __shortFloatVal(self) / (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   852
	    __qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   853
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   854
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   855
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   856
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   857
	val = __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   858
	if (val != 0.0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   859
	    result = __shortFloatVal(self) / val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   860
	    goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   861
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   862
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   863
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   864
	dVal = __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   865
	if (dVal != 0.0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   866
	    dResult = (double) __shortFloatVal(self) / dVal;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   867
	    __qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   868
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   869
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   870
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   871
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   872
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   873
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   874
	 No, you shalt not divide by zero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   875
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   876
	^ ZeroDivide raiseRequestWith:thisContext.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   877
    ].
4166
5730ad6b744b oops - from coercion in quotient / uncheckedQuotient
Claus Gittinger <cg@exept.de>
parents: 4100
diff changeset
   878
    ^ aNumber quotientFromShortFloat:self
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   879
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
14710
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   881
abs
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   882
    "return the absolute value of the receiver
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   883
     reimplemented here for speed"
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   884
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   885
%{  /* NOCONTEXT */
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   886
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   887
    OBJ newFloat;
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   888
    float val = __shortFloatVal(self);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   889
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   890
    if (val < 0.0) {
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   891
	__qMKSFLOAT(newFloat, -val);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   892
	RETURN ( newFloat );
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   893
    }
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   894
    RETURN (self);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   895
%}.
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   896
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   897
    "
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   898
     3.0 asShortFloat abs
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   899
     -3.0 asShortFloat abs
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   900
    "
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   901
!
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   902
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   903
negated
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   904
    "return myself negated"
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   905
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   906
%{  /* NOCONTEXT */
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   907
    OBJ newFloat;
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   908
    float rslt = - __shortFloatVal(self);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   909
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   910
    __qMKSFLOAT(newFloat, rslt);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   911
    RETURN ( newFloat );
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   912
%}.
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   913
    ^ 0.0 - self
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   914
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   915
!
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   916
14690
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   917
rem: aNumber
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   918
    "return the floating point remainder of the receiver and the argument, aNumber"
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   919
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   920
%{  /* NOCONTEXT */
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   921
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   922
    /*
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   923
     * notice:
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   924
     * the following inline code handles some common cases,
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   925
     * and exists as an optimization, to speed up those cases.
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   926
     *
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   927
     * Conceptionally, (and for most other argument types),
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   928
     * mixed arithmetic is implemented by double dispatching
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   929
     * (see the message send at the bottom)
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   930
     */
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   931
    OBJ newFloat;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   932
    float result, val;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   933
    double dResult, dVal;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   934
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   935
    if (__isSmallInteger(aNumber)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   936
	if (aNumber != __mkSmallInteger(0)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   937
	    val = (float)__intVal(aNumber);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   938
computeResult:
14709
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   939
#ifdef NO_FMODF
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   940
	    dResult = fmod((double)__shortFloatVal(self), (double)val) ;
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   941
	    result = (float)dResult;
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   942
#else
14690
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   943
	    result = fmodf(__shortFloatVal(self), val) ;
14709
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   944
#endif
14690
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   945
	    __qMKSFLOAT(newFloat, result);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   946
	    RETURN ( newFloat );
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   947
	}
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   948
    } else if (__isFloatLike(aNumber)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   949
	dVal = __floatVal(aNumber);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   950
	if (dVal != 0.0) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   951
	    dResult = fmod((double)(__shortFloatVal(self)), dVal) ;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   952
	    __qMKFLOAT(newFloat, dResult);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   953
	    RETURN ( newFloat );
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   954
	}
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   955
    } else if (__isShortFloat(aNumber)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   956
	val = __shortFloatVal(aNumber);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   957
	if (val != 0.0) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   958
	    goto computeResult;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   959
	}
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   960
    }
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   961
%}.
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   962
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   963
	"
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   964
	 No, you shalt not divide by zero
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   965
	"
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   966
	^ ZeroDivide raiseRequestWith:thisContext.
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   967
    ].
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   968
    ^ aNumber remainderFromShortFloat:self
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   969
!
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   970
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   971
uncheckedDivide:aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   972
    "return the quotient of the receiver and the argument, aNumber.
7471
c5d4bd612d9f comments
Claus Gittinger <cg@exept.de>
parents: 7437
diff changeset
   973
     Do not check for divide by zero (return NaN or Infinity).
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   974
     This operation is provided for emulators of other languages/semantics,
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   975
     where no exception is raised for these results (i.e. Java).
18841
0578521d1cea #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18139
diff changeset
   976
     It is only defined if the argument's type is the same as the receiver's."
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   977
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   978
%{  /* NOCONTEXT */
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   979
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   980
    OBJ newFloat;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   981
    float result, val;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   982
    double dResult, dVal;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   983
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   984
    if (__isSmallInteger(aNumber)) {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   985
	result = __shortFloatVal(self) / (float)(__intVal(aNumber));
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   986
retResult:
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   987
	__qMKSFLOAT(newFloat, result);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   988
	RETURN ( newFloat );
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   989
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   990
    if (__isShortFloat(aNumber)) {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   991
	val = __shortFloatVal(aNumber);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   992
	result = __shortFloatVal(self) / val;
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   993
	goto retResult;
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   994
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   995
    if (__isFloatLike(aNumber)) {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   996
	dVal = __floatVal(aNumber);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   997
	dResult = (double) __shortFloatVal(self) / dVal;
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   998
	__qMKFLOAT(newFloat, dResult);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
   999
	RETURN ( newFloat );
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1000
    }
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1001
%}.
4166
5730ad6b744b oops - from coercion in quotient / uncheckedQuotient
Claus Gittinger <cg@exept.de>
parents: 4100
diff changeset
  1002
    ^ aNumber quotientFromShortFloat:self
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1003
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1004
    "
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1005
      0.0 asShortFloat uncheckedDivide:0
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1006
      1.0 asShortFloat uncheckedDivide:0.0
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1007
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1008
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1009
5257
a90fd9cb3c18 category rename
Claus Gittinger <cg@exept.de>
parents: 5120
diff changeset
  1010
!ShortFloat methodsFor:'coercing & converting'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1011
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1012
asFloat
11238
f321de80643a comment
Claus Gittinger <cg@exept.de>
parents: 9896
diff changeset
  1013
    "return a Float with same value as the receiver.
f321de80643a comment
Claus Gittinger <cg@exept.de>
parents: 9896
diff changeset
  1014
     Redefined for performance (machine can do it faster)"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1015
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1016
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1017
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1018
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1019
    double dVal = (double)__shortFloatVal(self);
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1020
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
  1021
    __qMKFLOAT(newFloat, dVal);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1022
    RETURN ( newFloat );
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1023
%}
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1024
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1025
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1026
     1.0 asShortFloat asFloat
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1027
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1028
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1029
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1030
asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1031
    "return an integer with same value - might truncate"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1032
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1033
%{  /* NOCONTEXT */
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1583
diff changeset
  1034
    float fVal;
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1035
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1583
diff changeset
  1036
    fVal = __shortFloatVal(self);
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19617
diff changeset
  1037
#ifdef __win32__
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1038
    if (! isnanf(fVal))
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
  1039
#endif
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
  1040
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1041
	if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1042
	    RETURN ( __mkSmallInteger( (INT)fVal) );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1043
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1044
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1045
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1046
    ^ super asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1047
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1048
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1049
     12345.0 asShortFloat asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1050
     1e15 asShortFloat asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1051
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1052
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1053
7437
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
  1054
asLongFloat
21891
e697cc4bbc7c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21878
diff changeset
  1055
    "return a LongFloat with same value as the receiver"
e697cc4bbc7c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21878
diff changeset
  1056
7437
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
  1057
    ^ LongFloat fromShortFloat:self
21891
e697cc4bbc7c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21878
diff changeset
  1058
e697cc4bbc7c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21878
diff changeset
  1059
    "Modified (comment): / 21-06-2017 / 13:59:41 / cg"
7437
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
  1060
!
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
  1061
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1062
asShortFloat
15022
4db3a134deb9 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 15019
diff changeset
  1063
    "return a ShortFloat with same value as the receiver - that's me"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1064
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1065
    ^ self
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1066
!
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1067
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1068
coerce:aNumber
18841
0578521d1cea #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18139
diff changeset
  1069
    "convert the argument aNumber into an instance of the receiver's class and return it."
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1070
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1071
    ^ aNumber asShortFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1072
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1073
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1074
generality
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1075
    "return the generality value - see ArithmeticValue>>retry:coercing:"
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1076
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1077
    ^ 70
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1078
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1079
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1080
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1081
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1082
!ShortFloat methodsFor:'comparing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1083
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1084
< aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1085
    "return true, if the argument is greater"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1086
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1087
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1088
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1089
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1090
	RETURN ( (__shortFloatVal(self) < (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1091
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1092
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1093
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1094
	    RETURN ( (double)(__shortFloatVal(self) < __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1095
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1096
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1097
	    RETURN ( (__shortFloatVal(self) < __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1098
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1099
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1100
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1101
    ^ aNumber lessFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1102
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1103
    "
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1104
     1.0 asShortFloat > (1/3)
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
  1105
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1106
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1107
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1108
<= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1109
    "return true, if the argument is greater or equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1110
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1111
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1112
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1113
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1114
	RETURN ( (__shortFloatVal(self) <= (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1115
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1116
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1117
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1118
	    RETURN ( (double)(__shortFloatVal(self) <= __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1119
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1120
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1121
	    RETURN ( (__shortFloatVal(self) <= __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1122
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1123
    }
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1124
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1125
    ^ self retry:#<= coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1126
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1127
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1128
= aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1129
    "return true, if the argument represents the same numeric value
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1130
     as the receiver, false otherwise"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1131
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1132
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1133
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1134
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1135
	RETURN ( (__shortFloatVal(self) == (float)(__intVal(aNumber))) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1136
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1137
    if (aNumber == nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1138
	RETURN (false);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1139
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1140
    if (__qIsFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1141
	RETURN ( (double)(__shortFloatVal(self) == __floatVal(aNumber)) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1142
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1143
    if (__qIsShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1144
	RETURN ( (__shortFloatVal(self) == __shortFloatVal(aNumber)) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1145
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1146
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1147
    ^ aNumber equalFromShortFloat:self
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1148
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1149
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1150
> aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1151
    "return true, if the argument is less"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1152
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1153
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1154
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1155
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1156
	RETURN ( (__shortFloatVal(self) > (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1157
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1158
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1159
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1160
	    RETURN ( (double)(__shortFloatVal(self) > __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1161
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1162
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1163
	    RETURN ( (__shortFloatVal(self) > __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1164
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1165
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1166
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1167
    ^ self retry:#> coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1168
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1169
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1170
>= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1171
    "return true, if the argument is less or equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1172
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1173
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1174
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1175
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1176
	RETURN ( (__shortFloatVal(self) >= (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1177
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1178
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1179
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1180
	    RETURN ( (double)(__shortFloatVal(self) >= __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1181
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1182
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1183
	    RETURN ( (__shortFloatVal(self) >= __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1184
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1185
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1186
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1187
    ^ self retry:#>= coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1188
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1189
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1190
hash
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1191
    "return a number for hashing; redefined, since floats compare
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1192
     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
  1193
     as 3 hash."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1194
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1195
    |i|
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1196
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1197
    (self >= SmallInteger minVal and:[self <= SmallInteger maxVal]) ifTrue:[
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  1198
	i := self asInteger.
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  1199
	self = i ifTrue:[
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  1200
	    ^ i hash
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  1201
	].
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1202
    ].
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1203
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
  1204
    ^ self asFloat hash
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1205
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1206
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1207
     1.2345 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1208
     1.2345 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1209
     1.0 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1210
     1.0 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1211
     0.5 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1212
     0.25 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1213
     0.5 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1214
     0.25 hash
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1215
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1216
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1217
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1218
isAlmostEqualTo:aNumber nEpsilon:nE
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1219
    "return true, if the argument, aNumber represents almost the same numeric value
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1220
     as the receiver, false otherwise.
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1221
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1222
     nE is the number of minimal float distances, that the numbers may differ and
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1223
     still be considered equal.
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1224
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1225
     For background information why floats need this
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1226
     read: http://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1227
    "
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1228
21149
b8ceb5aff633 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 20706
diff changeset
  1229
    Epsilon isNil ifTrue:[
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1230
	Epsilon := self class computeEpsilon.
21149
b8ceb5aff633 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 20706
diff changeset
  1231
    ].
b8ceb5aff633 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 20706
diff changeset
  1232
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1233
%{  /* NOCONTEXT */
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1234
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1235
    /*
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1236
     * notice:
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1237
     * the following inline code handles some common cases,
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1238
     * and exists as an optimization, to speed up those cases.
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1239
     *
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1240
     * Conceptionally, (and for most other argument types),
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1241
     * mixed arithmetic is implemented by double dispatching
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1242
     * (see the message send at the bottom)
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1243
     */
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1244
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1245
    INT32 ulpDiff;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1246
    union {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1247
	float f;
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1248
	INT32 i;
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1249
    } myself, otherFloat;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1250
    int nEpsilon;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1251
    float scaledEpsilon;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1252
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1253
    if (!__isSmallInteger(nE)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1254
	goto tryHarder;
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1255
    }
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1256
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1257
    nEpsilon =  __intVal(nE);
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1258
    scaledEpsilon = nEpsilon *__shortFloatVal(@global(Epsilon));
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1259
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1260
    if (__isSmallInteger(aNumber)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1261
	otherFloat.f = (float)(__intVal(aNumber));
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1262
    } else if (aNumber == nil) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1263
	RETURN(false)
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1264
    } else if (__qIsFloatLike(aNumber)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1265
	otherFloat.f = (float)(__floatVal(aNumber));
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1266
    } else if (__qIsShortFloat(aNumber)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1267
	otherFloat.f = __shortFloatVal(aNumber);
22853
a0380f086736 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22788
diff changeset
  1268
//    } else if (__qIsLongFloat(aNumber)) {
a0380f086736 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22788
diff changeset
  1269
//        otherFloat.f = (float)(__longFloatVal(aNumber));
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1270
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1271
	goto tryHarder;
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1272
    }
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1273
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1274
    myself.f = __shortFloatVal(self);
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1275
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1276
    // Check if the numbers are really close -- needed
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1277
    // when comparing numbers near zero (ULP method below fails for numbers near 0!).
22919
1f77f065b31e fix for borland
Claus Gittinger <cg@exept.de>
parents: 22853
diff changeset
  1278
# ifdef NO_ABSF
22920
ab4f159ef843 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 22919
diff changeset
  1279
    if (fabs((double)(myself.f - otherFloat.f)) <= scaledEpsilon) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1280
	RETURN(true);
22919
1f77f065b31e fix for borland
Claus Gittinger <cg@exept.de>
parents: 22853
diff changeset
  1281
    }
1f77f065b31e fix for borland
Claus Gittinger <cg@exept.de>
parents: 22853
diff changeset
  1282
# else
22853
a0380f086736 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22788
diff changeset
  1283
    // fprintf(stderr, "%.10f %.10f\n", fabsf(myself.f - otherFloat.f), scaledEpsilon);
a0380f086736 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22788
diff changeset
  1284
    if (fabsf(myself.f - otherFloat.f) <= scaledEpsilon) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1285
	RETURN(true);
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1286
    }
22919
1f77f065b31e fix for borland
Claus Gittinger <cg@exept.de>
parents: 22853
diff changeset
  1287
#endif
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1288
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1289
    // if the signs differ, the numbers are different
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1290
    if ((myself.f >= 0) != (otherFloat.f >= 0)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1291
	RETURN(false);
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1292
    }
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1293
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1294
    // compute the difference of the 'units in the last place" ULP
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1295
    // (if ulpDiff == 1, two floats are adjecant)
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1296
    ulpDiff = myself.i - otherFloat.i;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1297
    if (ulpDiff < 0) ulpDiff = -ulpDiff;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1298
    if (ulpDiff <= nEpsilon) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1299
	RETURN(true);
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1300
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1301
	RETURN(false)
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1302
    }
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1303
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1304
tryHarder:;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1305
%}.
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1306
    ^ aNumber isAlmostEqualToFromShortFloat:self nEpsilon:nE
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1307
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1308
    "
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1309
	67329.234 asShortFloat isAlmostEqualTo:67329.23401 asShortFloat nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1310
	1.0 asShortFloat isAlmostEqualTo:1.0000001 asShortFloat nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1311
	1.0 asShortFloat isAlmostEqualTo:1.0000001  nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1312
	1.0 asShortFloat isAlmostEqualTo:-1.0 nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1313
	1.0 asShortFloat isAlmostEqualTo:1 nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1314
	0.0 asShortFloat isAlmostEqualTo:0.0000001 asShortFloat nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1315
	0.0 asShortFloat isAlmostEqualTo:0.000001 asShortFloat nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1316
	0.0 asShortFloat isAlmostEqualTo:self epsilon nEpsilon:1
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1317
	0.0 asShortFloat - 1.192093e-07 asShortFloat
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1318
    "
22853
a0380f086736 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22788
diff changeset
  1319
a0380f086736 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22788
diff changeset
  1320
    "Modified: / 10-05-2018 / 00:47:22 / stefan"
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1321
!
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1322
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1323
~= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1324
    "return true, if the arguments value are not equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1325
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1326
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1327
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1328
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1329
	if (__isSmallInteger(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1330
	    RETURN ( (__shortFloatVal(self) != (float)(__intVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1331
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1332
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1333
	    RETURN ( (double)(__shortFloatVal(self) !=  __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1334
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1335
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1336
	    RETURN ( (__shortFloatVal(self) !=  __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1337
	}
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1338
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1339
	RETURN ( true );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1340
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1341
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1342
    ^ super ~= aNumber
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1343
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1344
24189
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1345
!ShortFloat methodsFor:'copying'!
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1346
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1347
deepCopy
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1348
    "return a deep copy of myself
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1349
     - because storing into floats is not recommended/allowed, its ok to return the receiver"
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1350
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1351
    ^ self
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1352
!
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1353
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1354
deepCopyUsing:aDictionary postCopySelector:postCopySelector
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1355
    "return a deep copy of myself
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1356
     - because storing into floats is not recommended/allowed, its ok to return the receiver"
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1357
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1358
    ^ self
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1359
!
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1360
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1361
shallowCopy
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1362
    "return a shallow copy of the receiver"
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1363
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1364
    ^ self
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1365
!
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1366
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1367
simpleDeepCopy
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1368
    "return a deep copy of the receiver
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1369
     - because storing into floats is not recommended/allowed, its ok to return the receiver"
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1370
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1371
    ^ self
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1372
! !
51e1451f72fd #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 24150
diff changeset
  1373
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1374
!ShortFloat methodsFor:'mathematical functions'!
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1375
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1376
fastInverseSqrt
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1377
    "return a rough but fast approximation of (1 / self sqrt).
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1378
     The error is some 1%, which is ok for many 3D computations or physics simulations.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1379
     Do not use this for now: it is non-portable and probably not speeding things up
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1380
     much, unless inlined into the sender code.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1381
     The code is here as a reminder and might be later used as a hint for the inliner
13360
1aac241c9981 comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13359
diff changeset
  1382
     (to speed up 3D computations, for example).
1aac241c9981 comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13359
diff changeset
  1383
     see: http://betterexplained.com/articles/understanding-quakes-fast-inverse-square-root/"
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1384
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1385
%{  /* NOCONTEXT */
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1386
    float x, rslt;
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1387
    OBJ newFloat;
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1388
13361
Michael Beyl <mb@exept.de>
parents: 13360
diff changeset
  1389
    if (sizeof(float) == 4) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1390
	x = __shortFloatVal(self);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1391
	{
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1392
	    float xhalf = 0.5f * x;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1393
	    int i = *(int*)&x; // store floating-point bits in integer
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1394
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1395
	    i = 0x5f3759d5 - (i >> 1); // initial guess for Newton's method
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1396
	    x = *(float*)&i; // convert new bits into float
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1397
	    x = x*(1.5f - xhalf*x*x); // One round of Newton's method
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1398
	    __qMKSFLOAT(newFloat, x);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1399
	    RETURN ( newFloat );
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1400
	}
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1401
    }
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1402
%}.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1403
    ^ 1 / self sqrt
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1404
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1405
    "
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1406
     10.0 asShortFloat fastInverseSqrt
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1407
     (1 / 10.0 asShortFloat sqrt)
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1408
    "
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1409
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1410
    "
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1411
     |a b t0 t1 t2|
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1412
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1413
     a := 345 asShortFloat.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1414
     t0 := Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1415
	1000000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1416
	]
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1417
     ].
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1418
     t1 := Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1419
	1000000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1420
	    a fastInverseSqrt
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1421
	]
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1422
     ].
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1423
     t2 := Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1424
	1000000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1425
	    (1 / a sqrt)
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1426
	]
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1427
     ].
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1428
     Transcript show:'empty: '; showCR:t0.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1429
     Transcript show:'fast: '; showCR:t1.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1430
     Transcript show:'regular: '; showCR:t2.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1431
    "
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1432
!
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1433
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1434
ln
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1435
    "return the natural logarithm of the receiver.
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1436
     Raises an exception, if the receiver is less or equal to zero."
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1437
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1438
%{  /* NOCONTEXT */
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1439
#ifndef __SCHTEAM__
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1440
    float val, rslt;
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1441
    OBJ newFloat;
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1442
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1443
    val = __shortFloatVal(self);
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1444
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1445
    /*
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1446
     * to suppress the warnBox opened by win32
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1447
     * to avoid returning -INF from some unix math libs (__osx__)
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1448
     */
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1449
    if (val > 0.0) {
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1450
	__threadErrno = 0;
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1451
# ifdef NO_LOGF
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1452
	{
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1453
	    double dRslt = log((double)val);
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1454
	    rslt = (float)dRslt;
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1455
	}
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1456
# else
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1457
	rslt = logf(val);
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1458
# endif
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1459
	if (! isnanf(rslt))  /* Currently all our systems support isnan() */
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1460
	{
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1461
	    if (__threadErrno == 0) {
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1462
		__qMKSFLOAT(newFloat, rslt);
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1463
		RETURN ( newFloat );
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1464
	    }
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1465
	}
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1466
    }
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1467
#endif
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1468
%}.
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1469
    "
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1470
     an invalid value for logarithm
21972
846097bcc0c9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21965
diff changeset
  1471
     if you need -INF for a zero receiver, try Number trapInfinity:[...]
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1472
    "
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1473
    ^ self class
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1474
	raise:(self = 0 ifTrue:[#infiniteResultSignal] ifFalse:[#domainErrorSignal])
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1475
	receiver:self
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1476
	selector:#ln
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1477
	arguments:#()
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1478
	errorString:'bad receiver in log10 (not strictly positive)'
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1479
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1480
    "
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1481
     0 asFloat ln
21965
ace6435a0903 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21956
diff changeset
  1482
     Number trapInfinity:[ 0 asFloat ln ]
ace6435a0903 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21956
diff changeset
  1483
21956
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1484
     10 asFloat ln       2.30258509299405
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1485
     10 asShortFloat ln  2.302585
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1486
     10 asLongFloat ln   2.302585092994045684
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1487
     10 asQDouble ln     2.30258509299404568402
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1488
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1489
     50 asFloat ln       3.91202300542815
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1490
     50 asShortFloat ln  3.912023
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1491
     50 asLongFloat ln   3.912023005428146059
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1492
     50 asQDouble ln     3.91202300542814605862
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1493
    "
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1494
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1495
    "Created: / 03-07-2017 / 15:20:07 / cg"
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1496
!
7a51828d5c96 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21955
diff changeset
  1497
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1498
log10
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1499
    "return the base-10 logarithm of the receiver.
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1500
     Raises an exception, if the receiver is less or equal to zero."
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1501
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1502
%{  /* NOCONTEXT */
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1503
#ifndef __SCHTEAM__
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1504
    float val, rslt;
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1505
    OBJ newFloat;
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1506
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1507
    val = __shortFloatVal(self);
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1508
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1509
    /*
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1510
     * to suppress the warnBox opened by win32
21955
c6b82cbb4b6a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21950
diff changeset
  1511
     * to avoid returning -INF from some unix math libs (__osx__)
c6b82cbb4b6a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21950
diff changeset
  1512
     */
c6b82cbb4b6a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21950
diff changeset
  1513
    if (val > 0.0) {
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1514
	__threadErrno = 0;
21834
1fe471f18a2e oops - no log10f under win32
Claus Gittinger <cg@exept.de>
parents: 21829
diff changeset
  1515
# ifdef NO_LOG10F
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1516
	{
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1517
	    double dRslt = log10((double)val);
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1518
	    rslt = (float)dRslt;
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1519
	}
21834
1fe471f18a2e oops - no log10f under win32
Claus Gittinger <cg@exept.de>
parents: 21829
diff changeset
  1520
# else
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1521
	rslt = log10f(val);
21834
1fe471f18a2e oops - no log10f under win32
Claus Gittinger <cg@exept.de>
parents: 21829
diff changeset
  1522
# endif
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1523
	if (! isnanf(rslt))  /* Currently all our systems support isnan() */
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1524
	{
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1525
	    if (__threadErrno == 0) {
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1526
		__qMKSFLOAT(newFloat, rslt);
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1527
		RETURN ( newFloat );
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1528
	    }
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1529
	}
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1530
    }
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1531
#endif
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1532
%}.
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1533
    "
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1534
     an invalid value for logarithm
21972
846097bcc0c9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21965
diff changeset
  1535
     if you need -INF for a zero receiver, try Number trapInfinity:[...]
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1536
    "
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1537
    ^ self class
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1538
	raise:(self = 0 ifTrue:[#infiniteResultSignal] ifFalse:[#domainErrorSignal])
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1539
	receiver:self
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1540
	selector:#log10
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1541
	arguments:#()
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1542
	errorString:'bad receiver in log10 (not strictly positive)'
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1543
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1544
    "
21976
a57d00890b72 no logf in borland
Claus Gittinger <cg@exept.de>
parents: 21972
diff changeset
  1545
     0 asShortFloat log10
21965
ace6435a0903 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21956
diff changeset
  1546
     Number trapInfinity:[ 0 asShortFloat log10 ]
ace6435a0903 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21956
diff changeset
  1547
21829
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1548
     10 asFloat log10       1.0
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1549
     10 asShortFloat log10  1.0
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1550
     10 asLongFloat log10   1.0
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1551
     10 asQDouble log10     1.00000000000000000000000000000000000000000
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1552
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1553
     50 asFloat log10       1.69897000433602
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1554
     50 asShortFloat log10  1.69897
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1555
     50 asLongFloat log10   1.698970004336018805
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1556
     50 asQDouble log10     1.69897000433601880478626110527550697323181
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1557
    "
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1558
ecd8892d2de5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21799
diff changeset
  1559
    "Created: / 16-06-2017 / 10:47:53 / cg"
21972
846097bcc0c9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21965
diff changeset
  1560
    "Modified (comment): / 03-07-2017 / 15:59:05 / cg"
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1561
! !
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1562
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1563
!ShortFloat methodsFor:'printing & storing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1564
22303
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1565
printOn:aStream
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1566
    "append a printed representation of the receiver to
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1567
     the argument, aStream.
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1568
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1569
     I use #printString instead of #printOn: as basic print mechanism."
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1570
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1571
    aStream nextPutAll:self printString
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1572
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1573
    "Created: / 10-10-2017 / 14:05:28 / cg"
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1574
!
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1575
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1576
printString
3194
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
  1577
    "return a printed representation of the receiver
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
  1578
     LimitedPrecisonReal and its subclasses use #printString instead of
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
  1579
     #printOn: as basic print mechanism."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1580
18139
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1581
    ^ self printStringWithFormat:DefaultPrintFormat
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1582
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1583
    "
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1584
	1.234 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1585
	1.0 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1586
	1e10 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1587
	1.2e3 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1588
	1.2e30 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1589
	(1.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1590
	(0.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1591
	self pi printString.
18139
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1592
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1593
	self pi printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1594
	DefaultPrintFormat := '.3'.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1595
	self pi printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1596
	DefaultPrintFormat := '.7'.
18139
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1597
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1598
	DecimalPointCharacterForPrinting := $,.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1599
	1.234 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1600
	1.0 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1601
	1e10 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1602
	1.2e3 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1603
	1.2e30 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1604
	(1.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1605
	(0.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1606
	DecimalPointCharacterForPrinting := $.
18139
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1607
    "
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1608
!
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1609
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1610
printStringWithFormat:format
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1611
    "return a printed representation of the receiver;
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1612
     fmt must be of the form: .nn, where nn is the number of digits.
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1613
     To print 6 valid digits, use printStringWithFormat:'.6'
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1614
     For Floats, the default used in printString, is 15 (because its a double);
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1615
     for ShortFloats, it is 6 (because it is a float)"
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1616
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1617
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1618
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1619
    char buffer[64];
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1620
    REGISTER char *cp;
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1621
    int len;
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1622
    OBJ s;
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1623
    char *fmt;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1624
    char fmtBuffer[20];
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1625
18139
b001bda4f8f5 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 18130
diff changeset
  1626
    if (__isStringLike(format)) {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1627
	fmt = (char *) __stringVal(format);
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1628
    } else {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1629
	/*
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1630
	 * in case we get called with garbage...
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1631
	 */
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1632
	fmt = ".7";
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1633
    }
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1634
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1635
    /*
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1636
     * build a printf format string
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1637
     */
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1638
    fmtBuffer[0] = '%';
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1639
    strncpy(fmtBuffer+1, fmt, 10);
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1640
    strcat(fmtBuffer, "g");
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1641
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1642
    /*
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1643
     * actually only needed on sparc: since thisContext is
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1644
     * in a global register, which gets destroyed by printf,
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1645
     * manually save it here - very stupid ...
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1646
     */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1647
    __BEGIN_PROTECT_REGISTERS__
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1648
    len = snprintf(buffer, sizeof(buffer), fmtBuffer, (float)__shortFloatVal(self));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1649
    __END_PROTECT_REGISTERS__
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1650
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1651
    if (len >= 0 && len <= sizeof(buffer)-3) {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1652
	/*
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1653
	 * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1654
	 * (i.e. look if string contains '.' or 'e' and append '.0' if not)
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1655
	 */
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1656
	for (cp = buffer; *cp; cp++) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1657
	    if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1658
	}
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1659
	if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1660
	    if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1661
		*cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1662
	    } else {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1663
		*cp++ = '.';
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1664
	    }
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1665
	    *cp++ = '0';
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1666
	    *cp = '\0';
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1667
	} else {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1668
	    if (cp && (*cp == '.')) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1669
		if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1670
		    *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1671
		}
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1672
	    }
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1673
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1674
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1675
	s = __MKSTRING(buffer);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1676
	if (s != nil) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1677
	    RETURN (s);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1678
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1679
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1680
%}.
5432
c71559a881e2 migration support
Claus Gittinger <cg@exept.de>
parents: 5411
diff changeset
  1681
    ^ self asFloat printString
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1682
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1683
    "
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1684
	1.234 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1685
	ShortFloat pi printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1686
	1.0 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1687
	1e10 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1688
	1.2e3 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1689
	1.2e30 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1690
	(1.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1691
	(0.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1692
	self pi printString.
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1693
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1694
	self pi printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1695
	DefaultPrintFormat := '.3'.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1696
	self pi printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1697
	DefaultPrintFormat := '.7'.
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1698
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1699
	DecimalPointCharacterForPrinting := $,.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1700
	1.234 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1701
	1.0 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1702
	1e10 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1703
	1.2e3 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1704
	1.2e30 asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1705
	(1.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1706
	(0.0 uncheckedDivide:0) asShortFloat printString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1707
	DecimalPointCharacterForPrinting := $.
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1708
    "
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1709
!
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1710
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1711
printfPrintString:formatString
24693
9587c4518f5d #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24459
diff changeset
  1712
    <unsave>
9587c4518f5d #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24459
diff changeset
  1713
7746
4a4208ef7699 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7725
diff changeset
  1714
    "non-standard: return a printed representation of the receiver
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1715
     as specified by formatString, which is defined by printf.
21950
f5852ca02a75 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21906
diff changeset
  1716
f5852ca02a75 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21906
diff changeset
  1717
     If you use this, be aware, that the format string must be correct and something like %f.
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1718
     Also, the resulting string may not be longer than 255 bytes -
20433
29c784535d3b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20008
diff changeset
  1719
     since that's the (static) size of the buffer.
21906
f070c75710f1 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21891
diff changeset
  1720
11924
db93de0d761d changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11730
diff changeset
  1721
     This method is NONSTANDARD and may be removed without notice.
24693
9587c4518f5d #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24459
diff changeset
  1722
9587c4518f5d #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24459
diff changeset
  1723
     WARNING: this goes directly to the C-printf function and may therefore me inherently unsafe.
11924
db93de0d761d changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11730
diff changeset
  1724
     Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1725
24693
9587c4518f5d #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24459
diff changeset
  1726
%{  /* STACK: 8000 */
9587c4518f5d #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24459
diff changeset
  1727
#ifndef __SCHTEAM__
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1728
    char buffer[256];
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1729
    OBJ s;
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1730
    int len;
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1731
12486
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  1732
    if (__isStringLike(formatString)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1733
	/*
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1734
	 * actually only needed on sparc: since thisContext is
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1735
	 * in a global register, which gets destroyed by printf,
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1736
	 * manually save it here - very stupid ...
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1737
	 */
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1738
	__BEGIN_PROTECT_REGISTERS__
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1739
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1740
	len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __shortFloatVal(self));
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1741
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1742
	__END_PROTECT_REGISTERS__
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1743
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1744
	if (len < 0) goto fail;
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1745
	if (len >= sizeof(buffer)) goto fail;
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1746
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1747
	s = __MKSTRING_L(buffer, len);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1748
	if (s != nil) {
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1749
	    RETURN (s);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  1750
	}
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1751
    }
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1752
fail: ;
24693
9587c4518f5d #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24459
diff changeset
  1753
#endif /* not __SCHTEAM__ */
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1754
%}.
21906
f070c75710f1 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21891
diff changeset
  1755
    ^ super printfPrintString:formatString
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1756
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1757
    "ShortFloat pi printfPrintString:'%%lg -> %lg'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1758
    "ShortFloat pi printfPrintString:'%%lf -> %lf'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1759
    "ShortFloat pi printfPrintString:'%%7.5lg -> %7.5lg'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1760
    "ShortFloat pi printfPrintString:'%%G -> %G'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1761
    "ShortFloat pi printfPrintString:'%%F -> %F'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1762
    "ShortFloat pi printfPrintString:'%%7.5G -> %7.5G'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1763
    "ShortFloat pi printfPrintString:'%%7.5F -> %7.5F'"
21906
f070c75710f1 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21891
diff changeset
  1764
21950
f5852ca02a75 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21906
diff changeset
  1765
    "Modified (comment): / 03-07-2017 / 15:12:20 / cg"
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1766
!
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1767
22303
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1768
storeOn:aStream
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1769
    "append a printed representation of the receiver to
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1770
     the argument, aStream.
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1771
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1772
     I use #storeString instead of #storeOn: as basic store mechanism."
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1773
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1774
    aStream nextPutAll:self storeString
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1775
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1776
    "Created: / 10-10-2017 / 14:06:52 / cg"
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1777
!
a6cd53d4a5fe #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22259
diff changeset
  1778
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1779
storeString
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1780
    "return a printed representation of the receiver;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1781
     all valid digits are printed.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1782
     LimitedPrecisonReal and its subclasses use #storeString instead of
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1783
     #storeOn: as basic print mechanism."
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1784
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1785
%{  /* NOCONTEXT */
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1786
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1787
    char buffer[64];
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1788
    REGISTER char *cp;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1789
    OBJ s;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1790
    int len;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1791
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1792
    /*
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1793
     * build a printf format string
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1794
     */
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1795
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1796
    __BEGIN_PROTECT_REGISTERS__
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1797
    len = snprintf(buffer, sizeof(buffer), "%.8g", (float)__shortFloatVal(self));
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1798
    __END_PROTECT_REGISTERS__
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1799
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1800
    if (len >= 0 && len < sizeof(buffer)-3) {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1801
	/*
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1802
	 * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1803
	 * (i.e. look if string contains '.' or 'e' and append '.0' if not)
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1804
	 */
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1805
	for (cp = buffer; *cp; cp++) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1806
	    if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1807
	}
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1808
	if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1809
	    *cp++ = '.';
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1810
	    *cp++ = '0';
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1811
	    *cp = '\0';
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1812
	}
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1813
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1814
	s = __MKSTRING(buffer);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1815
	if (s != nil) {
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1816
	    RETURN (s);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1817
	}
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1818
    }
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1819
%}.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1820
    "
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1821
     memory allocation (for the new string) failed.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1822
     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: 8418
diff changeset
  1823
     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: 8418
diff changeset
  1824
     OS, which was not kind enough to give it.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1825
     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: 8418
diff changeset
  1826
    "
20706
009b8269bd08 we have class based exceptions - use them
Claus Gittinger <cg@exept.de>
parents: 20433
diff changeset
  1827
    ^ AllocationFailure raise.
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1828
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1829
    "
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1830
	0.1 asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1831
	((Array new:10 withAll:0.1 asShortFloat) inject:0 into:[:v :sumSoFar| sumSoFar + v]) storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1832
	1.0 asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1833
	1.234 asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1834
	1e10 asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1835
	1.2e3 asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1836
	1.2e30 asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1837
	Float pi asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1838
	(1.0 uncheckedDivide:0) asShortFloat storeString
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1839
	(0.0 uncheckedDivide:0) asShortFloat storeString
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1840
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1841
     notice that the storeString is NOT affected by DecimalPointCharacterForPrinting:
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1842
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1843
	DecimalPointCharacterForPrinting := $,.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1844
	1.234 asShortFloat storeString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1845
	1.0 asShortFloat storeString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1846
	1e10 asShortFloat storeString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1847
	1.2e3 asShortFloat storeString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1848
	1.2e30 asShortFloat storeString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1849
	(1.0 uncheckedDivide:0) asShortFloat storeString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1850
	(0.0 uncheckedDivide:0) asShortFloat storeString.
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1851
	DecimalPointCharacterForPrinting := $.
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1852
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1853
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1854
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1855
!ShortFloat methodsFor:'private accessing'!
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1856
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1857
basicAt:index
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1858
    "return an internal byte of the float.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1859
     The value returned here depends on byte order, float representation etc.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1860
     Therefore, this method should be used strictly private.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1861
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1862
     Notice:
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1863
	the need to redefine this method here is due to the
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1864
	inability of many machines to store floats in non-double aligned memory.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1865
	Therefore, on some machines, the first 4 bytes of a float are left unused,
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1866
	and the actual float is stored at index 5 .. 12.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1867
	To hide this at one place, this method knows about that, and returns
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1868
	values as if this filler wasnt present."
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1869
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1870
%{  /* NOCONTEXT */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1871
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1872
    register int indx;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1873
    unsigned char *cp;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1874
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1875
    /*
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1876
     * notice the missing test for self being a nonNilObject -
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1877
     * this can be done since basicAt: is defined both in UndefinedObject
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1878
     * and SmallInteger
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1879
     */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1880
    if (__isSmallInteger(index)) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1881
	indx = __intVal(index) - 1;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1882
	if (((unsigned)(indx)) < sizeof(float)) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1883
	    cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1884
	    RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1885
	}
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1886
    }
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1887
%}.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1888
    ^ self indexNotIntegerOrOutOfBounds:index
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1889
!
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1890
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1891
basicAt:index put:value
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1892
    "set an internal byte of the float.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1893
     The value to be stored here depends on byte order, float representation etc.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1894
     Therefore, this method should be used strictly private.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1895
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1896
     Notice:
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1897
	the need to redefine this method here is due to the
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1898
	inability of many machines to store floats in non-double aligned memory.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1899
	Therefore, on some machines, the first 4 bytes of a float are left unused,
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1900
	and the actual float is stored at index 5 .. 12.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1901
	To hide this at one place, this method knows about that, and returns
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1902
	values as if this filler wasnt present."
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1903
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1904
%{  /* NOCONTEXT */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1905
    register int indx, val;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1906
    unsigned char *cp;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1907
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1908
    /*
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1909
     * notice the missing test for self being a nonNilObject -
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1910
     * this can be done since basicAt: is defined both in UndefinedObject
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1911
     * and SmallInteger
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1912
     */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1913
    if (__bothSmallInteger(index, value)) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1914
	val = __intVal(value);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1915
	if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1916
	    indx = __intVal(index) - 1;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1917
	    if (((unsigned)(indx)) < sizeof(float)) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1918
		cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1919
		cp[indx] = val;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1920
		RETURN ( value );
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1921
	    }
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1922
	}
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1923
    }
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1924
%}.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1925
    value isInteger ifFalse:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1926
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1927
	 the object to store should be an integer number
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1928
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1929
	^ self elementNotInteger
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1930
    ].
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1931
    (value between:0 and:255) ifFalse:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1932
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1933
	 the object to store must be a bytes value
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1934
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1935
	^ self elementBoundsError:value
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1936
    ].
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1937
    ^ self indexNotIntegerOrOutOfBounds:index
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1938
! !
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1939
22259
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1940
!ShortFloat methodsFor:'private-accessing'!
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1941
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1942
byteAt:index
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1943
    ^ self basicAt:index
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1944
!
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1945
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1946
byteAt:index put:newByte
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1947
    self shouldNotImplement
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1948
! !
60b47f522c85 #BUGFIX by sr
sr
parents: 21976
diff changeset
  1949
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1950
!ShortFloat methodsFor:'queries'!
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1951
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1952
nextFloat:count
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1953
    "answer the next float count places after (or before if count is negative) myself"
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1954
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1955
%{
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1956
    union u {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1957
	float d;
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1958
	INT32 i;
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1959
    } this;
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1960
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1961
    if (__isSmallInteger(count)) {
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1962
	this.d = __shortFloatVal(self);
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1963
	if (isfinite(this.d))
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1964
	    this.i += __intVal(count);
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1965
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  1966
	RETURN(__MKSFLOAT(this.d));
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1967
    }
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1968
%}.
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1969
    self primitiveFailed:#badArgument
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1970
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1971
  "
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1972
     (1.0 asShortFloat nextFloat:2) storeString
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1973
     (67329.234 asShortFloat nextFloat:1) storeString
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1974
     ShortFloat NaN nextFloat:100000
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1975
     ShortFloat infinity nextFloat:100000
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1976
  "
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1977
! !
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  1978
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1979
!ShortFloat methodsFor:'special access'!
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1980
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1981
exponent
24964
0236232a98e1 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24953
diff changeset
  1982
    "extract a normalized float's (unbiased) exponent.
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1983
     The returned value depends on the float-representation of
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1984
     the underlying machine and is therefore highly unportable.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1985
     This is not for general use.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1986
     This assumes that the mantissa is normalized to
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  1987
     0.5 .. 1.0 and the float's value is mantissa * 2^exp"
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1988
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1989
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1990
    int exp;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1991
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1992
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1993
    frexpf( __shortFloatVal(self), &exp);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1994
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1995
    frexp( (double)(__shortFloatVal(self)), &exp);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1996
#endif
14744
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
  1997
    RETURN (__mkSmallInteger(exp));
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1998
%}.
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  1999
    ^ super exponent
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2000
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2001
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2002
     4.0 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2003
     2.0 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2004
     1.0 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2005
     0.5 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2006
     0.25 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2007
     0.00000011111 asShortFloat exponent
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2008
    "
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2009
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2010
    "Modified: / 20-06-2017 / 11:33:41 / cg"
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2011
!
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2012
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2013
mantissa
24150
bf24bb4dd79e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 23478
diff changeset
  2014
    "extract a normalized float's mantissa.
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2015
     The returned value depends on the float-representation of
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2016
     the underlying machine and is therefore highly unportable.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2017
     This is not for general use.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2018
     This assumes that the mantissa is normalized to
24150
bf24bb4dd79e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 23478
diff changeset
  2019
     0.5 .. 1.0 and the float's value is mantissa * 2^exp"
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2020
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2021
%{  /* NOCONTEXT */
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2022
    float myVal;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2023
    int exp;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2024
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2025
    myVal = __shortFloatVal(self);
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2026
    // ouch: math libs seem to not care for NaN here;
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2027
#if 1
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2028
    // should we?
21868
f568817ef1d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21858
diff changeset
  2029
    if (!isnanf(myVal) && isfinitef(myVal))
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2030
#endif
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2031
    {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  2032
#if defined(__i386__) && defined(__GNUC__)
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2033
	float frac = frexpf(myVal, &exp);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2034
	RETURN (__MKSFLOAT(frac));
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2035
#else
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2036
	double frac = frexp( (double)(myVal), &exp);
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2037
	RETURN (__MKFLOAT(frac));
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2038
#endif
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2039
    }
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2040
%}.
20008
21d2247d8dd8 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 20000
diff changeset
  2041
    ^ super mantissa
20706
009b8269bd08 we have class based exceptions - use them
Claus Gittinger <cg@exept.de>
parents: 20433
diff changeset
  2042
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2043
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2044
     1.0 asShortFloat exponent
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2045
     1.0 asShortFloat mantissa
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2046
     1e1000 asShortFloat mantissa
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2047
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2048
     0.5 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2049
     0.5 asShortFloat mantissa
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2050
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2051
     0.25 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2052
     0.25 asShortFloat mantissa
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2053
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2054
     0.00000011111 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2055
     0.00000011111 asShortFloat mantissa
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2056
    "
21850
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2057
30b47dffc27c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21836
diff changeset
  2058
    "Modified: / 20-06-2017 / 11:41:11 / cg"
24150
bf24bb4dd79e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 23478
diff changeset
  2059
    "Modified: / 26-05-2019 / 03:13:14 / Claus Gittinger"
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2060
! !
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2061
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2062
!ShortFloat methodsFor:'testing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2063
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2064
isFinite
24701
594248902e06 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24693
diff changeset
  2065
    "return true, if the receiver is a finite float (not NaN and not +/-INF)"
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2066
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2067
%{  /* NOCONTEXT */
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
  2068
    float fV = __shortFloatVal(self);
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2069
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2070
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2071
     * notice: on machines which do not provide
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2072
     * a isfinite() macro or function (WIN32),
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
  2073
     * 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
  2074
     */
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  2075
    if (isfinitef(fV)) { RETURN (true); }
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2076
%}.
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
  2077
    ^ false
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2078
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2079
    "
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2080
	1.0 asShortFloat isFinite
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2081
	(0.0 asShortFloat uncheckedDivide: 0.0) isFinite
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2082
	(1.0 asShortFloat uncheckedDivide: 0.0) isFinite
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2083
    "
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2084
!
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2085
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2086
isNaN
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2087
    "return true, if the receiver is an invalid float (NaN - not a number).
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2088
     These are not created by ST/X float operations (they raise an exception);
24701
594248902e06 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24693
diff changeset
  2089
     however, inline C-code could produce them."
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2090
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2091
%{  /* NOCONTEXT */
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  2092
    float sV = __shortFloatVal(self);
3139
ca
parents: 3014
diff changeset
  2093
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2094
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  2095
     * notice: on machines which do not provide
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2096
     * a isnan() macro or function (WIN32),
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
  2097
     * 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
  2098
     */
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  2099
    if (isnanf(sV)) { RETURN (true); }
2392
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  2100
%}.
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  2101
    ^ false
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2102
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2103
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2104
     1.0 asShortFloat isNaN
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2105
     (0.0 asShortFloat uncheckedDivide: 0.0) isNaN
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2106
     (0.0 asShortFloat uncheckedDivide: 0.0 asShortFloat) isNaN
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  2107
    "
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2108
!
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2109
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2110
isNegativeZero
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2111
    "many systems have two float.Pnt zeros"
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2112
17396
b587ca0a385f class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17394
diff changeset
  2113
%{ /* NOCONTEXT */
17394
5adc10f7b7a5 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17391
diff changeset
  2114
#if defined(__BORLANDC__)
5adc10f7b7a5 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17391
diff changeset
  2115
    union { float f; int i; } __u;
5adc10f7b7a5 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17391
diff changeset
  2116
   __u.f = __shortFloatVal(self);
5adc10f7b7a5 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17391
diff changeset
  2117
    RETURN ( (__u.f == 0.0 && __u.i < 0) ? true : false );
17391
a3b12aec97ac class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17382
diff changeset
  2118
#else
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2119
    RETURN ( (__shortFloatVal(self) == 0.0 && signbit(__shortFloatVal(self)) != 0) ? true : false );
17391
a3b12aec97ac class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17382
diff changeset
  2120
#endif
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2121
%}.
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2122
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2123
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2124
     0.0 asShortFloat isNegativeZero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2125
     -0.0 asShortFloat isNegativeZero
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2126
    "
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2127
!
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  2128
24947
2b4b6de3a009 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24933
diff changeset
  2129
isShortFloat
2b4b6de3a009 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24933
diff changeset
  2130
    "return true, if the receiver is some kind of short floating point number (iee single precision)"
2b4b6de3a009 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24933
diff changeset
  2131
2b4b6de3a009 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24933
diff changeset
  2132
    ^ true
2b4b6de3a009 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24933
diff changeset
  2133
!
2b4b6de3a009 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24933
diff changeset
  2134
24330
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2135
isZero
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2136
    "return true, if the receiver is zero"
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2137
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2138
    ^ self = 0.0
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2139
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2140
    "Created: / 10-06-2019 / 21:59:09 / Claus Gittinger"
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2141
!
a06e1fba915a #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24324
diff changeset
  2142
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2143
negative
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2144
    "return true if the receiver is less than zero.
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2145
     -0.0 is positive for now."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2146
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2147
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2148
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2149
    RETURN ( __shortFloatVal(self) < 0.0  ? true : false );
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2150
    // RETURN ( signbit(__shortFloatVal(self)) != 0  ? true : false );
5411
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
  2151
%}.
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2152
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2153
    "
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2154
	0.0 asShortFloat negative
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2155
	-0.0 asShortFloat negative
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2156
	1.0 asShortFloat negative
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2157
	-1.0 asShortFloat negative
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2158
	(1.0 uncheckedDivide: 0.0) asShortFloat negative
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2159
	(-1.0 uncheckedDivide: 0.0) asShortFloat negative
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2160
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2161
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2162
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2163
numberOfBits
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2164
    "return the size (in bits) of the real;
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2165
     typically, 32 is returned here,
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2166
     but who knows ..."
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2167
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2168
%{  /* NOCONTEXT */
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2169
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2170
    RETURN (__mkSmallInteger (sizeof(float) * 8));
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2171
%}
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2172
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2173
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2174
     1.2 numberOfBits
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2175
     1.2 asShortFloat numberOfBits
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2176
    "
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2177
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2178
!
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  2179
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2180
positive
18852
49601a7aefd8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18841
diff changeset
  2181
    "return true if the receiver is greater or equal to zero (not negative)
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2182
     0.0 and -0.0 are positive for now."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2183
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2184
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2185
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2186
    RETURN ( __shortFloatVal(self) >= 0.0 ? true : false );
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2187
//    RETURN ( (signbit(__shortFloatVal(self)) == 0 ? true : false ) );
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2188
%}.
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2189
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2190
    "
19570
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2191
	0.0 asShortFloat positive
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2192
	-0.0 asShortFloat positive
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2193
	1.0 asShortFloat positive
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2194
	-1.0 asShortFloat positive
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2195
	(1.0 uncheckedDivide: 0.0) asShortFloat positive
017c53457288 lazy computation of epsilon
Claus Gittinger <cg@exept.de>
parents: 19325
diff changeset
  2196
	(-1.0 uncheckedDivide: 0.0) asShortFloat positive
17382
1181f2c99686 class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 17220
diff changeset
  2197
    "
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2198
!
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2199
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2200
strictlyPositive
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2201
    "return true if the receiver is greater than zero"
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2202
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2203
%{  /* NOCONTEXT */
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2204
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2205
    RETURN ( (__shortFloatVal(self) > 0.0) ? true : false );
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2206
%}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2207
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2208
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5432
diff changeset
  2209
!ShortFloat methodsFor:'truncation & rounding'!
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2210
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2211
ceiling
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2212
    "return the smallest integer which is greater or equal to the receiver."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2213
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2214
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2215
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2216
%{
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2217
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2218
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2219
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2220
    fVal = ceilf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2221
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2222
    fVal = (float)(ceil((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2223
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2224
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2225
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2226
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2227
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2228
	RETURN ( __mkSmallInteger( (INT) fVal ) );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2229
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2230
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2231
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2232
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2233
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2234
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2235
     0.5 asShortFloat ceiling
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2236
     -0.5 asShortFloat ceiling
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2237
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2238
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2239
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2240
ceilingAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2241
    "return the smallest integer-valued float greater or equal to the receiver.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2242
     This is much like #ceiling, but avoids a (possibly expensive) conversion
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2243
     of the result to an integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2244
     It may be useful, if the result is to be further used in another float-operation."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2245
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2246
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2247
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2248
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2249
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2250
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2251
    fVal = ceilf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2252
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2253
    fVal = (float) ceil((double)__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2254
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2255
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2256
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2257
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2258
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2259
     0.5 asShortFloat ceilingAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2260
     -0.5 asShortFloat ceilingAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2261
     -1.5 asShortFloat ceilingAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2262
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2263
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2264
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2265
floor
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2266
    "return the integer nearest the receiver towards negative infinity."
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2267
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2268
    |val|
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2269
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2270
%{
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2271
    float fVal;
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2272
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2273
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2274
    fVal = floorf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2275
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2276
    fVal = (float)(floor((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2277
#endif
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2278
    /*
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2279
     * ST-80 (and X3J20) returns integer.
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2280
     */
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2281
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2282
	RETURN ( __mkSmallInteger( (INT) fVal ) );
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2283
    }
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2284
    __qMKSFLOAT(val, fVal);
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2285
%}.
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2286
    ^ val asInteger
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2287
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2288
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2289
     0.5 asShortFloat floor
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2290
     -0.5 asShortFloat floor
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2291
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2292
!
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2293
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2294
floorAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2295
    "return the float which represents the next lower
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2296
     integer nearest the receiver towards negative infinity.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2297
     Much like floor, but returns a float result - useful if the result
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2298
     will be used in another float operation, to avoid costy int-conversion."
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2299
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2300
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2301
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2302
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2303
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2304
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2305
    fVal = floorf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2306
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2307
    fVal = (float)(floor((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2308
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2309
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2310
    RETURN ( v );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2311
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2312
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2313
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2314
     0.5 asShortFloat floorAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2315
     -0.5 asShortFloat floorAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2316
    "
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2317
!
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  2318
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2319
fractionPart
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2320
    "extract the after-decimal fraction part.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2321
     such that (self truncated + self fractionPart) = self"
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2322
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2323
%{  /* NOCONTEXT */
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2324
#ifdef NO_MODFF
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2325
    double dFrac, dTrunc;
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2326
#else
14741
4a898f7517d5 hack for visualc
Claus Gittinger <cg@exept.de>
parents: 14727
diff changeset
  2327
# ifndef __VISUALC__
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2328
    float modff(float, float *);
14741
4a898f7517d5 hack for visualc
Claus Gittinger <cg@exept.de>
parents: 14727
diff changeset
  2329
# endif
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2330
#endif
14718
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2331
    float frac, trunc;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2332
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  2333
    __threadErrno = 0;
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2334
#ifdef NO_MODFF
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2335
	dFrac = modf((double)__shortFloatVal(self), &dTrunc) ;
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2336
	frac = (float)dFrac;
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2337
#else
14718
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2338
    frac = modff(__shortFloatVal(self), &trunc);
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  2339
#endif
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2340
    if (! isnan(frac)) {
14719
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2341
	if (__threadErrno == 0) {
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2342
	    RETURN (__MKSFLOAT(frac));
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2343
	}
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2344
    }
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2345
%}.
7403
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  2346
    ^ self class
14719
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2347
	raise:#domainErrorSignal
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2348
	receiver:self
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2349
	selector:#fractionPart
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2350
	arguments:#()
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  2351
	errorString:'bad receiver in fractionPart'
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2352
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2353
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2354
     1.6 asShortFloat fractionPart + 1.6 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2355
     -1.6 asShortFloat fractionPart + -1.6 asShortFloat truncated
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2356
14718
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2357
     1.0 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2358
     0.5 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2359
     0.25 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2360
     3.14159 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2361
     12345673.14159 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  2362
     123456731231231231.14159 asShortFloat fractionPart
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2363
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2364
!
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2365
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2366
rounded
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2367
    "return the receiver rounded to the nearest integer"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2368
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2369
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2370
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2371
%{
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2372
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2373
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2374
    fVal = __shortFloatVal(self);
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2375
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2376
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2377
	fVal = ceilf(fVal - (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2378
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2379
	fVal = floorf(fVal + (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2380
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2381
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2382
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2383
	fVal = (float)ceil((double)fVal - 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2384
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2385
	fVal = (float)floor((double)fVal + 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2386
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2387
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2388
    /*
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2389
     * ST-80 (and X3J20) return integer.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2390
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2391
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2392
	RETURN ( __mkSmallInteger( (INT) fVal ) );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2393
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2394
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2395
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2396
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2397
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2398
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2399
     0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2400
     0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2401
     0.6 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2402
     -0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2403
     -0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2404
     -0.6 asShortFloat rounded
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2405
     1e32 asShortFloat rounded
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2406
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2407
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2408
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2409
roundedAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2410
    "return the receiver rounded to the nearest integer as a float.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2411
     This is much like #rounded, but avoids a (possibly expensive) conversion
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2412
     of the result to an integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2413
     It may be useful, if the result is to be further used in another float-operation."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2414
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2415
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2416
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2417
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2418
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2419
    fVal = __shortFloatVal(self);
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2420
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2421
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2422
	fVal = ceilf(fVal - (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2423
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2424
	fVal = floorf(fVal + (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2425
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2426
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2427
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2428
	fVal = (float)ceil((double)fVal - 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2429
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2430
	fVal = (float)floor((double)fVal + 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2431
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2432
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2433
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2434
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2435
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2436
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2437
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2438
     0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2439
     0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2440
     0.6 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2441
     -0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2442
     -0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2443
     -0.6 asShortFloat rounded
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2444
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2445
     0.4 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2446
     0.5 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2447
     0.6 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2448
     -0.4 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2449
     -0.5 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2450
     -0.6 asShortFloat roundedAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2451
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2452
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2453
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2454
truncated
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2455
    "return the receiver truncated towards zero as an integer"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2456
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2457
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2458
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2459
%{
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2460
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2461
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2462
    fVal = __shortFloatVal(self);
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2463
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2464
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2465
	fVal = ceilf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2466
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2467
	fVal = floorf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2468
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2469
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2470
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2471
	fVal = (float)ceil((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2472
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2473
	fVal = (float)floor((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2474
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2475
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2476
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2477
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2478
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2479
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2480
	RETURN ( __mkSmallInteger( (INT) fVal ) );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2481
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2482
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2483
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2484
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2485
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2486
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2487
     0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2488
     -0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2489
     0.5 asShortFloat truncatedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2490
     -0.5 asShortFloat truncatedAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2491
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2492
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2493
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2494
truncatedAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2495
    "return the receiver truncated towards zero as a float.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2496
     This is much like #truncated, but avoids a (possibly expensive) conversion
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2497
     of the result to an integer.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2498
     It may be useful, if the result is to be further used in another
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2499
     float-operation."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2500
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2501
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2502
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2503
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2504
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2505
    fVal = __shortFloatVal(self);
22788
6a6604fa5b49 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22785
diff changeset
  2506
#if (defined(__i386__) || defined(xx__x86_64__)) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2507
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2508
	fVal = ceilf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2509
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2510
	fVal = floorf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2511
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2512
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2513
    if (fVal < 0.0) {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2514
	fVal = (float)ceil((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2515
    } else {
24976
0b3c34125507 fallback for missing strtof with BORLAND
Claus Gittinger <cg@exept.de>
parents: 24975
diff changeset
  2516
	fVal = (float)floor((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2517
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2518
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2519
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2520
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2521
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2522
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2523
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2524
     0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2525
     -0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2526
     0.5 asShortFloat truncatedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  2527
     -0.5 asShortFloat truncatedAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  2528
    "
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2529
! !
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  2530
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2531
!ShortFloat class methodsFor:'documentation'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2532
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2533
version
18841
0578521d1cea #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18139
diff changeset
  2534
    ^ '$Header$'
12486
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  2535
!
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  2536
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  2537
version_CVS
18841
0578521d1cea #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18139
diff changeset
  2538
    ^ '$Header$'
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2539
! !
15012
3361a2f2993e class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14931
diff changeset
  2540
16670
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  2541
b81b77ec431d class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 16633
diff changeset
  2542
ShortFloat initialize!