ShortFloat.st
author Claus Gittinger <cg@exept.de>
Tue, 17 Jun 2003 22:13:34 +0200
changeset 7412 daae29634e02
parent 7408 43bd10f2f2e6
child 7419 44b2f66791f1
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
5411
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
    15
"{ Package: 'stx:libbasic' }"
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
    16
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
LimitedPrecisionReal variableByteSubclass:#ShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	instanceVariableNames:''
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
    19
	classVariableNames:''
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	poolDictionaries:''
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
	category:'Magnitude-Numbers'
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    24
!ShortFloat primitiveDefinitions!
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    25
%{
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    26
3471
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    27
#include <errno.h>
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    28
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    29
#ifndef __OPTIMIZE__
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    30
# define __OPTIMIZE__
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    31
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    32
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    33
#define __USE_ISOC9X 1
3471
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    34
#include <math.h>
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    35
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    36
/*
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    37
 * on some systems errno is a macro ... check for it here
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    38
 */
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    39
#ifndef errno
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    40
 extern errno;
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    41
#endif
91bad1642e2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3470
diff changeset
    42
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    43
#if defined (_AIX)
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    44
# include <float.h>
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    45
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    46
2395
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    47
#if defined(IRIX)
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    48
# include <nan.h>
e83076fa0a3f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2394
diff changeset
    49
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    50
2397
dd6979979e67 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2395
diff changeset
    51
#if defined(LINUX)
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    52
# ifndef NAN
5822
4e56f8aadda5 Get nan.h from bits/nan.h for Linux
Stefan Vogel <sv@exept.de>
parents: 5718
diff changeset
    53
#  include <bits/nan.h>
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    54
# endif
2397
dd6979979e67 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2395
diff changeset
    55
#endif
4825
4c77d43433d1 nan trouble with new suse
Claus Gittinger <cg@exept.de>
parents: 4637
diff changeset
    56
2400
01b61753386f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2398
diff changeset
    57
#if defined(solaris) || defined(sunos)
2398
652c9f2a13fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
    58
# include <nan.h>
652c9f2a13fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2397
diff changeset
    59
#endif
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    60
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    61
#ifdef WIN32
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    62
/*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    63
 * no finite(x) ?
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    64
 * no isnan(x) ?
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    65
 */
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    66
# ifndef finite 
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    67
#  define finite(x)     1
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    68
# endif
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    69
# ifndef isnan
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    70
#  define isnan(x)      0
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    71
# endif
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    72
#endif
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
    73
3414
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    74
#ifdef realIX
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    75
/*
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    76
 * no finite(x)
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    77
 */
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    78
# ifndef finite
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    79
#  define finite(x)     1
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    80
# endif
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    81
#endif
d9aefd18c10d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3198
diff changeset
    82
2394
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    83
%}
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    84
! !
475f415ad893 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2393
diff changeset
    85
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
    86
!ShortFloat class methodsFor:'documentation'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
copyright
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
 COPYRIGHT (c) 1996 by Claus Gittinger
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
    91
	      All Rights Reserved
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
 This software is furnished under a license and may be used
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
 only in accordance with the terms of that license and with the
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
 inclusion of the above copyright notice.   This software may not
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
 be provided or otherwise made available to, or used by, any
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
 other person.  No title to or ownership of the software is
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
 hereby transferred.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
documentation
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
"
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   106
    ShortFloats represent rational numbers with limited precision. 
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   107
    They use the C-compilers 'float' format, which is usually the IEE single float format.
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   108
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   109
    In contrast to Floats (which use the C-compilers 64bit 'double' format),
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   110
    ShortFloats give you 32 bit floats.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
    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
   113
    ST-80's Floats respectively.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
    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
   115
    provide different float and double types in their C-compiler.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
    WARNING:
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   118
        The layout of shortFloat instances is known by the runtime system and the compiler;
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   119
        you may not add instance variables here. 
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   120
        Also, subclassing is complicated by the fact, that the VM creates floats/shortFloats, 
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   121
        and does some of its float-checks by an identity compare with the ShortFloat-class. 
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   122
        (i.e. your subclasses instances may not be recognized as float-like objects, 
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   123
         thus mixed mode arithmetic will always coerce them, effectively slowing things down).
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   124
        This may be changed, to use a flag bit in the class.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   126
    Mixed mode arithmetic:
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   127
        shortFloat op shortFloat   -> shortFloat
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   128
        shortFloat op fix         -> shortFloat
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   129
        shortFloat op fraction    -> shortFloat
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   130
        shortFloat op integer     -> shortFloat
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   131
        shortFloat op longFloat   -> longFloat
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   132
        shortFloat op float       -> float
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   133
        shortFloat op complex     -> complex
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   134
7405
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   135
    Representation:
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   136
            32bit single precision IEE floats
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   137
            23 bit mantissa,
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   138
            8 bit exponent,
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   139
            6 decimal digits (approx)
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   140
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   141
    Range and Precision of Storage Formats: see LimitedPrecisionReal >> documentation
