ShortFloat.st
author Claus Gittinger <cg@exept.de>
Wed, 20 Mar 2013 16:01:14 +0100
changeset 14922 30546dbb18c6
parent 14920 5b452cc39879
child 14924 7115c6830ed8
permissions -rw-r--r--
class: ShortFloat added: #readBinaryIEEESingleFrom:into:MSB: changed: #readBinaryIEEESingleFrom:into:
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
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
LimitedPrecisionReal variableByteSubclass:#ShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
	instanceVariableNames:''
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
    16
	classVariableNames:''
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	poolDictionaries:''
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	category:'Magnitude-Numbers'
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    21
!ShortFloat primitiveDefinitions!
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    22
%{
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    23
14744
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
    24
#include <stdio.h>
3471
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    25
#include <errno.h>
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    26
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    27
#ifndef __OPTIMIZE__
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    28
# define __OPTIMIZE__
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    29
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    30
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    31
#define __USE_ISOC9X 1
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
    32
#define __USE_ISOC99 1
3471
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    33
#include <math.h>
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    34
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    35
/*
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    36
 * on some systems errno is a macro ... check for it here
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    37
 */
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    38
#ifndef errno
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    39
 extern errno;
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    40
#endif
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    41
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
    42
#if !defined (WIN32)
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
    43
# include <locale.h>
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
    44
#endif
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
    45
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    46
#if defined (_AIX)
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    47
# include <float.h>
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    48
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    49
2395
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    50
#if defined(IRIX)
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    51
# include <nan.h>
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    52
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    53
2397
dd6979979e67 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2395
diff changeset
    54
#if defined(LINUX)
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    55
# ifndef NAN
5822
4e56f8aadda5 Get nan.h from bits/nan.h for Linux
Stefan Vogel <sv@exept.de>
parents: 5718
diff changeset
    56
#  include <bits/nan.h>
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    57
# endif
2397
dd6979979e67 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2395
diff changeset
    58
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    59
2400
01b61753386f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2398
diff changeset
    60
#if defined(solaris) || defined(sunos)
2398
652c9f2a13fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
    61
# include <nan.h>
652c9f2a13fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
    62
#endif
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    63
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    64
#ifdef WIN32
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    65
/*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    66
 * no finite(x) ?
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    67
 * no isnan(x) ?
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    68
 */
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    69
# ifndef isnan
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    70
#  define isnan(x)      \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    71
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    72
	 (((unsigned int *)(&x))[1] == 0xFFF80000))
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    73
# endif
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    74
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    75
# ifndef isPositiveInfinity
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    76
#  define isPositiveInfinity(x) \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    77
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    78
	 (((unsigned int *)(&x))[1] == 0x7FF00000))
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    79
# endif
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    80
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    81
# ifndef isNegativeInfinity
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    82
#  define isPositiveInfinity(x) \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    83
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    84
	 (((unsigned int *)(&x))[1] == 0xFFF00000))
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    85
# endif
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    86
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    87
# ifndef isinf
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    88
#  define isinf(x) \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    89
	((((unsigned int *)(&x))[0] == 0x00000000) && \
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    90
	 ((((unsigned int *)(&x))[1] & 0x7FF00000) == 0x7FF00000))
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    91
# endif
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    92
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
    93
# ifndef isfinite
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
    94
#  define isfinite(x) (!isinf(x) && !isnan(x))
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    95
# endif
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
    96
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
    97
# ifndef isnanf
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
    98
#  define isnanf(x)      \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
    99
	(((unsigned int *)(&x))[0] == 0xFFC00000)
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   100
# endif
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   101
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   102
# ifndef isPositiveInfinityf
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   103
#  define isPositiveInfinityf(x)      \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   104
	(((unsigned int *)(&x))[0] == 0x7F800000)
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   105
# endif
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   106
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   107
# ifndef isNegativeInfinityf
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   108
#  define isNegativeInfinityf(x)      \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   109
	(((unsigned int *)(&x))[0] == 0xFF800000)
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   110
# endif
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   111
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   112
# ifndef isinff
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   113
#  define isinff(x)      \
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   114
	((((unsigned int *)(&x))[0] & 0x7FFFFFFF) == 0x7F800000)
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   115
# endif
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   116
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   117
# ifndef isfinitef
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   118
#  define isfinitef(x) (!isinff(x) && !isnanf(x))
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   119
# endif
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   120
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
   121
# define NO_ASINH
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
   122
# define NO_ACOSH
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
   123
# define NO_ATANH
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
   124
# ifdef __BORLANDC__
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
   125
#  define NO_FMODF
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
   126
#  define NO_MODFF
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
   127
# endif
8706
d48896f0a910 mac stuff
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
   128
#endif /* WIN32 */
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
   129
8984
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   130
#ifdef solaris
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   131
# ifndef isfinite
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   132
#  define isfinite(f) finite((double)(f))
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   133
# endif
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   134
#endif
ddf3bff73452 isfinite() et.al. for Solaris
Stefan Vogel <sv@exept.de>
parents: 8980
diff changeset
   135
3414
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
   136
#ifdef realIX
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   137
# ifndef isfinite
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   138
#  define isfinite(x)     1
3414
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
   139
# endif
8706
d48896f0a910 mac stuff
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
   140
#endif /* realIX */
d48896f0a910 mac stuff
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
   141
9896
307c7296064e Fix syntax warning in #ifdef
Stefan Vogel <sv@exept.de>
parents: 9636
diff changeset
   142
#ifndef isfinitef
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   143
# define isfinitef(x) isfinite(x)
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   144
#endif
9896
307c7296064e Fix syntax warning in #ifdef
Stefan Vogel <sv@exept.de>
parents: 9636
diff changeset
   145
#ifndef isnanf
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   146
# define isnanf(x) isnan(x)
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   147
#endif
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
   148
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
   149
%}
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
   150
! !
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
   151
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   152
!ShortFloat class methodsFor:'documentation'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
copyright
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
 COPYRIGHT (c) 1996 by Claus Gittinger
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   157
	      All Rights Reserved
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
 This software is furnished under a license and may be used
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
 only in accordance with the terms of that license and with the
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
 inclusion of the above copyright notice.   This software may not
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
 be provided or otherwise made available to, or used by, any
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
 other person.  No title to or ownership of the software is
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
 hereby transferred.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
