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