9b0334a4591b comments
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   142
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   143
    [author:]
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   144
        Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   145
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   146
    [see also:]
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   147
        Number
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   148
        Float LongFloat Fraction FixedPoint Integer Complex
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
   149
        FloatArray DoubleArray
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   153
!ShortFloat class methodsFor:'instance creation'!
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   154
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   155
basicNew
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   156
    "return a new shortFloat - here we return 0.0
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   157
     - shortFloats are usually NOT created this way ...
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   158
     Its implemented here to allow things like binary store & load
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   159
     of shortFloats. (but even this support will go away eventually, its not
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   160
     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
   161
     totally different representation - so floats will eventually be 
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   162
     binary stored in a device independent format."
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   163
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   164
%{  /* NOCONTEXT */
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   165
    OBJ newFloat;
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   166
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
   167
    __qMKSFLOAT(newFloat, 0.0);
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   168
    RETURN (newFloat);
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   169
%}
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   170
!
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   171
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   172
fastFromString:aString at:startIndex
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   173
    "return the next ShortFloat from the string starting at startIndex. 
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   174
     No spaces are skipped.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   175
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   176
     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
   177
     returns garbage if the argument string is not a valid float number.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   178
     It has been added to allow higher speed string decomposition into
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   179
     numbers."
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   180
%{
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   181
     if (__isString(aString) && __isSmallInteger(startIndex)) {
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   182
	char *cp = (char *)(__stringVal(aString));
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   183
	int idx = __intVal(startIndex) - 1;
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   184
	double atof();
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   185
	double val;
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   186
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   187
	if ((unsigned)idx < __stringSize(aString)) {
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   188
	    val = atof(cp + idx);
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   189
	    RETURN (__MKSFLOAT(val));
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   190
	}
4297
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
     self primitiveFailed.
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   194
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   195
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   196
     ShortFloat fastFromString:'123.45' at:1  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   197
     ShortFloat fastFromString:'123.45' at:2  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   198
     ShortFloat fastFromString:'123.45E4' at:1  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   199
     ShortFloat fastFromString:'hello123.45E4' at:6  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   200
     ShortFloat fastFromString:'12345' at:1  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   201
     ShortFloat fastFromString:'12345' at:2  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   202
     ShortFloat fastFromString:'12345' at:3  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   203
     ShortFloat fastFromString:'12345' at:4  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   204
     ShortFloat fastFromString:'12345' at:5  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   205
     ShortFloat fastFromString:'12345' at:6  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   206
     ShortFloat fastFromString:'12345' at:0  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   207
     ShortFloat fastFromString:'hello123.45E4' at:1  
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   208
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   209
     Time millisecondsToRun:[
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   210
	100000 timesRepeat:[
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   211
	    ShortFloat readFrom:'123.45'
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   212
	]
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   213
     ]
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   214
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   215
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   216
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   217
     Time millisecondsToRun:[
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   218
	100000 timesRepeat:[
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   219
	    ShortFloat fastFromString:'123.45' at:1  
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
   220
	]
4297
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   221
     ]
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   222
    "
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   223
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   224
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   225
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   226
!
302e80e0b14a added #fastFromString:
Claus Gittinger <cg@exept.de>
parents: 4166
diff changeset
   227
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   228
readFrom:aStringOrStream
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   229
    "read a shortFloat from a string"
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   230
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   231
    |num|
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   232
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   233
    num := super readFrom:aStringOrStream onError:[self error:'conversion error for: ' , self name].
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   234
    num notNil ifTrue:[  
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   235
	num := num asShortFloat
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   236
    ].
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   237
    ^ num 
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   238
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   239
    "
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   240
     ShortFloat readFrom:'0.1'
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   241
     ShortFloat readFrom:'0'    
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   242
     ShortFloat readFrom:'.123' 
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   243
     ShortFloat readFrom:'-.123'   
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   244
     ShortFloat readFrom:'1e4'  
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   245
    "
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   246
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   247
    "Modified: / 7.1.1998 / 16:17:59 / cg"
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   248
!
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   249
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   250
readFrom:aStringOrStream onError:exceptionBlock
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   251
    "read a shortFloat from a string"
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   252
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   253
    |num|
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   254
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   255
    num := super readFrom:aStringOrStream onError:nil.
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   256
    num isNil ifTrue:[  
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   257
	^ exceptionBlock value
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   258
    ].
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   259
    ^ num asShortFloat
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   260
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   261
    "
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   262
     ShortFloat readFrom:'0.1'
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   263
     ShortFloat readFrom:'0'
4637
814b3d8e3f72 allow for degenerate float to be read
Claus Gittinger <cg@exept.de>
parents: 4615
diff changeset
   264
     ShortFloat readFrom:'.123'
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   265
    "
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   266
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   267
    "Modified: / 7.1.1998 / 16:17:59 / cg"
1207
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   268
! !
8c3d75503dd2 need basicNew
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   269
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   270
!ShortFloat class methodsFor:'binary storage'!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   271
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   272
readBinaryIEEESingleFrom:aStream
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   273
    "read a float value from the binary stream, aStream,
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   274
     interpreting the next bytes as an IEEE formatted 4-byte float"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   276
    |f|
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   278
    f := ShortFloat basicNew.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   279
    self readBinaryIEEESingleFrom:aStream into:f.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   280
    ^ f
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   282
    "Created: 16.4.1996 / 21:00:35 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   285
readBinaryIEEESingleFrom:aStream into:aFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   286
    "read a float value from the binary stream, aStream,
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   287
     interpreting the next bytes as an IEEE formatted 4-byte float"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   288
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   289
    aFloat isShortFloat ifFalse:[self error].
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   290
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   291
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   292
     this implementation is wrong: does not work on non-IEEE machines
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   293
     (to date all machines where ST/X is running on use
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   294
      IEEE float format. Need more here, when porting ST/X to 370's)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   295
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   296
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   297
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   298
    UninterpretedBytes isBigEndian ifFalse:[
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   299
        "swap the bytes"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   300
        8 to:4 by:-1 do:[:i |
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   301
            aFloat basicAt:i put:(aStream next)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   302
        ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   303
        ^ self
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   304
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   305
    1 to:4 do:[:i |
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   306
        aFloat basicAt:i put:aStream next
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   307
    ]
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   308
!
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   309
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   310
storeBinaryIEEESingle:aFloat on:aStream
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   311
    "store aFloat as an IEEE formatted 4-byte float
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   312
     onto the binary stream, aStream"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   313
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   314
    aFloat isShortFloat ifFalse:[self error].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   315
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   316
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   317
     this implementation is wrong: does not work on non-IEEE machines
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   318
     (to date all machines where ST/X is running on use
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   319
      IEEE float format. Need more here, when porting ST/X to 370's)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   320
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   321
    self isIEEEFormat ifFalse:[self error:'unsupported operation'].
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   322
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   323
    UninterpretedBytes isBigEndian ifFalse:[
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   324
        "swap the bytes"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   325
        8 to:4 by:-1 do:[:i |
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   326
            aStream nextPut:(aFloat basicAt:i).
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   327
        ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   328
        ^ self
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   329
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   330
    1 to:4 do:[:i |
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   331
        aStream nextPut:(aFloat basicAt:i).
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   332
    ]
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   333
! !
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   334
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   335
!ShortFloat class methodsFor:'constants'!
6574
788f5a36dcb1 Define #precision, #radix
Stefan Vogel <sv@exept.de>
parents: 6063
diff changeset
   336
7392
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   337
e
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   338
    "return the constant e as ShortFloat"
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   339
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   340
    ^ Float e asShortFloat
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   341
!
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   342
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   343
pi
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   344
    "return the constant pi as ShortFloat"
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   345
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   346
    ^ Float pi asShortFloat
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   347
!
8084c9ca941d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7387
diff changeset
   348
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   349
unity
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   350
    "return the neutral element for multiplication (1.0) as ShortFloat"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   351
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   352
    ^ 1.0 asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   353
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   354
    "Modified: 23.4.1996 / 09:26:51 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   355
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   356
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   357
zero
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   358
    "return the neutral element for addition (0.0) as ShortFloat"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   359
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
    ^ 0.0 asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   362
    "Modified: 23.4.1996 / 09:26:45 / cg"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   363
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   364
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   365
!ShortFloat class methodsFor:'queries'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   366
6898
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   367
exponentCharacter
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   368
    ^ $e
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   369
!
d0182256f3ff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6890
diff changeset
   370
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   371
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   372
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   373
     Here, true is returned for myself, false for subclasses."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   374
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   375
    ^ self == ShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   376
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   377
    "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
   378
!
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   379
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   380
isIEEEFormat
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   381
    "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
   382
     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
   383
     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
   384
     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
   385
     machine).
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   386
     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
   387
     (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
   388
ba90490c94b6 added query for IEE format (for future use)
Claus Gittinger <cg@exept.de>
parents: 3414
diff changeset
   389
    ^ true "/ this may be a lie
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   390
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   391
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   392
numBitsInExponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   393
    "answer the number of bits in the exponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   394
     This is an IEEE float, where 8 bits are available:
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   395
        seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   396
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   397
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   398
    ^ 8
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   399
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   400
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   401
numBitsInMantissa
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   402
    "answer the number of bits in the mantissa.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   403
     This is an IEEE float, where 23 bits (the hidden one is not counted here) are available:
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   404
        seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   405
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   406
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   407
    ^ 23
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   408
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   409
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   410
precision
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   411
    "answer the precision of a ShortFloat (in bits)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   412
     This is an IEEE float, only the fraction from the normalized mantissa is stored 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   413
     and so there is a hidden bit and the mantissa is actually represented by 24 binary digits"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   414
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   415
    ^  24
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   416
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   417
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   418
radix
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   419
    "answer the radix of a ShortFloats exponent
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   420
     This is an IEEE float, which is represented as binary"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   421
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   422
    ^  2        "must be careful here, whenever ST/X is used on VAX or a 370"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   424
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   425
!ShortFloat methodsFor:'arithmetic'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   426
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
* aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
    "return the product of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   430
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   431
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   437
        result = __shortFloatVal(self) * (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   438
retResult:
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   439
        __qMKSFLOAT(newFloat, result);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   440
        RETURN ( newFloat );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   441
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   442
    if (__isShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   443
        result = __shortFloatVal(self) * __shortFloatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   444
        goto retResult;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   445
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   446
    if (__isFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   447
        dResult = (double) __shortFloatVal(self)* __floatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   448
        __qMKFLOAT(newFloat, dResult);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   449
        RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   450
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
    ^ aNumber productFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
+ aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
    "return the sum of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   457
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   458
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   465
        result = __shortFloatVal(self) + (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
retResult:
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   467
        __qMKSFLOAT(newFloat, result);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   468
        RETURN ( newFloat );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   469
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   470
    if (__isShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   471
        result = __shortFloatVal(self) + __shortFloatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   472
        goto retResult;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   473
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   474
    if (__isFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   475
        dResult = (double) __shortFloatVal(self) + __floatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   476
        __qMKFLOAT(newFloat, dResult);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   477
        RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   478
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
    ^ aNumber sumFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
- aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
    "return the difference of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   488
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   489
    float result;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
    double dResult;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   492
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   493
        result = __shortFloatVal(self) - (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
retResult:
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   495
        __qMKSFLOAT(newFloat, result);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   496
        RETURN ( newFloat );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   497
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   498
    if (__isShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   499
        result = __shortFloatVal(self) - __shortFloatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   500
        goto retResult;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   501
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   502
    if (__isFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   503
        dResult = (double) __shortFloatVal(self) - __floatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   504
        __qMKFLOAT(newFloat, dResult);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   505
        RETURN ( newFloat );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   506
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   508
    ^ aNumber differenceFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   509
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   511
/ aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   512
    "return the quotient of the receiver and the argument, aNumber"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   513
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   514
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   515
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   517
    float result, val;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   518
    double dResult, dVal;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   520
    if (__isSmallInteger(aNumber)) {
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   521
        if (aNumber != __MKSMALLINT(0)) {
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   522
            result = __shortFloatVal(self) / (float)(__intVal(aNumber));
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
retResult:
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   524
            __qMKSFLOAT(newFloat, result);
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   525
            RETURN ( newFloat );
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   526
        }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   527
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   528
    if (__isShortFloat(aNumber)) {
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   529
        val = __shortFloatVal(aNumber);
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   530
        if (val != 0.0) {
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   531
            result = __shortFloatVal(self) / val;
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   532
            goto retResult;
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   533
        }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   534
    } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   535
    if (__isFloatLike(aNumber)) {
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   536
        dVal = __floatVal(aNumber);
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   537
        if (dVal != 0.0) {
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   538
            dResult = (double) __shortFloatVal(self) / dVal;
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   539
            __qMKFLOAT(newFloat, dResult);
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   540
            RETURN ( newFloat );
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   541
        }
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
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
    ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   545
        "
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   546
         No, you shalt not divide by zero
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5884
diff changeset
   547
        "
7141
033f2c26d8e6 replaced refs to DivisionByZeroSignal with ZeroDivide
Claus Gittinger <cg@exept.de>
parents: 6898
diff changeset
   548
        ^ ZeroDivide raiseRequestWith:thisContext.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
    ].
4166
5730ad6b744b oops - from coercion in quotient / uncheckedQuotient
Claus Gittinger <cg@exept.de>
parents: 4100
diff changeset
   550
    ^ aNumber quotientFromShortFloat:self
1197
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
negated
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   554
    "return myself negated"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   555
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   556
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   557
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
    float rslt = - __shortFloatVal(self);
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   559
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
   560
    __qMKSFLOAT(newFloat, rslt);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
    RETURN ( newFloat );
5411
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
   562
%}.
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
   563
    ^ 0.0 - self
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   565
!
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   566
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   567
uncheckedDivide:aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   568
    "return the quotient of the receiver and the argument, aNumber.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   569
     Do not check for divide by zero (return NaN or infinity).
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   570
     This operation is provided for emulators of other languages/semantics,
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   571
     where no exception is raised for these results (i.e. Java).
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   572
     Its only defined if the arguments type is the same as the receivers."
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   573
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   574
%{  /* NOCONTEXT */
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   575
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   576
    OBJ newFloat;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   577
    float result, val;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   578
    double dResult, dVal;
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   579
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   580
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   581
        result = __shortFloatVal(self) / (float)(__intVal(aNumber));
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   582
retResult:
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   583
        __qMKSFLOAT(newFloat, result);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   584
        RETURN ( newFloat );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   585
    }  
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   586
    if (__isShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   587
        val = __shortFloatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   588
        result = __shortFloatVal(self) / val;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   589
        goto retResult;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   590
    }  
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   591
    if (__isFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   592
        dVal = __floatVal(aNumber);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   593
        dResult = (double) __shortFloatVal(self) / dVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   594
        __qMKFLOAT(newFloat, dResult);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   595
        RETURN ( newFloat );
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   596
    }
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   597
%}.
4166
5730ad6b744b oops - from coercion in quotient / uncheckedQuotient
Claus Gittinger <cg@exept.de>
parents: 4100
diff changeset
   598
    ^ aNumber quotientFromShortFloat:self
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   599
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   600
    "
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   601
      0.0 asShortFloat uncheckedDivide:0
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   602
      1.0 asShortFloat uncheckedDivide:0.0
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   603
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   604
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   605
5257
a90fd9cb3c18 category rename
Claus Gittinger <cg@exept.de>
parents: 5120
diff changeset
   606
!ShortFloat methodsFor:'coercing & converting'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   607
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   608
asFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   609
    "return a Float with same value as the receiver"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   610
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   611
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   612
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
    OBJ newFloat;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   614
    double dVal = (double)__shortFloatVal(self);
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   615
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1670
diff changeset
   616
    __qMKFLOAT(newFloat, dVal);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
    RETURN ( newFloat );
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
    "
1583
592fee83b796 commentary
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   621
     1.0 asShortFloat asFloat 
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   624
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
    "return an integer with same value - might truncate"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   627
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   628
%{  /* NOCONTEXT */
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1583
diff changeset
   629
    float fVal;
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   630
1670
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1583
diff changeset
   631
    fVal = __shortFloatVal(self);
55cde0b3ee8e slightly faster asInteger
Claus Gittinger <cg@exept.de>
parents: 1583
diff changeset
   632
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
3158
8e6bec40f6b0 added #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3147
diff changeset
   633
	RETURN ( __MKSMALLINT( (INT)fVal) );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   634
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   635
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   636
    ^ super asInteger
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
     12345.0 asShortFloat asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
     1e15 asShortFloat asInteger
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   641
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   642
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   644
asShortFloat
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   645
    "return a ShortFloat with same value as the receiver - thats me"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   646
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   647
    ^ self
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   648
!
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   649
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
   650
asTrueFraction
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   651
    "return a fraction or integer with the same value as the receiver"
4615
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
   652
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
   653
    ^ self asFloat asTrueFraction
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
   654
!
e480d1e6090f largFloat -> largeInt conversion fixed.
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
   655
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   656
coerce:aNumber
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   657
    "return aNumber converted into receivers type"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   658
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   659
    ^ aNumber asShortFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   660
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   661
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   662
generality
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   663
    "return the generality value - see ArithmeticValue>>retry:coercing:"
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   664
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   665
    ^ 70
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   666
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   667
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   668
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   669
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   670
!ShortFloat methodsFor:'comparing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   671
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   672
< aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   673
    "return true, if the argument is greater"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   674
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   675
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   678
        RETURN ( (__shortFloatVal(self) < (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   679
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   680
    if (aNumber != nil) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   681
        if (__qIsFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   682
            RETURN ( (double)(__shortFloatVal(self) < __floatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   683
        }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   684
        if (__qIsShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   685
            RETURN ( (__shortFloatVal(self) < __shortFloatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   686
        }
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   687
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   688
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   689
    ^ aNumber lessFromShortFloat:self
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   690
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   691
    "
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   692
     1.0 asShortFloat > (1/3)
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1197
diff changeset
   693
    "
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   695
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   696
<= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   697
    "return true, if the argument is greater or equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   702
        RETURN ( (__shortFloatVal(self) <= (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   704
    if (aNumber != nil) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   705
        if (__qIsFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   706
            RETURN ( (double)(__shortFloatVal(self) <= __floatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   707
        }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   708
        if (__qIsShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   709
            RETURN ( (__shortFloatVal(self) <= __shortFloatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   710
        } 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   711
    } 
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
    ^ self retry:#<= coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
= aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   717
    "return true, if the argument represents the same numeric value
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   718
     as the receiver, false otherwise"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   723
        RETURN ( (__shortFloatVal(self) == (float)(__intVal(aNumber))) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   724
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   725
    if (aNumber == nil) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   726
        RETURN (false);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   728
    if (__qIsFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   729
        RETURN ( (double)(__shortFloatVal(self) == __floatVal(aNumber)) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   730
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   731
    if (__qIsShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   732
        RETURN ( (__shortFloatVal(self) == __shortFloatVal(aNumber)) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   735
    ^ aNumber equalFromShortFloat:self
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
> aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
    "return true, if the argument is less"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   744
        RETURN ( (__shortFloatVal(self) > (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   746
    if (aNumber != nil) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   747
        if (__qIsFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   748
            RETURN ( (double)(__shortFloatVal(self) > __floatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   749
        }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   750
        if (__qIsShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   751
            RETURN ( (__shortFloatVal(self) > __shortFloatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   752
        }
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   755
    ^ self retry:#> coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   756
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
>= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
    "return true, if the argument is less or equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
    if (__isSmallInteger(aNumber)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   764
        RETURN ( (__shortFloatVal(self) >= (float)(__intVal(aNumber))) ? true : false );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   766
    if (aNumber != nil) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   767
        if (__qIsFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   768
            RETURN ( (double)(__shortFloatVal(self) >= __floatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   769
        }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   770
        if (__qIsShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   771
            RETURN ( (__shortFloatVal(self) >= __shortFloatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   772
        }
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   773
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   774
%}.
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
    ^ self retry:#>= coercing:aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   776
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   777
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
hash
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   779
    "return a number for hashing; redefined, since floats compare
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
     by numeric value (i.e. 3.0 = 3), therefore 3.0 hash must be the same
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   781
     as 3 hash."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   782
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   783
    |i|
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
    (self >= SmallInteger minVal and:[self <= SmallInteger maxVal]) ifTrue:[
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   786
	i := self asInteger.
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   787
	self = i ifTrue:[
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   788
	    ^ i hash
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   789
	].
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   790
    ].
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   791
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   792
    ^ self asFloat hash
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
     1.2345 hash      
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   796
     1.2345 asShortFloat hash 
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   797
     1.0 hash               
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
     1.0 asShortFloat hash  
4593
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4591
diff changeset
   799
     0.5 asShortFloat hash  
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4591
diff changeset
   800
     0.25 asShortFloat hash  
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   801
     0.5 hash         
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   802
     0.25 hash        
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
    "
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   804
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   805
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   806
~= aNumber
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   807
    "return true, if the arguments value are not equal"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   808
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   809
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   810
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   811
    if (aNumber != nil) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   812
        if (__isSmallInteger(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   813
            RETURN ( (__shortFloatVal(self) != (float)(__intVal(aNumber))) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   814
        }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   815
        if (__qIsFloatLike(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   816
            RETURN ( (double)(__shortFloatVal(self) !=  __floatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   817
        }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   818
        if (__qIsShortFloat(aNumber)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   819
            RETURN ( (__shortFloatVal(self) !=  __shortFloatVal(aNumber)) ? true : false );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   820
        }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   821
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   822
        RETURN ( true );
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   823
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   824
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   825
    ^ super ~= aNumber
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   826
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   827
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
!ShortFloat methodsFor:'printing & storing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   829
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   830
printString
3194
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
   831
    "return a printed representation of the receiver
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
   832
     LimitedPrecisonReal and its subclasses use #printString instead of
16073834a825 Add comment about #printOn: and #printString
Stefan Vogel <sv@exept.de>
parents: 3158
diff changeset
   833
     #printOn: as basic print mechanism."
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   834
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   835
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   836
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
    char buffer[64];
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
    REGISTER char *cp;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
    OBJ s;
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   840
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
    /*
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   842
     * actually only needed on sparc: since thisContext is
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
     * in a global register, which gets destroyed by printf,
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
     * manually save it here - very stupid ...
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
     */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
    __BEGIN_PROTECT_REGISTERS__
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
#ifdef SYSV
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   849
    sprintf(buffer, "%.6lg", (double)__shortFloatVal(self));
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
#else
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
    sprintf(buffer, "%.6G", (double)__shortFloatVal(self));
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
#endif
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   853
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
    __END_PROTECT_REGISTERS__
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
    /* 
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
     * 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
   858
     * (i.e. look if string contains '.' or 'e' and append '.0' if not)
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   859
     */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   860
    for (cp = buffer; *cp; cp++) {
5317
6004c4c2a916 oops - printString was wrong when exponent was involved
Claus Gittinger <cg@exept.de>
parents: 5257
diff changeset
   861
        if ((*cp == '.') || (*cp == 'e') || (*cp == 'E')) break;
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   862
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   863
    if (! *cp) {
5317
6004c4c2a916 oops - printString was wrong when exponent was involved
Claus Gittinger <cg@exept.de>
parents: 5257
diff changeset
   864
        *cp++ = '.';
6004c4c2a916 oops - printString was wrong when exponent was involved
Claus Gittinger <cg@exept.de>
parents: 5257
diff changeset
   865
        *cp++ = '0';
6004c4c2a916 oops - printString was wrong when exponent was involved
Claus Gittinger <cg@exept.de>
parents: 5257
diff changeset
   866
        *cp = '\0';
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   867
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   868
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   869
    s = __MKSTRING(buffer COMMA_SND);
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   870
    if (s != nil) {
5317
6004c4c2a916 oops - printString was wrong when exponent was involved
Claus Gittinger <cg@exept.de>
parents: 5257
diff changeset
   871
        RETURN (s);
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   872
    }
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   873
%}.
5432
c71559a881e2 migration support
Claus Gittinger <cg@exept.de>
parents: 5411
diff changeset
   874
    ^ self asFloat printString
5718
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   875
!
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   876
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   877
printfPrintString:formatString
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   878
    "non-portable: return a printed representation of the receiver
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   879
     as specified by formatString, which is defined by printf.
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   880
     If you use this, be aware, that specifying doubles differs on
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   881
     systems; on SYSV machines you have to give something like %lf, 
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   882
     while on BSD systems the format string has to be %F.
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   883
     Also, the resulting string may not be longer than 255 bytes -
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   884
     since thats the (static) size of the buffer.
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   885
     This method is NONSTANDARD and may be removed without notice."
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   886
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   887
%{  /* STACK: 400 */
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   888
    char buffer[256];
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   889
    OBJ s;
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   890
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   891
    if (__isString(formatString)) {
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   892
        sprintf(buffer, __stringVal(formatString), __shortFloatVal(self));
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   893
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   894
        s = __MKSTRING(buffer COMMA_SND);
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   895
        if (s != nil) {
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   896
            RETURN (s);
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   897
        }
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   898
    }
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   899
%}.
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   900
    self primitiveFailed
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   901
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   902
    "ShortFloat pi printfPrintString:'%%lg -> %lg'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   903
    "ShortFloat pi printfPrintString:'%%lf -> %lf'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   904
    "ShortFloat pi printfPrintString:'%%7.5lg -> %7.5lg'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   905
    "ShortFloat pi printfPrintString:'%%G -> %G'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   906
    "ShortFloat pi printfPrintString:'%%F -> %F'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   907
    "ShortFloat pi printfPrintString:'%%7.5G -> %7.5G'"
dfb94d8e4ad1 added #printfPrintString
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   908
    "ShortFloat pi printfPrintString:'%%7.5F -> %7.5F'"
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   909
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   910
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   911
!ShortFloat methodsFor:'special access'!
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   912
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   913
exponent
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   914
    "extract a normalized floats exponent.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   915
     The returned value depends on the float-representation of
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   916
     the underlying machine and is therefore highly unportable.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   917
     This is not for general use.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   918
     This assumes that the mantissa is normalized to
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   919
     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
   920
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   921
%{  /* NOCONTEXT */
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   922
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   923
    double frexp();
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   924
    INT exp;
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   925
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   926
    __threadErrno = 0;
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   927
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   928
    frexpf( __shortFloatVal(self), &exp);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   929
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   930
    frexp( (double)(__shortFloatVal(self)), &exp);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   931
#endif
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   932
    if (__threadErrno == 0) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   933
        RETURN (__MKSMALLINT(exp));
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   934
    }
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   935
%}.
7387
9be7990ded99 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7380
diff changeset
   936
    ^ super exponent
3897
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
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   939
     4.0 asShortFloat exponent    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   940
     2.0 asShortFloat exponent    
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   941
     1.0 asShortFloat exponent    
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   942
     0.5 asShortFloat exponent   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   943
     0.25 asShortFloat exponent   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   944
     0.00000011111 asShortFloat exponent   
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
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   948
mantissa
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   949
    "extract a normalized floats mantissa.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   950
     The returned value depends on the float-representation of
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   951
     the underlying machine and is therefore highly unportable.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   952
     This is not for general use.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   953
     This assumes that the mantissa is normalized to
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   954
     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
   955
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   956
%{  /* NOCONTEXT */
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   957
    INT exp;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   958
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   959
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   960
    float frac;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   961
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   962
    __threadErrno = 0;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   963
    frac = frexpf( (double)__shortFloatVal(self), &exp);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   964
    if (__threadErrno == 0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   965
        RETURN (__MKSFLOAT(frac));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   966
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   967
#else
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   968
    double frexp();
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   969
    double frac;
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   970
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   971
    __threadErrno = 0;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   972
    frac = frexp( (double)(__shortFloatVal(self)), &exp);
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
   973
    if (__threadErrno == 0) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   974
        RETURN (__MKFLOAT(frac));
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   975
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
   976
#endif
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   977
%}.
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   978
    ^ self primitiveFailed
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   979
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   980
    "
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   981
     1.0 asShortFloat exponent    
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   982
     1.0 asShortFloat mantissa
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   983
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   984
     0.5 asShortFloat exponent   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   985
     0.5 asShortFloat mantissa   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   986
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   987
     0.25 asShortFloat exponent   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   988
     0.25 asShortFloat mantissa   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   989
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   990
     0.00000011111 asShortFloat exponent   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   991
     0.00000011111 asShortFloat mantissa   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   992
    "
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   993
! !
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
   994
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   995
!ShortFloat methodsFor:'testing'!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   996
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   997
isFinite
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   998
    "return true, if the receiver is a finite float 
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
   999
     i.e. not NaN and not infinite."
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1000
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1001
%{  /* NOCONTEXT */
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1002
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1003
    if (finitef(__shortFloatVal(self))) { RETURN (true); }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1004
#else
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1005
    double dV = (double) __shortFloatVal(self);
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1006
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1007
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1008
     * 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
  1009
     * a finite() macro or function (WIN32), 
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
  1010
     * 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
  1011
     */
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1012
    if (finite(dV)) { RETURN (true); }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1013
#endif
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1014
%}.
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1015
    ^false
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1016
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1017
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1018
        1.0 asShortFloat isFinite
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1019
        (0.0 asShortFloat uncheckedDivide: 0.0) isFinite
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1020
        (1.0 asShortFloat uncheckedDivide: 0.0) isFinite
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1021
    "
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1022
!
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1023
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1024
isNaN
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1025
    "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
  1026
     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
  1027
     however, inline C-code could produce them ..."
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1028
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1029
%{  /* NOCONTEXT */
7408
43bd10f2f2e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7407
diff changeset
  1030
#if defined(__GNUC__)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1031
    if (isnanf(__shortFloatVal(self))) { RETURN (true); }
7408
43bd10f2f2e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7407
diff changeset
  1032
# else
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1033
3139
ca
parents: 3014
diff changeset
  1034
    double dV = (double)(__shortFloatVal(self));
ca
parents: 3014
diff changeset
  1035
3198
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1036
    /*
4f930c1c96e7 care for systems which do not define finite() / isnan() - sigh
Claus Gittinger <cg@exept.de>
parents: 3194
diff changeset
  1037
     * 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
  1038
     * a finite() macro or function (WIN32), 
4305
e71100d13b67 void possible return warning
Claus Gittinger <cg@exept.de>
parents: 4297
diff changeset
  1039
     * 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
  1040
     */
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1041
    if (isnan(dV)) { RETURN (true); }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1042
#endif /* i386 */
2392
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  1043
%}.
cd44ad5cf015 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2391
diff changeset
  1044
    ^ false
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1045
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1046
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1047
     1.0 asShortFloat isNaN
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1048
     (0.0 asShortFloat uncheckedDivide: 0.0) isNaN
3147
60396c4b82eb New #finite, fix #isNaN.
Stefan Vogel <sv@exept.de>
parents: 3139
diff changeset
  1049
    "
2387
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1050
!
3aafb49a86ac added #isNaN
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1051
6890
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1052
isNegativeZero
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1053
    "many systems have two float.Pnt zeros"
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1054
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1055
%{
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1056
#if defined(i386) && defined(linux)
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1057
    RETURN ((__ByteArrayInstPtr(self)->ba_element[sizeof(float)-1] == 128) ? true : false );
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1058
#endif
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1059
%}.
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1060
    ^ super isNegativeZero
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1061
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1062
    "
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1063
     0.0 asShortFloat isNegativeZero     
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1064
     -0.0 asShortFloat isNegativeZero       
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1065
    "
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1066
!
8e74eff54c3d added isNegativeZero to test for -0.0
Claus Gittinger <cg@exept.de>
parents: 6574
diff changeset
  1067
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1068
negative
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1069
    "return true if the receiver is less than zero"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1070
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1071
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1072
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1073
    RETURN ( (__shortFloatVal(self) < 0.0) ? true : false );
5411
c396c6640868 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5357
diff changeset
  1074
%}.
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1075
!
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1076
5357
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1077
numberOfBits
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1078
    "return the size (in bits) of the real;
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1079
     typically, 32 is returned here,
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1080
     but who knows ..."
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1081
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1082
%{  /* NOCONTEXT */
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1083
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1084
    RETURN (__MKSMALLINT (sizeof(float) * 8));
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1085
%}
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1086
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1087
    "
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1088
     1.2 numberOfBits 
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1089
     1.2 asShortFloat numberOfBits 
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1090
    "
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1091
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1092
!
39860dd8b0f5 query for number of bits
ps
parents: 5317
diff changeset
  1093
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1094
positive
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1095
    "return true if the receiver is greater or equal to zero"
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1096
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1097
%{  /* NOCONTEXT */
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1098
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1099
    RETURN ( (__shortFloatVal(self) >= 0.0) ? true : false );
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1100
%}
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1101
!
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1102
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1103
strictlyPositive
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1104
    "return true if the receiver is greater than zero"
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1105
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1106
%{  /* NOCONTEXT */
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1107
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1108
    RETURN ( (__shortFloatVal(self) > 0.0) ? true : false );
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1109
%}
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1110
! !
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1111
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5432
diff changeset
  1112
!ShortFloat methodsFor:'truncation & rounding'!
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1113
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1114
ceiling
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1115
    "return the smallest integer which is greater or equal to the receiver."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1116
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1117
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1118
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1119
%{
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1120
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1121
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1122
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1123
    fVal = ceilf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1124
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1125
    fVal = (float)(ceil((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1126
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1127
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1128
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1129
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1130
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1131
        RETURN ( __MKSMALLINT( (INT) fVal ) );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1132
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1133
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1134
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1135
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1136
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1137
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1138
     0.5 asShortFloat ceiling           
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1139
     -0.5 asShortFloat ceiling     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1140
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1141
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1142
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1143
ceilingAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1144
    "return the smallest integer-valued float greater or equal to the receiver.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1145
     This is much like #ceiling, but avoids a (possibly expensive) conversion 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1146
     of the result to an integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1147
     It may be useful, if the result is to be further used in another float-operation."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1148
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1149
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1150
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1151
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1152
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1153
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1154
    fVal = ceilf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1155
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1156
    fVal = (float) ceil((double)__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1157
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1158
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1159
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1160
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1161
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1162
     0.5 asShortFloat ceilingAsFloat           
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1163
     -0.5 asShortFloat ceilingAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1164
     -1.5 asShortFloat ceilingAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1165
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1166
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1167
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1168
floor
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1169
    "return the integer nearest the receiver towards negative infinity."
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1170
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1171
    |val|
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1172
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1173
%{
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1174
    float fVal;
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1175
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1176
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1177
    fVal = floorf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1178
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1179
    fVal = (float)(floor((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1180
#endif
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1181
    /*
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1182
     * ST-80 (and X3J20) returns integer.
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1183
     */
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1184
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1185
        RETURN ( __MKSMALLINT( (INT) fVal ) );
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1186
    }
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1187
    __qMKSFLOAT(val, fVal);
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1188
%}.
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1189
    ^ val asInteger
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1190
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1191
    "
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1192
     0.5 asShortFloat floor           
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1193
     -0.5 asShortFloat floor     
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1194
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1195
!
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1196
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1197
floorAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1198
    "return the float which represents the next lower
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1199
     integer nearest the receiver towards negative infinity.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1200
     Much like floor, but returns a float result - useful if the result
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1201
     will be used in another float operation, to avoid costy int-conversion."
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1202
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1203
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1204
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1205
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1206
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1207
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1208
    fVal = floorf(__shortFloatVal(self));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1209
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1210
    fVal = (float)(floor((double)__shortFloatVal(self)));
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1211
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1212
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1213
    RETURN ( v );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1214
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1215
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1216
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1217
     0.5 asShortFloat floorAsFloat           
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1218
     -0.5 asShortFloat floorAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1219
    "
4100
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1220
!
a605c54bf9a9 fixed floor (endless recursion)
Claus Gittinger <cg@exept.de>
parents: 3983
diff changeset
  1221
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1222
fractionPart
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1223
    "extract the after-decimal fraction part.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1224
     such that (self truncated + self fractionPart) = self"
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1225
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1226
%{  /* NOCONTEXT */
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1227
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1228
    double modf();
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1229
    double frac, trunc;
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1230
5120
13143fbcbdf8 introduced __threadErrno (for native threads)
Claus Gittinger <cg@exept.de>
parents: 4825
diff changeset
  1231
    __threadErrno = 0;
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1232
    frac = modf((double)(__shortFloatVal(self)), &trunc);
7403
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1233
    if (! isnan(frac)) { 
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1234
        if (__threadErrno == 0) {
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1235
            RETURN (__MKSFLOAT((float)frac));
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1236
        }
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1237
    }
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1238
%}.
7403
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1239
    ^ self class
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1240
        raise:#domainErrorSignal
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1241
        receiver:self
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1242
        selector:#fractionPart
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1243
        arguments:#()
857702a5a921 signals vs. errors
Claus Gittinger <cg@exept.de>
parents: 7392
diff changeset
  1244
        errorString:'bad receiver in fractionPart'
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1245
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1246
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1247
     1.6 asShortFloat fractionPart + 1.6 asShortFloat truncated    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1248
     -1.6 asShortFloat fractionPart + -1.6 asShortFloat truncated    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1249
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1250
     1.0 asShortFloat fractionalPart    
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1251
     0.5 asShortFloat fractionalPart    
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1252
     0.25 asShortFloat fractionalPart   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1253
     3.14159 asShortFloat fractionalPart   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1254
     12345673.14159 asShortFloat fractionalPart   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1255
     123456731231231231.14159 asShortFloat fractionalPart   
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1256
    "
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1257
!
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1258
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1259
rounded
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1260
    "return the receiver rounded to the nearest integer"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1261
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1262
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1263
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1264
%{  
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1265
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1266
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1267
    fVal = __shortFloatVal(self);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1268
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1269
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1270
        fVal = ceilf(fVal - (float)0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1271
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1272
        fVal = floorf(fVal + (float)0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1273
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1274
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1275
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1276
        fVal = (float)ceil((double)fVal - 0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1277
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1278
        fVal = (float)floor((double)fVal + 0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1279
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1280
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1281
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1282
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1283
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1284
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1285
        RETURN ( __MKSMALLINT( (INT) fVal ) );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1286
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1287
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1288
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1289
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1290
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1291
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1292
     0.4 asShortFloat rounded     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1293
     0.5 asShortFloat rounded     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1294
     0.6 asShortFloat rounded     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1295
     -0.4 asShortFloat rounded    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1296
     -0.5 asShortFloat rounded  
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1297
     -0.6 asShortFloat rounded  
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1298
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1299
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1300
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1301
roundedAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1302
    "return the receiver rounded to the nearest integer as a float.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1303
     This is much like #rounded, but avoids a (possibly expensive) conversion 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1304
     of the result to an integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1305
     It may be useful, if the result is to be further used in another float-operation."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1306
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1307
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1308
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1309
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1310
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1311
    fVal = __shortFloatVal(self);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1312
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1313
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1314
        fVal = ceilf(fVal - (float)0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1315
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1316
        fVal = floorf(fVal + (float)0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1317
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1318
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1319
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1320
        fVal = (float)ceil((double)fVal - 0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1321
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1322
        fVal = (float)floor((double)fVal + 0.5);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1323
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1324
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1325
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1326
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1327
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1328
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1329
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1330
     0.4 asShortFloat rounded     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1331
     0.5 asShortFloat rounded     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1332
     0.6 asShortFloat rounded     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1333
     -0.4 asShortFloat rounded    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1334
     -0.5 asShortFloat rounded    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1335
     -0.6 asShortFloat rounded    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1336
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1337
     0.4 asShortFloat roundedAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1338
     0.5 asShortFloat roundedAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1339
     0.6 asShortFloat roundedAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1340
     -0.4 asShortFloat roundedAsFloat    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1341
     -0.5 asShortFloat roundedAsFloat    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1342
     -0.6 asShortFloat roundedAsFloat    
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1343
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1344
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1345
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1346
truncated
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1347
    "return the receiver truncated towards zero as an integer"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1348
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1349
    |val|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1350
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1351
%{  
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1352
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1353
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1354
    fVal = __shortFloatVal(self);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1355
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1356
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1357
        fVal = ceilf(fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1358
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1359
        fVal = floorf(fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1360
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1361
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1362
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1363
        fVal = (float)ceil((double)fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1364
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1365
        fVal = (float)floor((double)fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1366
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1367
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1368
    /*
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1369
     * ST-80 (and X3J20) returns integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1370
     */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1371
    if ((fVal >= (float)_MIN_INT) && (fVal <= (float)_MAX_INT)) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1372
        RETURN ( __MKSMALLINT( (INT) fVal ) );
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1373
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1374
    __qMKSFLOAT(val, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1375
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1376
    ^ val asInteger
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1377
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1378
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1379
     0.5 asShortFloat truncated           
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1380
     -0.5 asShortFloat truncated          
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1381
     0.5 asShortFloat truncatedAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1382
     -0.5 asShortFloat truncatedAsFloat   
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1383
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1384
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1385
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1386
truncatedAsFloat
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1387
    "return the receiver truncated towards zero as a float.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1388
     This is much like #truncated, but avoids a (possibly expensive) conversion 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1389
     of the result to an integer.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1390
     It may be useful, if the result is to be further used in another 
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1391
     float-operation."
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1392
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1393
%{  /* NOCONTEXT */
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1394
    float fVal;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1395
    OBJ v;
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1396
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1397
    fVal = __shortFloatVal(self);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1398
#if defined(i386) && defined(__GNUC__)
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1399
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1400
        fVal = ceilf(fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1401
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1402
        fVal = floorf(fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1403
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1404
#else
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1405
    if (fVal < 0.0) {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1406
        fVal = (float)ceil((double)fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1407
    } else {
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1408
        fVal = (float)floor((double)fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1409
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1410
#endif
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1411
    __qMKSFLOAT(v, fVal);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1412
    RETURN (v);
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1413
%}
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1414
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1415
    "
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1416
     0.5 asShortFloat truncated     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1417
     -0.5 asShortFloat truncated   
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1418
     0.5 asShortFloat truncatedAsFloat     
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1419
     -0.5 asShortFloat truncatedAsFloat  
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7141
diff changeset
  1420
    "
3897
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1421
! !
b50a14f9083e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3895
diff changeset
  1422
1880
64341225f439 added strictlyPositive
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1423
!ShortFloat class methodsFor:'documentation'!
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1424
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1425
version
7408
43bd10f2f2e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7407
diff changeset
  1426
    ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.78 2003-06-17 16:10:28 cg Exp $'
1197
2b37cf664b81 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1427
! !