documentation
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
"
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   172
    ShortFloats represent rational numbers with limited precision.
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   173
    They use the C-compilers 'float' format, which is usually the IEE single float format.
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   174
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   175
    In contrast to Floats (which use the C-compilers 64bit 'double' format),
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   176
    ShortFloats give you 32 bit floats.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
    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
   179
    ST-80's Floats respectively. The reason was to make ST/X's floats compatible
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
   180
    to bothe visualWorks and other smalltalks, which use C-doubles for the Float class.
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
   181
    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
   182
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   183
    This may change in one of the next versions (at least on machines, which
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
    provide different float and double types in their C-compiler.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
    WARNING:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   187
	The layout of shortFloat instances is known by the runtime system and the compiler;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   188
	you may not add instance variables here.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   189
	Also, subclassing is complicated by the fact, that the VM creates floats/shortFloats,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   190
	and does some of its float-checks by an identity compare with the ShortFloat-class.
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   191
	(i.e. your subclasses instances may not be recognized as float-like objects,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   192
	 thus mixed mode arithmetic will always coerce them, effectively slowing things down).
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   193
	This may be changed, to use a flag bit in the class.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   195
    Mixed mode arithmetic:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   196
	shortFloat op shortFloat   -> shortFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   197
	shortFloat op fix         -> shortFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   198
	shortFloat op fraction    -> shortFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   199
	shortFloat op integer     -> shortFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   200
	shortFloat op longFloat   -> longFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   201
	shortFloat op float       -> float
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   202
	shortFloat op complex     -> complex
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   203
7405
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   204
    Representation:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   205
	    32bit single precision IEE floats
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   206
	    23 bit mantissa,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   207
	    8 bit exponent,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   208
	    6 decimal digits (approx)
7405
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   209
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   210
    Range and Precision of Storage Formats: see LimitedPrecisionReal >> documentation
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   211
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   212
    [author:]
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   213
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   214
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   215
    [see also:]
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   216
	Number
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   217
	Float LongFloat Fraction FixedPoint Integer Complex
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   218
	FloatArray DoubleArray
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   222
!ShortFloat class methodsFor:'instance creation'!
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   223
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   224
basicNew
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   225
    "return a new shortFloat - here we return 0.0
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   226
     - shortFloats are usually NOT created this way ...
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   227
     Its implemented here to allow things like binary store & load
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   228
     of shortFloats. (but even this support will go away eventually, its not
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   229
     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
   230
     totally different representation - so floats will eventually be
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   231
     binary stored in a device independent format."
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   232
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   233
%{  /* NOCONTEXT */
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   234
    OBJ newFloat;
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   235
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
   236
    __qMKSFLOAT(newFloat, 0.0);
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   237
    RETURN (newFloat);
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   238
%}
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   239
!
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   240
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   241
fastFromString:aString at:startIndex
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   242
    "return the next ShortFloat from the string starting at startIndex.
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   243
     No spaces are skipped.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   244
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   245
     This is a specially tuned entry (using a low-level C-call), which
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   246
     returns garbage if the argument string is not a valid float number.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   247
     It has been added to allow higher speed string decomposition into numbers,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   248
     especially for mass-data."
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   249
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   250
%{   /* NOCONTEXT */
12486
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
   251
     if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   252
	char *cp = (char *)(__stringVal(aString));
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   253
	int idx = __intVal(startIndex) - 1;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   254
	double atof();
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   255
	double val;
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   256
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   257
	if ((unsigned)idx < __stringSize(aString)) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   258
	    val = atof(cp + idx);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   259
	    RETURN (__MKSFLOAT(val));
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   260
	}
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   261
     }
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   262
%}.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   263
     self primitiveFailed.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   264
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   265
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   266
     ShortFloat fastFromString:'123.45' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   267
     ShortFloat fastFromString:'123.45' at:2
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   268
     ShortFloat fastFromString:'123.45E4' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   269
     ShortFloat fastFromString:'hello123.45E4' at:6
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   270
     ShortFloat fastFromString:'12345' at:1
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   271
     ShortFloat fastFromString:'12345' at:2
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   272
     ShortFloat fastFromString:'12345' at:3
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   273
     ShortFloat fastFromString:'12345' at:4
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   274
     ShortFloat fastFromString:'12345' at:5
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   275
     ShortFloat fastFromString:'12345' at:6
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   276
     ShortFloat fastFromString:'12345' at:0
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   277
     ShortFloat fastFromString:'hello123.45E4' at:1
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   278
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   279
     Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   280
	100000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   281
	    ShortFloat readFrom:'123.45'
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   282
	]
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   283
     ]
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   284
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   285
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   286
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   287
     Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   288
	100000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   289
	    ShortFloat fastFromString:'123.45' at:1
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   290
	]
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   291
     ]
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
!
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   294
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   295
readFrom:aStringOrStream
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   296
    "read a shortFloat from a string"
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   297
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   298
    |num|
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   299
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   300
    num := super readFrom:aStringOrStream onError:[self error:'conversion error for: ' , self name].
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   301
    num notNil ifTrue:[
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   302
	num := num asShortFloat
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   303
    ].
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   304
    ^ num
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   305
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   306
    "
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   307
     ShortFloat readFrom:'0.1'
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   308
     ShortFloat readFrom:'0'
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   309
     ShortFloat readFrom:'.123'
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   310
     ShortFloat readFrom:'-.123'
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   311
     ShortFloat readFrom:'1e4'
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   312
    "
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   313
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   314
    "Modified: / 7.1.1998 / 16:17:59 / cg"
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   315
!
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   316
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   317
readFrom:aStringOrStream onError:exceptionBlock
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   318
    "read a shortFloat from a string"
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   319
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   320
    |num|
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   321
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   322
    num := super readFrom:aStringOrStream onError:nil.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   323
    num isNil ifTrue:[
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   324
	^ exceptionBlock value
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   325
    ].
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   326
    ^ num asShortFloat
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   327
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   328
    "
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   329
     ShortFloat readFrom:'0.1'
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   330
     ShortFloat readFrom:'0'
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   331
     ShortFloat readFrom:'.123'
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   332
    "
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   333
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   334
    "Modified: / 7.1.1998 / 16:17:59 / cg"
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   335
! !
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   336
12915
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   337
!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
   338
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   339
defaultPrintFormat
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   340
    "this is fixed in ShortFloat"
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   341
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   342
    ^ '.6'
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   343
! !
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
   344
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   345
!ShortFloat class methodsFor:'binary storage'!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   346
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   347
readBinaryIEEESingleFrom:aStream
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   348
    "read a float value from the binary stream, aStream,
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   349
     interpreting the next bytes as an IEEE formatted 4-byte float"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   350
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   351
    |f|
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   352
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   353
    f := ShortFloat basicNew.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   354
    self readBinaryIEEESingleFrom:aStream into:f.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   355
    ^ f
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   356
9636
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   357
    "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
   358
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   359
    "Created: / 16-04-1996 / 21:00:35 / cg"
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   360
    "Modified: / 23-08-2006 / 16:01:47 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   363
readBinaryIEEESingleFrom:aStream into:aFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   364
    "read a float value from the binary stream, aStream,
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   365
     interpreting the next bytes as an IEEE formatted 4-byte float.
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   366
     The bytes are read in the nativ byte order (i.e.lsb on intel)"
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   367
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   368
    ^ self readBinaryIEEESingleFrom:aStream into:aFloat MSB:(UninterpretedBytes isBigEndian)
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   369
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   370
    "Modified: / 23-08-2006 / 16:01:52 / cg"
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   371
!
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   372
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   373
readBinaryIEEESingleFrom:aStream into:aFloat MSB:msb
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   374
    "read a float value from the binary stream, aStream,
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   375
     interpreting the next bytes as an IEEE formatted 4-byte float.
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   376
     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
   377
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   378
    aFloat class == self ifFalse:[self error:'no a ShortFloat'].
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   379
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   380
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   381
     this implementation is wrong: does not work on non-IEEE machines
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   382
     (to date all machines where ST/X is running on use
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   383
      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
   384
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   385
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   386
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   387
    (UninterpretedBytes isBigEndian == msb) ifFalse:[
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   388
        "swap the bytes"
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   389
        4 to:1 by:-1 do:[:i |
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   390
            aFloat basicAt:i put:(aStream next)
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   391
        ].
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   392
        ^ self
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   393
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   394
    1 to:4 do:[:i |
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
   395
        aFloat basicAt:i put:aStream next
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   396
    ]
9636
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   397
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   398
    "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
   399
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   400
    "Modified: / 23-08-2006 / 16:01:52 / cg"
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   401
!
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   402
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   403
storeBinaryIEEESingle:aFloat on:aStream
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   404
    "store aFloat as an IEEE formatted 4-byte float
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   405
     onto the binary stream, aStream"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   406
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   407
    |float|
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   408
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   409
    float := aFloat asShortFloat.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   410
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   411
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   412
     this implementation is wrong: does not work on non-IEEE machines
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   413
     (to date all machines where ST/X is running on use
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   414
      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
   415
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   416
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   417
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   418
    UninterpretedBytes isBigEndian ifFalse:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   419
	"swap the bytes"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   420
	4 to:1 by:-1 do:[:i |
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   421
	    aStream nextPut:(float basicAt:i).
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   422
	].
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   423
	^ self
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   424
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   425
    1 to:4 do:[:i |
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
   426
	aStream nextPut:(float basicAt:i).
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   427
    ]
9636
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   428
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   429
    "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
   430
c6b63e749626 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9149
diff changeset
   431
    "Modified: / 23-08-2006 / 16:01:55 / cg"
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   432
! !
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   433
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   434
!ShortFloat class methodsFor:'constants'!
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   435
7392
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   436
e
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   437
    "return the constant e as ShortFloat"
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   438
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   439
    ^ Float e asShortFloat
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   440
!
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   441
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   442
pi
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   443
    "return the constant pi as ShortFloat"
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   444
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   445
    ^ Float pi asShortFloat
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   446
!
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   447
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   448
unity
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   449
    "return the neutral element for multiplication (1.0) as ShortFloat"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   450
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
    ^ 1.0 asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   453
    "Modified: 23.4.1996 / 09:26:51 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
zero
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   457
    "return the neutral element for addition (0.0) as ShortFloat"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   458
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
    ^ 0.0 asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   461
    "Modified: 23.4.1996 / 09:26:45 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   464
!ShortFloat class methodsFor:'queries'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
6898
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   466
exponentCharacter
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   467
    ^ $e
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   468
!
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   469
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   471
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   472
     Here, true is returned for myself, false for subclasses."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
    ^ self == ShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   476
    "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
   477
!
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   478
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   479
isIEEEFormat
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   480
    "return true, if this machine represents floats in IEEE format.
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   481
     Currently, no support is provided for non-ieee machines
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   482
     to convert their floats into this (which is only relevant,
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   483
     if such a machine wants to send floats as binary to some other
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   484
     machine).
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   485
     Machines with non-IEEE format are VAXed and IBM370-type systems
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   486
     (among others). Today, most systems use IEEE format floats."
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   487
14920
Claus Gittinger <cg@exept.de>
parents: 14744
diff changeset
   488
%{
Claus Gittinger <cg@exept.de>
parents: 14744
diff changeset
   489
#ifdef __s390__
Claus Gittinger <cg@exept.de>
parents: 14744
diff changeset
   490
    RETURN(false);
Claus Gittinger <cg@exept.de>
parents: 14744
diff changeset
   491
#endif
Claus Gittinger <cg@exept.de>
parents: 14744
diff changeset
   492
%}.
Claus Gittinger <cg@exept.de>
parents: 14744
diff changeset
   493
3427
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   494
    ^ true "/ this may be a lie
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   495
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   496
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   497
numBitsInExponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   498
    "answer the number of bits in the exponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   499
     This is an IEEE float, where 8 bits are available:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   500
	seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   501
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   502
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   503
    ^ 8
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   504
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   505
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   506
numBitsInMantissa
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   507
    "answer the number of bits in the mantissa.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   508
     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
   509
	seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   510
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   511
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   512
    ^ 23
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   513
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   514
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   515
precision
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   516
    "answer the precision of a ShortFloat (in bits)
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   517
     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
   518
     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
   519
     (although only 23 are needed in the binary representation)"
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   520
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   521
    ^  24
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   522
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   523
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   524
radix
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   525
    "answer the radix of a ShortFloats exponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   526
     This is an IEEE float, which is represented as binary"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   527
9149
3fb15c4d83d8 comment
Claus Gittinger <cg@exept.de>
parents: 9121
diff changeset
   528
    ^ 2 "must be careful here, whenever ST/X is used on a VAX or a 370"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   529
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   530
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   531
!ShortFloat methodsFor:'arithmetic'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   532
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   533
* aNumber
11730
eabe6364c89b comment
Claus Gittinger <cg@exept.de>
parents: 11720
diff changeset
   534
    "return the product of the receiver and the argument."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   535
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   536
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   537
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   538
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   539
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   540
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   541
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   542
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   543
	result = __shortFloatVal(self) * (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   545
	__qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   546
	RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   547
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   548
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   549
	result = __shortFloatVal(self) * __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   550
	goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   551
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   552
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   553
	dResult = (double) __shortFloatVal(self)* __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   554
	__qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   555
	RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   556
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   557
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
    ^ aNumber productFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   559
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   560
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
+ aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   562
    "return the sum of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   563
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   569
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   570
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   571
	result = __shortFloatVal(self) + (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   573
	__qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   574
	RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   575
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   576
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   577
	result = __shortFloatVal(self) + __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   578
	goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   579
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   580
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   581
	dResult = (double) __shortFloatVal(self) + __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   582
	__qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   583
	RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   584
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   585
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
    ^ aNumber sumFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   588
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
- aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   590
    "return the difference of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   591
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   595
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   596
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   597
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   598
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   599
	result = __shortFloatVal(self) - (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   600
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   601
	__qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   602
	RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   603
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   604
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   605
	result = __shortFloatVal(self) - __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   606
	goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   607
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   608
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   609
	dResult = (double) __shortFloatVal(self) - __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   610
	__qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   611
	RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   612
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   614
    ^ aNumber differenceFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   615
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   616
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
/ aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   618
    "return the quotient of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   619
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   620
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
    float result, val;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   624
    double dResult, dVal;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   627
	if (aNumber != __mkSmallInteger(0)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   628
	    result = __shortFloatVal(self) / (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   629
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   630
	    __qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   631
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   632
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   633
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   634
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   635
	val = __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   636
	if (val != 0.0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   637
	    result = __shortFloatVal(self) / val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   638
	    goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   639
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   640
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   641
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   642
	dVal = __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   643
	if (dVal != 0.0) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   644
	    dResult = (double) __shortFloatVal(self) / dVal;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   645
	    __qMKFLOAT(newFloat, dResult);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   646
	    RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   647
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   648
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   649
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   650
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   651
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   652
	 No, you shalt not divide by zero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   653
	"
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   654
	^ ZeroDivide raiseRequestWith:thisContext.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   655
    ].
4166
5730ad6b744b oops - from coercion in quotient / uncheckedQuotient
Claus Gittinger <cg@exept.de>
parents: 4100
diff changeset
   656
    ^ aNumber quotientFromShortFloat:self
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   657
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   658
14710
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   659
abs
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   660
    "return the absolute value of the receiver
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   661
     reimplemented here for speed"
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   662
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   663
%{  /* NOCONTEXT */
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   664
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   665
    OBJ newFloat;
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   666
    float val = __shortFloatVal(self);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   667
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   668
    if (val < 0.0) {
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   669
	__qMKSFLOAT(newFloat, -val);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   670
	RETURN ( newFloat );
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   671
    }
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   672
    RETURN (self);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   673
%}.
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   674
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   675
    "
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   676
     3.0 asShortFloat abs
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   677
     -3.0 asShortFloat abs
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   678
    "
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   679
!
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   680
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   681
negated
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   682
    "return myself negated"
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   683
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   684
%{  /* NOCONTEXT */
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   685
    OBJ newFloat;
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   686
    float rslt = - __shortFloatVal(self);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   687
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   688
    __qMKSFLOAT(newFloat, rslt);
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   689
    RETURN ( newFloat );
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   690
%}.
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   691
    ^ 0.0 - self
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   692
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   693
!
db1edb5f0b67 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14709
diff changeset
   694
14690
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   695
rem: aNumber
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   696
    "return the floating point remainder of the receiver and the argument, aNumber"
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   697
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   698
%{  /* NOCONTEXT */
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   699
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   700
    /*
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   701
     * notice:
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   702
     * the following inline code handles some common cases,
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   703
     * and exists as an optimization, to speed up those cases.
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   704
     *
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   705
     * Conceptionally, (and for most other argument types),
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   706
     * mixed arithmetic is implemented by double dispatching
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   707
     * (see the message send at the bottom)
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   708
     */
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   709
    OBJ newFloat;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   710
    float result, val;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   711
    double dResult, dVal;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   712
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   713
    if (__isSmallInteger(aNumber)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   714
	if (aNumber != __mkSmallInteger(0)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   715
	    val = (float)__intVal(aNumber);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   716
computeResult:
14709
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   717
#ifdef NO_FMODF
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   718
	    dResult = fmod((double)__shortFloatVal(self), (double)val) ;
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   719
	    result = (float)dResult;
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   720
#else
14690
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   721
	    result = fmodf(__shortFloatVal(self), val) ;
14709
9ba9a2c9e132 ouch: fmodf is not avail with borland
Claus Gittinger <cg@exept.de>
parents: 14690
diff changeset
   722
#endif
14690
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   723
	    __qMKSFLOAT(newFloat, result);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   724
	    RETURN ( newFloat );
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   725
	}
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   726
    } else if (__isFloatLike(aNumber)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   727
	dVal = __floatVal(aNumber);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   728
	if (dVal != 0.0) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   729
	    dResult = fmod((double)(__shortFloatVal(self)), dVal) ;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   730
	    __qMKFLOAT(newFloat, dResult);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   731
	    RETURN ( newFloat );
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   732
	}
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   733
    } else if (__isShortFloat(aNumber)) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   734
	val = __shortFloatVal(aNumber);
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   735
	if (val != 0.0) {
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   736
	    goto computeResult;
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   737
	}
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   738
    }
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   739
%}.
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   740
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   741
	"
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   742
	 No, you shalt not divide by zero
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   743
	"
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   744
	^ ZeroDivide raiseRequestWith:thisContext.
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   745
    ].
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   746
    ^ aNumber remainderFromShortFloat:self
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   747
!
5934219d333a added rem:
Claus Gittinger <cg@exept.de>
parents: 14673
diff changeset
   748
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   749
uncheckedDivide:aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   750
    "return the quotient of the receiver and the argument, aNumber.
7471
c5d4bd612d9f comments
Claus Gittinger <cg@exept.de>
parents: 7437
diff changeset
   751
     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
   752
     This operation is provided for emulators of other languages/semantics,
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   753
     where no exception is raised for these results (i.e. Java).
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   754
     Its only defined if the arguments type is the same as the receivers."
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   755
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   756
%{  /* NOCONTEXT */
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   757
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   758
    OBJ newFloat;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   759
    float result, val;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   760
    double dResult, dVal;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   761
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   762
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   763
	result = __shortFloatVal(self) / (float)(__intVal(aNumber));
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   764
retResult:
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   765
	__qMKSFLOAT(newFloat, result);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   766
	RETURN ( newFloat );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   767
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   768
    if (__isShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   769
	val = __shortFloatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   770
	result = __shortFloatVal(self) / val;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   771
	goto retResult;
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   772
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   773
    if (__isFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   774
	dVal = __floatVal(aNumber);
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   775
	dResult = (double) __shortFloatVal(self) / dVal;
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 );
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   778
    }
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   779
%}.
4166
5730ad6b744b oops - from coercion in quotient / uncheckedQuotient
Claus Gittinger <cg@exept.de>
parents: 4100
diff changeset
   780
    ^ aNumber quotientFromShortFloat:self
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   781
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   782
    "
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   783
      0.0 asShortFloat uncheckedDivide:0
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   784
      1.0 asShortFloat uncheckedDivide:0.0
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   785
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
5257
a90fd9cb3c18 category rename
Claus Gittinger <cg@exept.de>
parents: 5120
diff changeset
   788
!ShortFloat methodsFor:'coercing & converting'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   789
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   790
asFloat
11238
f321de80643a comment
Claus Gittinger <cg@exept.de>
parents: 9896
diff changeset
   791
    "return a Float with same value as the receiver.
f321de80643a comment
Claus Gittinger <cg@exept.de>
parents: 9896
diff changeset
   792
     Redefined for performance (machine can do it faster)"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   796
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
    double dVal = (double)__shortFloatVal(self);
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
   799
    __qMKFLOAT(newFloat, dVal);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   800
    RETURN ( newFloat );
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   801
%}
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   802
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   804
     1.0 asShortFloat asFloat
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   805
    "
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
asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   809
    "return an integer with same value - might truncate"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   810
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   811
%{  /* NOCONTEXT */
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1583
diff changeset
   812
    float fVal;
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   813
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1583
diff changeset
   814
    fVal = __shortFloatVal(self);
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
   815
#ifdef WIN32
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   816
    if (! isnanf(fVal))
7419
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
   817
#endif
44b2f66791f1 isnanf for Win32
Claus Gittinger <cg@exept.de>
parents: 7408
diff changeset
   818
    {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   819
	if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   820
	    RETURN ( __mkSmallInteger( (INT)fVal) );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   821
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   822
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   823
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   824
    ^ super asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   825
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   826
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   827
     12345.0 asShortFloat asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
     1e15 asShortFloat asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   829
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   830
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   831
7437
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
   832
asLongFloat
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
   833
    ^ LongFloat fromShortFloat:self
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
   834
!
834ea4d6cdbc oops - printString of NaN/INF where wrong;
Claus Gittinger <cg@exept.de>
parents: 7419
diff changeset
   835
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   836
asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
    "return a ShortFloat with same value as the receiver - thats me"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
    ^ self
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   840
!
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   841
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   842
coerce:aNumber
11720
79b29ccf5f3c comment
Claus Gittinger <cg@exept.de>
parents: 11238
diff changeset
   843
    "convert the argument aNumber into an instance of the receivers class and return it."
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   844
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   845
    ^ aNumber asShortFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   846
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   847
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   848
generality
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   849
    "return the generality value - see ArithmeticValue>>retry:coercing:"
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   850
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   851
    ^ 70
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   852
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   853
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
!ShortFloat methodsFor:'comparing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   858
< aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   859
    "return true, if the argument is greater"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   860
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   861
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   862
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   863
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   864
	RETURN ( (__shortFloatVal(self) < (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   865
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   866
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   867
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   868
	    RETURN ( (double)(__shortFloatVal(self) < __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   869
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   870
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   871
	    RETURN ( (__shortFloatVal(self) < __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   872
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   873
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   874
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   875
    ^ aNumber lessFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   876
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   877
    "
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   878
     1.0 asShortFloat > (1/3)
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   879
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
<= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   883
    "return true, if the argument is greater or equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   884
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   885
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   886
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   887
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   888
	RETURN ( (__shortFloatVal(self) <= (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   889
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   890
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   891
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   892
	    RETURN ( (double)(__shortFloatVal(self) <= __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   893
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   894
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   895
	    RETURN ( (__shortFloatVal(self) <= __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   896
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   897
    }
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   898
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   899
    ^ self retry:#<= coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   900
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   901
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   902
= aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   903
    "return true, if the argument represents the same numeric value
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   904
     as the receiver, false otherwise"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   905
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   906
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   907
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   908
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   909
	RETURN ( (__shortFloatVal(self) == (float)(__intVal(aNumber))) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   910
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   911
    if (aNumber == nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   912
	RETURN (false);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   913
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   914
    if (__qIsFloatLike(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   915
	RETURN ( (double)(__shortFloatVal(self) == __floatVal(aNumber)) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   916
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   917
    if (__qIsShortFloat(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   918
	RETURN ( (__shortFloatVal(self) == __shortFloatVal(aNumber)) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   919
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   920
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   921
    ^ aNumber equalFromShortFloat:self
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   922
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   923
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   924
> aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   925
    "return true, if the argument is less"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   926
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   927
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   928
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   929
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   930
	RETURN ( (__shortFloatVal(self) > (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   931
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   932
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   933
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   934
	    RETURN ( (double)(__shortFloatVal(self) > __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   935
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   936
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   937
	    RETURN ( (__shortFloatVal(self) > __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   938
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   939
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   940
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   941
    ^ self retry:#> coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   942
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   943
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   944
>= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   945
    "return true, if the argument is less or equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   946
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   947
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   948
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   949
    if (__isSmallInteger(aNumber)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   950
	RETURN ( (__shortFloatVal(self) >= (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   951
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   952
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   953
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   954
	    RETURN ( (double)(__shortFloatVal(self) >= __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   955
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   956
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   957
	    RETURN ( (__shortFloatVal(self) >= __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   958
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   959
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   960
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   961
    ^ self retry:#>= coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   962
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   963
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   964
hash
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   965
    "return a number for hashing; redefined, since floats compare
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   966
     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
   967
     as 3 hash."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   968
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   969
    |i|
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   970
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   971
    (self >= SmallInteger minVal and:[self <= SmallInteger maxVal]) ifTrue:[
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   972
	i := self asInteger.
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   973
	self = i ifTrue:[
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   974
	    ^ i hash
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   975
	].
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   976
    ].
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   977
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   978
    ^ self asFloat hash
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   979
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   980
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   981
     1.2345 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   982
     1.2345 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   983
     1.0 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   984
     1.0 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   985
     0.5 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   986
     0.25 asShortFloat hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   987
     0.5 hash
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   988
     0.25 hash
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   989
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   990
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   991
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   992
~= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   993
    "return true, if the arguments value are not equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   994
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   995
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   996
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   997
    if (aNumber != nil) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   998
	if (__isSmallInteger(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
   999
	    RETURN ( (__shortFloatVal(self) != (float)(__intVal(aNumber))) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1000
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1001
	if (__qIsFloatLike(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1002
	    RETURN ( (double)(__shortFloatVal(self) !=  __floatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1003
	}
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1004
	if (__qIsShortFloat(aNumber)) {
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1005
	    RETURN ( (__shortFloatVal(self) !=  __shortFloatVal(aNumber)) ? true : false );
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1006
	}
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1007
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1008
	RETURN ( true );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1009
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1010
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1011
    ^ super ~= aNumber
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1012
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1013
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1014
!ShortFloat methodsFor:'mathematical functions'!
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1015
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1016
fastInverseSqrt
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1017
    "return a rough but fast approximation of (1 / self sqrt).
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1018
     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
  1019
     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
  1020
     much, unless inlined into the sender code.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1021
     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
  1022
     (to speed up 3D computations, for example).
1aac241c9981 comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13359
diff changeset
  1023
     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
  1024
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1025
%{  /* NOCONTEXT */
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1026
    float x, rslt;
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1027
    OBJ newFloat;
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1028
13361
Michael Beyl <mb@exept.de>
parents: 13360
diff changeset
  1029
    if (sizeof(float) == 4) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1030
	x = __shortFloatVal(self);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1031
	{
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1032
	    float xhalf = 0.5f * x;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1033
	    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
  1034
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1035
	    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
  1036
	    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
  1037
	    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
  1038
	    __qMKSFLOAT(newFloat, x);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1039
	    RETURN ( newFloat );
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1040
	}
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1041
    }
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1042
%}.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1043
    ^ 1 / self sqrt
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1044
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1045
    "
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1046
     10.0 asShortFloat fastInverseSqrt
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1047
     (1 / 10.0 asShortFloat sqrt)
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1048
    "
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1049
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1050
    "
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1051
     |a b t0 t1 t2|
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1052
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1053
     a := 345 asShortFloat.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1054
     t0 := Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1055
	1000000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1056
	]
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1057
     ].
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1058
     t1 := Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1059
	1000000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1060
	    a fastInverseSqrt
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1061
	]
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1062
     ].
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1063
     t2 := Time millisecondsToRun:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1064
	1000000 timesRepeat:[
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1065
	    (1 / a sqrt)
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1066
	]
13359
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1067
     ].
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1068
     Transcript show:'empty: '; showCR:t0.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1069
     Transcript show:'fast: '; showCR:t1.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1070
     Transcript show:'regular: '; showCR:t2.
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1071
    "
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1072
! !
17228556cabd comment/format in: #fastInverseSqrt
Claus Gittinger <cg@exept.de>
parents: 13358
diff changeset
  1073
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1074
!ShortFloat methodsFor:'printing & storing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1075
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1076
printString
3194
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
  1077
    "return a printed representation of the receiver
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
  1078
     LimitedPrecisonReal and its subclasses use #printString instead of
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
  1079
     #printOn: as basic print mechanism."
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
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1082
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1083
    char buffer[64];
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1084
    REGISTER char *cp;
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1085
    int len;
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1086
    OBJ s;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1087
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1088
    /*
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1089
     * actually only needed on sparc: since thisContext is
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1090
     * in a global register, which gets destroyed by printf,
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1091
     * manually save it here - very stupid ...
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1092
     */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1093
    __BEGIN_PROTECT_REGISTERS__
12915
d80685e8f20e #printString prints with maximum precision (15 for Float and 19 for LongFloat)
Stefan Vogel <sv@exept.de>
parents: 12629
diff changeset
  1094
    len = snprintf(buffer, sizeof(buffer), "%.6g", (float)__shortFloatVal(self));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1095
    __END_PROTECT_REGISTERS__
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1096
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1097
    if (len >= 0 && len <= sizeof(buffer)-3) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1098
	/*
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1099
	 * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1100
	 * (i.e. look if string contains '.' or 'e' and append '.0' if not)
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1101
	 */
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1102
	for (cp = buffer; *cp; cp++) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1103
	    if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1104
	}
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1105
	if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1106
	    if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1107
		*cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1108
	    } else {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1109
		*cp++ = '.';
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1110
	    }
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1111
	    *cp++ = '0';
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1112
	    *cp = '\0';
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1113
	} else {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1114
	    if (cp && (*cp == '.')) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1115
		if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1116
		    *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1117
		}
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1118
	    }
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1119
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1120
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1121
	s = __MKSTRING(buffer);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1122
	if (s != nil) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1123
	    RETURN (s);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1124
	}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1125
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1126
%}.
5432
c71559a881e2 migration support
Claus Gittinger <cg@exept.de>
parents: 5411
diff changeset
  1127
    ^ self asFloat printString
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1128
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1129
    "
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1130
	1.234 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1131
	1.0 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1132
	1e10 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1133
	1.2e3 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1134
	1.2e30 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1135
	(1.0 uncheckedDivide:0) asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1136
	(0.0 uncheckedDivide:0) asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1137
	self pi printString.
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1138
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1139
	DecimalPointCharacterForPrinting := $,.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1140
	1.234 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1141
	1.0 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1142
	1e10 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1143
	1.2e3 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1144
	1.2e30 asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1145
	(1.0 uncheckedDivide:0) asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1146
	(0.0 uncheckedDivide:0) asShortFloat printString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1147
	DecimalPointCharacterForPrinting := $.
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1148
    "
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1149
!
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1150
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1151
printfPrintString:formatString
7746
4a4208ef7699 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7725
diff changeset
  1152
    "non-standard: return a printed representation of the receiver
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1153
     as specified by formatString, which is defined by printf.
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1154
     If you use this, be aware, that specifying doubles differs on
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1155
     systems; on SYSV machines you have to give something like %lf,
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1156
     while on BSD systems the format string has to be %F.
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1157
     Also, the resulting string may not be longer than 255 bytes -
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1158
     since thats the (static) size of the buffer.
11924
db93de0d761d changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11730
diff changeset
  1159
     This method is NONSTANDARD and may be removed without notice.
db93de0d761d changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11730
diff changeset
  1160
     WARNNG: this goes directly to the C-printf function and may therefore me inherently unsafe.
db93de0d761d changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11730
diff changeset
  1161
     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
  1162
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1163
%{  /* STACK: 400 */
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1164
    char buffer[256];
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1165
    OBJ s;
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1166
    int len;
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1167
12486
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  1168
    if (__isStringLike(formatString)) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1169
	/*
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1170
	 * actually only needed on sparc: since thisContext is
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1171
	 * in a global register, which gets destroyed by printf,
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1172
	 * manually save it here - very stupid ...
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1173
	 */
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1174
	__BEGIN_PROTECT_REGISTERS__
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1175
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1176
	len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __shortFloatVal(self));
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1177
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1178
	__END_PROTECT_REGISTERS__
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1179
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1180
	if (len < 0) goto fail;
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1181
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1182
	s = __MKSTRING_L(buffer, len);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1183
	if (s != nil) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1184
	    RETURN (s);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1185
	}
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1186
    }
8418
37ccc74bbf9e Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
  1187
fail: ;
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1188
%}.
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1189
    self primitiveFailed
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1190
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1191
    "ShortFloat pi printfPrintString:'%%lg -> %lg'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1192
    "ShortFloat pi printfPrintString:'%%lf -> %lf'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1193
    "ShortFloat pi printfPrintString:'%%7.5lg -> %7.5lg'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1194
    "ShortFloat pi printfPrintString:'%%G -> %G'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1195
    "ShortFloat pi printfPrintString:'%%F -> %F'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1196
    "ShortFloat pi printfPrintString:'%%7.5G -> %7.5G'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
  1197
    "ShortFloat pi printfPrintString:'%%7.5F -> %7.5F'"
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1198
!
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1199
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1200
storeString
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1201
    "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
  1202
     all valid digits are printed.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1203
     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
  1204
     #storeOn: as basic print mechanism."
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1205
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1206
%{  /* NOCONTEXT */
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1207
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1208
    char buffer[64];
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1209
    REGISTER char *cp;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1210
    OBJ s;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1211
    int len;
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1212
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1213
    /*
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1214
     * build a printf format string
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1215
     */
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1216
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1217
    __BEGIN_PROTECT_REGISTERS__
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1218
#ifdef SYSV
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1219
    len = snprintf(buffer, sizeof(buffer), "%.6lg", (double)__shortFloatVal(self));
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1220
#else
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1221
    len = snprintf(buffer, sizeof(buffer), "%.6G", (double)__shortFloatVal(self));
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1222
#endif
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1223
    __END_PROTECT_REGISTERS__
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1224
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1225
    if (len >= 0 && len < sizeof(buffer)-3) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1226
	/*
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1227
	 * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1228
	 * (i.e. look if string contains '.' or 'e' and append '.0' if not)
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1229
	 */
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1230
	for (cp = buffer; *cp; cp++) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1231
	    if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1232
	}
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1233
	if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1234
	    *cp++ = '.';
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1235
	    *cp++ = '0';
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1236
	    *cp = '\0';
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1237
	}
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1238
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1239
	s = __MKSTRING(buffer);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1240
	if (s != nil) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1241
	    RETURN (s);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1242
	}
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1243
    }
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1244
%}.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1245
    "
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1246
     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
  1247
     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
  1248
     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
  1249
     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
  1250
     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
  1251
    "
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1252
    ^ ObjectMemory allocationFailureSignal raise.
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1253
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1254
    "
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1255
	1.0 asShortFloat storeString
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1256
	1.234 asShortFloat storeString
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1257
	1e10 asShortFloat storeString
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1258
	1.2e3 asShortFloat storeString
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1259
	1.2e30 asShortFloat storeString
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1260
	Float pi asShortFloat storeString
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1261
	(1.0 uncheckedDivide:0) asShortFloat storeString
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1262
	(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
  1263
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1264
     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
  1265
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1266
	DecimalPointCharacterForPrinting := $,.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1267
	1.234 asShortFloat storeString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1268
	1.0 asShortFloat storeString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1269
	1e10 asShortFloat storeString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1270
	1.2e3 asShortFloat storeString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1271
	1.2e30 asShortFloat storeString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1272
	(1.0 uncheckedDivide:0) asShortFloat storeString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1273
	(0.0 uncheckedDivide:0) asShortFloat storeString.
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1274
	DecimalPointCharacterForPrinting := $.
8422
c206b4711b6e Define #storeString to not use DecimalPointCharacter and to
Stefan Vogel <sv@exept.de>
parents: 8418
diff changeset
  1275
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1276
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1277
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1278
!ShortFloat methodsFor:'private accessing'!
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1279
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1280
basicAt:index
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1281
    "return an internal byte of the float.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1282
     The value returned here depends on byte order, float representation etc.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1283
     Therefore, this method should be used strictly private.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1284
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1285
     Notice:
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1286
	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
  1287
	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
  1288
	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
  1289
	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
  1290
	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
  1291
	values as if this filler wasnt present."
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1292
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1293
%{  /* NOCONTEXT */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1294
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1295
    register int indx;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1296
    unsigned char *cp;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1297
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1298
    /*
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1299
     * notice the missing test for self being a nonNilObject -
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1300
     * this can be done since basicAt: is defined both in UndefinedObject
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1301
     * and SmallInteger
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1302
     */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1303
    if (__isSmallInteger(index)) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1304
	indx = __intVal(index) - 1;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1305
	if (((unsigned)(indx)) < sizeof(float)) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1306
	    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
  1307
	    RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1308
	}
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1309
    }
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1310
%}.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1311
    ^ self indexNotIntegerOrOutOfBounds:index
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1312
!
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1313
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1314
basicAt:index put:value
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1315
    "set an internal byte of the float.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1316
     The value to be stored here depends on byte order, float representation etc.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1317
     Therefore, this method should be used strictly private.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1318
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1319
     Notice:
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1320
	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
  1321
	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
  1322
	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
  1323
	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
  1324
	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
  1325
	values as if this filler wasnt present."
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1326
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1327
%{  /* NOCONTEXT */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1328
    register int indx, val;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1329
    unsigned char *cp;
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1330
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1331
    /*
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1332
     * notice the missing test for self being a nonNilObject -
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1333
     * this can be done since basicAt: is defined both in UndefinedObject
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1334
     * and SmallInteger
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1335
     */
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1336
    if (__bothSmallInteger(index, value)) {
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1337
	val = __intVal(value);
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1338
	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
  1339
	    indx = __intVal(index) - 1;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1340
	    if (((unsigned)(indx)) < sizeof(float)) {
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1341
		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
  1342
		cp[indx] = val;
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1343
		RETURN ( value );
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1344
	    }
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1345
	}
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1346
    }
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1347
%}.
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1348
    value isInteger ifFalse:[
14673
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1349
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1350
	 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
  1351
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1352
	^ self elementNotInteger
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1353
    ].
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1354
    (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
  1355
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1356
	 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
  1357
	"
d3c91be01e96 setlocale only once and for all in stxmain
Claus Gittinger <cg@exept.de>
parents: 14601
diff changeset
  1358
	^ self elementBoundsError:value
12628
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1359
    ].
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1360
    ^ self indexNotIntegerOrOutOfBounds:index
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1361
! !
Claus Gittinger <cg@exept.de>
parents: 12486
diff changeset
  1362
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1363
!ShortFloat methodsFor:'special access'!
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1364
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1365
exponent
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1366
    "extract a normalized floats exponent.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1367
     The returned value depends on the float-representation of
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1368
     the underlying machine and is therefore highly unportable.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1369
     This is not for general use.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1370
     This assumes that the mantissa is normalized to
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1371
     0.5 .. 1.0 and the floats value is mantissa * 2^exp"
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1372
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1373
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1374
    int exp;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1375
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1376
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1377
    frexpf( __shortFloatVal(self), &exp);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1378
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1379
    frexp( (double)(__shortFloatVal(self)), &exp);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1380
#endif
14744
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
  1381
    RETURN (__mkSmallInteger(exp));
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1382
%}.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1383
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1384
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1385
     4.0 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1386
     2.0 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1387
     1.0 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1388
     0.5 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1389
     0.25 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1390
     0.00000011111 asShortFloat exponent
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1391
    "
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1392
!
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1393
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1394
mantissa
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1395
    "extract a normalized floats mantissa.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1396
     The returned value depends on the float-representation of
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1397
     the underlying machine and is therefore highly unportable.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1398
     This is not for general use.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1399
     This assumes that the mantissa is normalized to
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1400
     0.5 .. 1.0 and the floats value is mantissa * 2^exp"
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1401
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1402
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1403
    int exp;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1404
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1405
#if defined(__i386__) && defined(__GNUC__)
14744
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
  1406
    float frac = frexpf(__shortFloatVal(self), &exp);
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
  1407
    RETURN (__MKSFLOAT(frac));
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1408
#else
14744
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
  1409
    double frac = frexp( (double)(__shortFloatVal(self)), &exp);
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
  1410
    RETURN (__MKFLOAT(frac));
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1411
#endif
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1412
%}.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1413
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1414
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1415
     1.0 asShortFloat exponent
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1416
     1.0 asShortFloat mantissa
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1417
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1418
     0.5 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1419
     0.5 asShortFloat mantissa
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1420
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1421
     0.25 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1422
     0.25 asShortFloat mantissa
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1423
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1424
     0.00000011111 asShortFloat exponent
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1425
     0.00000011111 asShortFloat mantissa
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1426
    "
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1427
! !
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1428
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1429
!ShortFloat methodsFor:'testing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1430
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1431
isFinite
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1432
    "return true, if the receiver is a finite float
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1433
     i.e. not NaN and not infinite."
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1434
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1435
%{  /* NOCONTEXT */
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
  1436
    float fV = __shortFloatVal(self);
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1437
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1438
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1439
     * notice: on machines which do not provide
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1440
     * a isfinite() macro or function (WIN32),
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
  1441
     * 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
  1442
     */
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1443
    if (isfinitef(fV)) { RETURN (true); }
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1444
%}.
8980
abee9fcb0385 cleanup isfinite() and isnan() - usage (HPUX)
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
  1445
    ^ false
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1446
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1447
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1448
	1.0 asShortFloat isFinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1449
	(0.0 asShortFloat uncheckedDivide: 0.0) isFinite
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1450
	(1.0 asShortFloat uncheckedDivide: 0.0) isFinite
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1451
    "
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1452
!
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1453
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1454
isNaN
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1455
    "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
  1456
     These are not created by ST/X float operations (they raise an exception);
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1457
     however, inline C-code could produce them ..."
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1458
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1459
%{  /* NOCONTEXT */
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1460
    float sV = __shortFloatVal(self);
3139
ca
parents: 3014
diff changeset
  1461
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1462
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1463
     * notice: on machines which do not provide
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1464
     * a isnan() macro or function (WIN32),
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
  1465
     * 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
  1466
     */
9121
561e28aa22f9 fixed: isNaN and isFinite (for WIN32)
Claus Gittinger <cg@exept.de>
parents: 8984
diff changeset
  1467
    if (isnanf(sV)) { RETURN (true); }
2392
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  1468
%}.
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  1469
    ^ false
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1470
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1471
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1472
     1.0 asShortFloat isNaN
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1473
     (0.0 asShortFloat uncheckedDivide: 0.0) isNaN
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1474
     (0.0 asShortFloat uncheckedDivide: 0.0 asShortFloat) isNaN
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1475
    "
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1476
!
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1477
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1478
isNegativeZero
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1479
    "many systems have two float.Pnt zeros"
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1480
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1481
%{
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1482
#if defined(__i386__) && defined(linux)
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1483
    RETURN ((__ByteArrayInstPtr(self)->ba_element[sizeof(float)-1] == 128) ? true : false );
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1484
#endif
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1485
%}.
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1486
    ^ super isNegativeZero
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1487
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1488
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1489
     0.0 asShortFloat isNegativeZero
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1490
     -0.0 asShortFloat isNegativeZero
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1491
    "
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1492
!
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1493
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1494
negative
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1495
    "return true if the receiver is less than zero"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1496
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1497
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1498
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1499
    RETURN ( (__shortFloatVal(self) < 0.0) ? true : false );
5411
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
  1500
%}.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1501
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1502
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1503
numberOfBits
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1504
    "return the size (in bits) of the real;
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1505
     typically, 32 is returned here,
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1506
     but who knows ..."
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1507
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1508
%{  /* NOCONTEXT */
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1509
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1510
    RETURN (__mkSmallInteger (sizeof(float) * 8));
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1511
%}
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1512
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1513
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1514
     1.2 numberOfBits
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1515
     1.2 asShortFloat numberOfBits
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1516
    "
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1517
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1518
!
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1519
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1520
positive
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1521
    "return true if the receiver is greater or equal to zero"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1522
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1523
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1524
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1525
    RETURN ( (__shortFloatVal(self) >= 0.0) ? true : false );
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1526
%}
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1527
!
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1528
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1529
strictlyPositive
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1530
    "return true if the receiver is greater than zero"
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1531
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1532
%{  /* NOCONTEXT */
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1533
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1534
    RETURN ( (__shortFloatVal(self) > 0.0) ? true : false );
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1535
%}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1536
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1537
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5432
diff changeset
  1538
!ShortFloat methodsFor:'truncation & rounding'!
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1539
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1540
ceiling
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1541
    "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
  1542
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1543
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1544
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1545
%{
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1546
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1547
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1548
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1549
    fVal = ceilf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1550
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1551
    fVal = (float)(ceil((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1552
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1553
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1554
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1555
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1556
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1557
	RETURN ( __mkSmallInteger( (INT) fVal ) );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1558
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1559
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1560
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1561
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1562
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1563
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1564
     0.5 asShortFloat ceiling
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1565
     -0.5 asShortFloat ceiling
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1566
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1567
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1568
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1569
ceilingAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1570
    "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
  1571
     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
  1572
     of the result to an integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1573
     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
  1574
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1575
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1576
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1577
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1578
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1579
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1580
    fVal = ceilf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1581
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1582
    fVal = (float) ceil((double)__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1583
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1584
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1585
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1586
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1587
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1588
     0.5 asShortFloat ceilingAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1589
     -0.5 asShortFloat ceilingAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1590
     -1.5 asShortFloat ceilingAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1591
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1592
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1593
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1594
floor
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1595
    "return the integer nearest the receiver towards negative infinity."
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1596
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1597
    |val|
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1598
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1599
%{
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1600
    float fVal;
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1601
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1602
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1603
    fVal = floorf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1604
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1605
    fVal = (float)(floor((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1606
#endif
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1607
    /*
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1608
     * ST-80 (and X3J20) returns integer.
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1609
     */
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1610
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1611
	RETURN ( __mkSmallInteger( (INT) fVal ) );
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1612
    }
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1613
    __qMKSFLOAT(val, fVal);
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1614
%}.
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1615
    ^ val asInteger
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1616
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1617
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1618
     0.5 asShortFloat floor
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1619
     -0.5 asShortFloat floor
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1620
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1621
!
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1622
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1623
floorAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1624
    "return the float which represents the next lower
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1625
     integer nearest the receiver towards negative infinity.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1626
     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
  1627
     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
  1628
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1629
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1630
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1631
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1632
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1633
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1634
    fVal = floorf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1635
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1636
    fVal = (float)(floor((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1637
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1638
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1639
    RETURN ( v );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1640
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1641
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1642
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1643
     0.5 asShortFloat floorAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1644
     -0.5 asShortFloat floorAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1645
    "
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1646
!
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1647
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1648
fractionPart
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1649
    "extract the after-decimal fraction part.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1650
     such that (self truncated + self fractionPart) = self"
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1651
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1652
%{  /* NOCONTEXT */
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1653
#ifdef NO_MODFF
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1654
    double dFrac, dTrunc;
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1655
#else
14741
4a898f7517d5 hack for visualc
Claus Gittinger <cg@exept.de>
parents: 14727
diff changeset
  1656
# ifndef __VISUALC__
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1657
    float modff(float, float *);
14741
4a898f7517d5 hack for visualc
Claus Gittinger <cg@exept.de>
parents: 14727
diff changeset
  1658
# endif
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1659
#endif
14718
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1660
    float frac, trunc;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1661
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  1662
    __threadErrno = 0;
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1663
#ifdef NO_MODFF
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1664
	dFrac = modf((double)__shortFloatVal(self), &dTrunc) ;
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1665
	frac = (float)dFrac;
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1666
#else
14718
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1667
    frac = modff(__shortFloatVal(self), &trunc);
14727
10825e6940d3 no modff, no fmodf with bcc
Claus Gittinger <cg@exept.de>
parents: 14719
diff changeset
  1668
#endif
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1669
    if (! isnan(frac)) {
14719
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1670
	if (__threadErrno == 0) {
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1671
	    RETURN (__MKSFLOAT(frac));
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1672
	}
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1673
    }
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1674
%}.
7403
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1675
    ^ self class
14719
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1676
	raise:#domainErrorSignal
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1677
	receiver:self
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1678
	selector:#fractionPart
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1679
	arguments:#()
a354c1ef4a56 comment
Claus Gittinger <cg@exept.de>
parents: 14718
diff changeset
  1680
	errorString:'bad receiver in fractionPart'
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1681
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1682
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1683
     1.6 asShortFloat fractionPart + 1.6 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1684
     -1.6 asShortFloat fractionPart + -1.6 asShortFloat truncated
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1685
14718
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1686
     1.0 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1687
     0.5 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1688
     0.25 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1689
     3.14159 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1690
     12345673.14159 asShortFloat fractionPart
01835f8e7bab class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14710
diff changeset
  1691
     123456731231231231.14159 asShortFloat fractionPart
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1692
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1693
!
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1694
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1695
rounded
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1696
    "return the receiver rounded to the nearest integer"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1697
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1698
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1699
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1700
%{
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1701
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1702
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1703
    fVal = __shortFloatVal(self);
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1704
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1705
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1706
	fVal = ceilf(fVal - (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1707
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1708
	fVal = floorf(fVal + (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1709
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1710
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1711
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1712
	fVal = (float)ceil((double)fVal - 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1713
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1714
	fVal = (float)floor((double)fVal + 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1715
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1716
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1717
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1718
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1719
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1720
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1721
	RETURN ( __mkSmallInteger( (INT) fVal ) );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1722
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1723
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1724
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1725
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1726
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1727
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1728
     0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1729
     0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1730
     0.6 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1731
     -0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1732
     -0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1733
     -0.6 asShortFloat rounded
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1734
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1735
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1736
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1737
roundedAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1738
    "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
  1739
     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
  1740
     of the result to an integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1741
     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
  1742
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1743
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1744
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1745
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1746
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1747
    fVal = __shortFloatVal(self);
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1748
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1749
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1750
	fVal = ceilf(fVal - (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1751
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1752
	fVal = floorf(fVal + (float)0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1753
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1754
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1755
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1756
	fVal = (float)ceil((double)fVal - 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1757
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1758
	fVal = (float)floor((double)fVal + 0.5);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1759
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1760
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1761
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1762
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1763
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1764
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1765
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1766
     0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1767
     0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1768
     0.6 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1769
     -0.4 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1770
     -0.5 asShortFloat rounded
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1771
     -0.6 asShortFloat rounded
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1772
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1773
     0.4 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1774
     0.5 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1775
     0.6 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1776
     -0.4 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1777
     -0.5 asShortFloat roundedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1778
     -0.6 asShortFloat roundedAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1779
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1780
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1781
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1782
truncated
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1783
    "return the receiver truncated towards zero as an integer"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1784
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1785
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1786
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1787
%{
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1788
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1789
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1790
    fVal = __shortFloatVal(self);
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1791
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1792
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1793
	fVal = ceilf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1794
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1795
	fVal = floorf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1796
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1797
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1798
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1799
	fVal = (float)ceil((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1800
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1801
	fVal = (float)floor((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1802
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1803
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1804
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1805
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1806
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1807
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1808
	RETURN ( __mkSmallInteger( (INT) fVal ) );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1809
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1810
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1811
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1812
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1813
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1814
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1815
     0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1816
     -0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1817
     0.5 asShortFloat truncatedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1818
     -0.5 asShortFloat truncatedAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1819
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1820
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1821
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1822
truncatedAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1823
    "return the receiver truncated towards zero as a float.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1824
     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
  1825
     of the result to an integer.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1826
     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
  1827
     float-operation."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1828
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1829
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1830
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1831
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1832
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1833
    fVal = __shortFloatVal(self);
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8706
diff changeset
  1834
#if defined(__i386__) && defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1835
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1836
	fVal = ceilf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1837
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1838
	fVal = floorf(fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1839
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1840
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1841
    if (fVal < 0.0) {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1842
	fVal = (float)ceil((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1843
    } else {
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1844
	fVal = (float)floor((double)fVal);
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1845
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1846
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1847
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1848
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1849
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1850
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1851
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1852
     0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1853
     -0.5 asShortFloat truncated
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1854
     0.5 asShortFloat truncatedAsFloat
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11924
diff changeset
  1855
     -0.5 asShortFloat truncatedAsFloat
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1856
    "
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1857
! !
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1858
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1859
!ShortFloat class methodsFor:'documentation'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1860
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1861
version
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
  1862
    ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.120 2013-03-20 15:01:14 cg Exp $'
12486
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  1863
!
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  1864
f1ef886832f1 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11945
diff changeset
  1865
version_CVS
14922
30546dbb18c6 class: ShortFloat
Claus Gittinger <cg@exept.de>
parents: 14920
diff changeset
  1866
    ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.120 2013-03-20 15:01:14 cg Exp $'
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1867
! !
14744
24c92caccacf class: ShortFloat
Stefan Vogel <sv@exept.de>
parents: 14741
diff changeset
  1868