IEEEFloat.st
author Claus Gittinger <cg@exept.de>
Thu, 05 Dec 2019 15:02:09 +0100
changeset 5357 84fd4db36651
parent 5356 c5036483d628
child 5358 339af06b05c9
permissions -rw-r--r--
#BUGFIX by cg class: IEEEFloat comment/format in: #equalFromIEEEFloat: changed: #lessFromIEEEFloat:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
     1
"{ Encoding: utf8 }"
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
     2
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ Package: 'stx:libbasic2' }"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
"{ NameSpace: Smalltalk }"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
LimitedPrecisionReal variableByteSubclass:#IEEEFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	instanceVariableNames:'exponentSize'
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	classVariableNames:''
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
	poolDictionaries:''
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
	category:'Magnitude-Numbers'
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
!IEEEFloat class methodsFor:'documentation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
documentation
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
    Unfinished, ongoing work
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
    soft float emulation for arbitrary IEEE float formats.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
    This is very very slow and should only be used when importing 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
    funny sized floating point numbers (such as float24 or float8) from
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
    external sources, or to simulate computations on otherwise unsupported floating pnt numbers.
5341
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    24
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    25
    Create one by passing the overall number of bits and the number of exponent-bits:
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    26
        IEEEFloat size:64 exponentSize:(Float numBitsInExponent)
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
    27
    or:
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
    28
        1.0 asIEEEFloat
5341
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    29
    will give you a (slow) variant of a regular float.
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    30
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    31
    And:
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    32
        IEEEFloat size:256 exponentSize:19
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    33
    will give you a 256 bit ieee float.
a5a32ee87cbc #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5334
diff changeset
    34
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
!IEEEFloat class methodsFor:'instance creation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    40
fromFloat:aFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    41
    |nB f|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    42
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    43
    nB := aFloat byteSize.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    44
    f := self basicNew:nB.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    45
    1 to:nB do:[:i |
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    46
        f basicAt:i put:(aFloat byteAt:i)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    47
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    48
    f exponentSize:(aFloat numBitsInExponent).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    49
    ^ f
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    50
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    51
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    52
     self fromFloat:1.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    53
     self fromFloat:2.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    54
     self fromFloat:1.0 asShortFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    55
     self fromFloat:2.0 asShortFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    56
     self fromFloat:1.0 asLongFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    57
     self fromFloat:2.0 asLongFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    58
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    59
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    60
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    61
fromInteger:anInteger
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    62
    ^ self fromFloat:anInteger asFloat
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    63
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    64
    "
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    65
     self fromInteger:1
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    66
     self fromInteger:2
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    67
     self fromInteger:1e20 asInteger
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    68
     self fromInteger:1e100 asInteger
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    69
    "
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    70
!
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
    71
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
size:numBits exponentSize:exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
    ^ (self basicNew:(numBits // 8)) exponentSize:exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
     self size:256 exponentSize:19
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    77
     self size:16 exponentSize:5
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    78
     self size:(1.0 basicSize * 8) exponentSize:(1.0 numBitsInExponent)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    79
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    80
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    81
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    82
size:numBits exponentSize:exponentSize fraction:anInteger exponent:exp signBit:signBit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    83
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    84
            setFraction:anInteger exponent:exp signBit:signBit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    85
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    86
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    87
     self size:256 exponentSize:19 fromInteger:1
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    88
     self size:256 exponentSize:19 fromInteger:2
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
size:numBits exponentSize:exponentSize fromFloat:aFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) setValueFromFloat:aFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
     self size:256 exponentSize:19 fromFloat:1.0
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
     self size:256 exponentSize:19 fromFloat:2.0
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
size:numBits exponentSize:exponentSize fromInteger:anInteger
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) setValueFromInteger:anInteger
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
     self size:256 exponentSize:19 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
     self size:256 exponentSize:19 fromInteger:2
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   110
!IEEEFloat class methodsFor:'coercing & converting'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   111
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   112
coerce:aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   113
    "convert the argument aNumber into an instance of the receiver (class) and return it."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   114
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   115
    ^ aNumber asIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   116
! !
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   118
!IEEEFloat class methodsFor:'constants'!
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   120
unity
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   121
    ^ 1.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   122
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   123
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   124
zero
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   125
    ^ 0.0
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
!IEEEFloat methodsFor:'accessing'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   130
exponentBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   131
    "return the bits of my exponent.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   132
     These might be biased.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   133
     My bytes are stored LSB first; thus we have to fetch the high exponent bytes."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   134
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   135
    |nBytes nExpBytes e|
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   136
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   137
    nBytes := self basicSize.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   138
    nExpBytes := (exponentSize + 1 + 7) // 8.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   139
    "/ seee eeee eeee mmmm mmmm ....
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   140
    "/ BAD: assumes LSB
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   141
    e := (self basicAt:nBytes) bitAnd:16r7F.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   142
    2 to:nExpBytes do:[:eI |
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   143
         e := (e bitShift:8) bitOr:(self basicAt:nBytes + 1 - eI)
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   144
    ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   145
    "/ 0eee eeee eeee mmmm
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   146
    e := e rightShift:(nExpBytes * 8) - 1 "sign" - exponentSize.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   147
    "/ 0000 0eee eeee eeee 
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   148
    ^ e
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   149
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   150
    "
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   151
     1.0 asShortFloat asIEEEFloat
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   152
     (1 to:4) conform:[:i | (1.0 asShortFloat basicAt:i) = (1.0 asShortFloat asIEEEFloat basicAt:i)]
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   153
     1.0 asShortFloat exponentBits 
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   154
     1.0 asShortFloat asIEEEFloat exponentBits
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   155
     -1.0 asShortFloat exponentBits  
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   156
     -1.0 asShortFloat asIEEEFloat exponentBits   
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   157
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   158
     (self size:32 exponentSize:8) inspect.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   159
     (self size:64 exponentSize:11) inspect.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   160
     (self size:128 exponentSize:16) inspect.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   161
     (self size:256 exponentSize:16) inspect.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   162
    "
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   163
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   164
    "construct a soft-shortFloat
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   165
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   166
     |f sf|
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   167
     sf := 1.0 asShortFloat.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   168
     f := self size:(sf basicSize * 8) exponentSize:(sf numBitsInExponent).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   169
     1 to:sf basicSize do:[:i | f basicAt:i put:(sf basicAt:i)].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   170
     f inspect
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   171
    "
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   172
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   173
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   174
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   175
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
    ^ exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
exponentSize:something
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
    exponentSize := something.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   184
mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   185
    "return the bits of my mantissa (incl. the hidden bit).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   186
     My bytes are stored LSB first."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   187
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   188
    |bits hiddenBit mask c|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   189
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   190
    bits := self digitBytes asIntegerMSB:false.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   191
    bits == 0 ifTrue:[^ 0].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   192
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   193
    hiddenBit := (1 bitShift:self numBitsInMantissa).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   194
    mask := hiddenBit-1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   195
    c := bits bitAnd:mask.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   196
    "/ TODO: care for subnormals (exponent = 0)!!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   197
    ^ c bitOr:hiddenBit.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   198
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   199
    " 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   200
     (self size:32 exponentSize:8) inspect.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   201
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   202
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   203
   "construct a soft-shortFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   204
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   205
    |f sf|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   206
    sf := 1.0 asShortFloat.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   207
    f := self size:(sf basicSize * 8) exponentSize:(sf numBitsInExponent).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   208
    1 to:sf basicSize do:[:i | f basicAt:i put:(sf basicAt:i)].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   209
    f inspect
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   210
   "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   211
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   212
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   213
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   214
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   215
setFraction:normalizedFraction exponent:biasedExponent signBit:signBit
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   216
    |bits|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   217
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   218
    bits := (normalizedFraction 
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   219
            bitOr:(biasedExponent bitShift:self numBitsInMantissa))
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   220
            bitOr:(signBit bitShift:(self basicSize * 8) - 1). 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   221
    1 to:self basicSize do:[:i | self basicAt:i put:(bits digitAt:i)].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   222
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   223
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   224
     (self size:64 exponentSize:11) setFraction:0 exponent:1024 signBit:0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   225
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   226
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   227
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
setValueFromInteger:intValue
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
    "/ how many bits are there, in this int
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
    |absValue myNumBits numBitsInNumber shift|
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
    absValue := intValue abs. 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
    numBitsInNumber := absValue highBit.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
    myNumBits := (self basicSize * 8) - 1 "sign" - exponentSize.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
    shift := myNumBits - numBitsInNumber. 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
    numBitsInNumber > myNumBits ifTrue:[
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
        self halt.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
    ] ifFalse:[
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
        "/ number:
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
        "/    1xxxxxxx...xxxxx
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
        "/ myRep:
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
        "/    seee...eeexxxxxxxxxx
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
        absValue digitLength to:1 by:-1 do:[:byteIndex |
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
            
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
        ].
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
    ].
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
    "/ cut off some bits
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
    "Float numBitsInExponent
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
     self size:16 exponentSize:4 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
     self size:32 exponentSize:11 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
     self size:256 exponentSize:19 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
     self size:256 exponentSize:19 fromInteger:2
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   259
!IEEEFloat methodsFor:'arithmetic'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   260
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   261
* aNumber
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   262
    "/ thisContext isRecursive ifTrue:[self halt].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   263
    ^ aNumber productFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   264
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   265
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   266
+ aNumber
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   267
    "/ thisContext isRecursive ifTrue:[self halt].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   268
    ^ aNumber sumFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   269
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   270
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   271
     (-2.0 asIEEEFloat)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   272
     (2.0 asIEEEFloat)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   273
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   274
     self assert:((4.0 asIEEEFloat) + (2.0 asIEEEFloat)) = (6.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   275
     self assert:((4.0 asIEEEFloat) + (-2.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   276
     self assert:((-4.0 asIEEEFloat) + (-2.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   277
     self assert:((-4.0 asIEEEFloat) + (2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   278
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   279
     self assert:((2.0 asIEEEFloat) + (4.0 asIEEEFloat)) = (6.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   280
     self assert:((2.0 asIEEEFloat) + (-4.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   281
     self assert:((-2.0 asIEEEFloat) + (-4.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   282
     self assert:((-2.0 asIEEEFloat) + (4.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   283
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   284
     self assert:((IEEEFloat fromFloat:0.1) + (IEEEFloat fromFloat:-0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   285
     self assert:((IEEEFloat fromFloat:-0.1) + (IEEEFloat fromFloat:0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   286
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   287
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   288
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   289
- aNumber
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   290
    "/ thisContext isRecursive ifTrue:[self halt].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   291
    ^ aNumber differenceFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   292
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   293
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   294
     self assert:((4.0 asIEEEFloat) - (2.0 asIEEEFloat)) = (2.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   295
     self assert:((4.0 asIEEEFloat) - (-2.0 asIEEEFloat)) = (6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   296
     self assert:((-4.0 asIEEEFloat) - (-2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   297
     self assert:((-4.0 asIEEEFloat) - (2.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   298
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   299
     self assert:((2.0 asIEEEFloat) - (4.0 asIEEEFloat)) = (-2.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   300
     self assert:((2.0 asIEEEFloat) - (-4.0 asIEEEFloat)) = (6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   301
     self assert:((-2.0 asIEEEFloat) - (-4.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   302
     self assert:((-2.0 asIEEEFloat) - (4.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   303
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   304
     self assert:((IEEEFloat fromFloat:0.1) - (IEEEFloat fromFloat:0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   305
     self assert:((IEEEFloat fromFloat:0.1) - (IEEEFloat fromFloat:-0.1)) = (IEEEFloat fromFloat:0.2)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   306
     self assert:((IEEEFloat fromFloat:-0.1) - (IEEEFloat fromFloat:-0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   307
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   308
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   309
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   310
/ aNumber
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   311
    "/ thisContext isRecursive ifTrue:[self halt].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   312
    ^ aNumber quotientFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   313
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   314
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   315
negated
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   316
    |f highByte|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   317
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   318
    f := self copy.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   319
    highByte := self basicAt:(self basicSize).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   320
    f basicAt:(self basicSize) put:(highByte bitXor:16r80).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   321
    ^ f.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   322
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   323
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   324
     self assert:(IEEEFloat fromFloat:2.0) negated = (IEEEFloat fromFloat:-2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   325
     self assert:(IEEEFloat fromFloat:2.0) negated negated = (IEEEFloat fromFloat:2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   326
     self assert:(IEEEFloat fromFloat:-2.0) negated = (IEEEFloat fromFloat:2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   327
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   328
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   329
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   330
!IEEEFloat methodsFor:'coercing & converting'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   331
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   332
coerce:aNumber
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   333
    "convert the argument aNumber into an instance of the receiver's class and return it.
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   334
     Redefined to preserve the size and exponentSize"
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   335
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   336
    |fraction e h nM|
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   337
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   338
    aNumber isInteger ifTrue:[
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   339
        nM := self numBitsInMantissa.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   340
        "/ cut off precision by shifting right (if h > nM) 
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   341
        "/ or add zeros by shifting to the left 
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   342
        h := aNumber highBit.
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   343
        h == 0 ifTrue:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   344
            fraction := e := 0.
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   345
        ] ifFalse:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   346
            fraction := aNumber bitShift:(nM - h + 1). 
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   347
            fraction := fraction bitAnd:((1 bitShift:nM)-1).
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   348
            e := self eBias + h - 1.
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   349
        ].
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   350
        ^ (self class basicNew:self basicSize) exponentSize:exponentSize;
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   351
            setFraction:fraction exponent:e 
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   352
            signBit:(aNumber negative ifTrue:[1] ifFalse:[0]);
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   353
            yourself
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   354
    ].
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   355
    ^ self class coerce:aNumber
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   356
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   357
    "Modified: / 15-06-2017 / 10:27:03 / cg"
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   358
!
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   359
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   360
generality
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   361
    ^ 97   "/ between OctaFloat and LargeFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   362
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   363
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   364
     1 asShortFloat generality 70
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   365
     1 asFloat generality      80
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   366
     1 asLongFloat generality  90
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   367
     1 asQuadFloat generality
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   368
     1 asQDouble generality    95
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   369
     1 asLargeFloat generality 100
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   370
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   371
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   372
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   373
!IEEEFloat methodsFor:'comparing'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   374
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   375
< aNumber
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   376
    "/ thisContext isRecursive ifTrue:[self halt].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   377
    ^ aNumber lessFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   378
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   379
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   380
= aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   381
    ^ aNumber equalFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   382
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   383
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   384
!IEEEFloat methodsFor:'double dispatching'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   385
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   386
differenceFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   387
    "/ anIEEEFloat - self
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   388
    self isZero ifTrue:[^ anIEEEFloat]. "/ otherwise, we might get a negative zero
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   389
    ^ self negated sumFromIEEEFloat:anIEEEFloat
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   390
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   391
    "
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   392
     0.0 + (0.0 negated)         
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   393
     (0.0 negated) + 0.0 
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   394
     0.0 asIEEEFloat + (0.0 negated)         
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   395
     (0.0 asIEEEFloat negated) + 0.0 
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   396
     0.0 asIEEEFloat + (0.0 asIEEEFloat negated)         
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   397
     (0.0 asIEEEFloat negated) + 0.0 asIEEEFloat
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   398
    "
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   399
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   400
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   401
equalFromIEEEFloat:anIEEEFloat
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   402
    |nBytes m1 m2 nM1 nM2 e1 e2|
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   403
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   404
    nBytes := self basicSize.
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   405
    anIEEEFloat basicSize == nBytes ifTrue:[
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   406
        anIEEEFloat exponentSize == exponentSize ifTrue:[
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   407
            1 to:nBytes-1 do:[:i |
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   408
                (self basicAt:i) = (anIEEEFloat basicAt:i) ifFalse:[^ false].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   409
            ].
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   410
            "/ care for negative zero
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   411
            (self basicAt:nBytes) = (anIEEEFloat basicAt:nBytes) ifFalse:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   412
                ((self basicAt:nBytes) bitAnd:16r7F) == 0 ifTrue:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   413
                    ((anIEEEFloat basicAt:nBytes) bitAnd:16r7F) == 0 ifTrue:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   414
                        ^ true.
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   415
                    ].
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   416
                ].
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   417
                ^ false
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   418
            ].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   419
            ^ true.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   420
        ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   421
    ].
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   422
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   423
    "/ more complicated compare
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   424
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   425
    self negative = anIEEEFloat negative ifFalse:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   426
        ^ self isZero and:[anIEEEFloat isZero]
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   427
    ].
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   428
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   429
    "/ bring to same exponent, add m1 + m2, normalize
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   430
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   431
    m1 := anIEEEFloat mantissaBits. 
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   432
    m2 := self mantissaBits.        
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   433
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   434
    nM1 := anIEEEFloat numBitsInMantissa.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   435
    nM2 := self numBitsInMantissa.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   436
    nM1 ~= nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   437
        nM1 > nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   438
            m2 := m2 bitShift:(nM1-nM2).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   439
        ] ifFalse:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   440
            m1 := m1 bitShift:(nM2-nM1).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   441
        ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   442
    ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   443
    m1 = m2 ifFalse:[^ false].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   444
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   445
    e1 := anIEEEFloat exponentBits - anIEEEFloat eBias.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   446
    e2 := self exponentBits - self eBias.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   447
    e1 = e2 ifFalse:[^ false].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   448
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   449
    ^ true.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   450
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   451
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   452
lessFromIEEEFloat:anIEEEFloat
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   453
    |m1 m2 nM1 nM2 e1 e2 meNegative mySize myByte otherByte isLess|
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   454
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   455
    meNegative := self negative.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   456
    meNegative = anIEEEFloat negative ifFalse:[
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   457
        ^ anIEEEFloat negative
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   458
    ].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   459
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   460
    "/ same sized floats can be compared easily
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   461
    "/ (but care for the negative 0)
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   462
    mySize := self basicSize.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   463
    mySize == anIEEEFloat basicSize ifTrue:[
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   464
        anIEEEFloat exponentSize == exponentSize ifTrue:[
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   465
            "/ ignore the sign bit
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   466
            myByte := (self basicAt:mySize) bitAnd:16r7F.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   467
            otherByte := (anIEEEFloat basicAt:mySize) bitAnd:16r7F.    
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   468
            otherByte < myByte ifTrue:[
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   469
                ^ meNegative not
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   470
            ].
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   471
            otherByte > myByte ifTrue:[
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   472
                ^ meNegative
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   473
            ].
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   474
            mySize-1 to:1 by:-1 do:[:i |
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   475
                myByte := self basicAt:i.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   476
                otherByte := anIEEEFloat basicAt:i.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   477
                otherByte < myByte ifTrue:[
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   478
                    ^ meNegative not
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   479
                ].
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   480
                otherByte > myByte ifTrue:[
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   481
                    ^ meNegative
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   482
                ].
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   483
            ].
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   484
            "/ same
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   485
            ^ false.
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   486
        ].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   487
    ].
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   488
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   489
    "/ more complicated compare
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   490
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   491
    "/ bring to same exponent, add m1 + m2, normalize
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   492
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   493
    m1 := anIEEEFloat mantissaBits. 
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   494
    m2 := self mantissaBits.        
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   495
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   496
    nM1 := anIEEEFloat numBitsInMantissa.
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   497
    nM2 := self numBitsInMantissa.
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   498
    nM1 ~= nM2 ifTrue:[
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   499
        nM1 > nM2 ifTrue:[
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   500
            m2 := m2 bitShift:(nM1-nM2).
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   501
        ] ifFalse:[
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   502
            m1 := m1 bitShift:(nM2-nM1).
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   503
        ].
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   504
    ].
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   505
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   506
    e1 := anIEEEFloat exponent.
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   507
    e2 := self exponent.
5357
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   508
    isLess := e1 = e2 ifTrue:[m1 < m2] ifFalse:[e1 < e2].
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   509
    meNegative ifTrue:[^ isLess not].
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   510
    ^ isLess.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   511
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   512
    "
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   513
     self assert:(1.0 asIEEEFloat < 2.0 asIEEEFloat).
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   514
     self assert:(1.0 asIEEEFloat < 1.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   515
     self assert:(1.0 asIEEEFloat < 0.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   516
     self assert:(1.0 asIEEEFloat < -0.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   517
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   518
     self assert:(-1.0 asIEEEFloat < 2.0 asIEEEFloat).
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   519
     self assert:(-1.0 asIEEEFloat < 1.0 asIEEEFloat).
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   520
     self assert:(-1.0 asIEEEFloat < 0.0 asIEEEFloat).
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   521
     self assert:(-1.0 asIEEEFloat < -0.0 asIEEEFloat).
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   522
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   523
     self assert:(1.0 asIEEEFloat < -2.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   524
     self assert:(1.0 asIEEEFloat < -1.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   525
     self assert:(1.0 asIEEEFloat < 0.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   526
     self assert:(1.0 asIEEEFloat < -0.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   527
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   528
     self assert:(-1.0 asIEEEFloat < -2.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   529
     self assert:(-1.0 asIEEEFloat < -1.0 asIEEEFloat) not.
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   530
     self assert:(-1.0 asIEEEFloat < 0.0 asIEEEFloat).
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   531
     self assert:(-1.0 asIEEEFloat < -0.0 asIEEEFloat).
84fd4db36651 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
   532
    "
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   533
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   534
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   535
productFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   536
    "/ anIEEEFloat * self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   537
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   538
    |m1 m2 e1 e2 m e signBit hi shift nM1 nM2 nM|
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   539
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   540
    "/ m1 * m2 / e1 + e2
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   541
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   542
    m1 := anIEEEFloat mantissaBits. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   543
    m2 := self mantissaBits.        
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   544
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   545
    nM1 := anIEEEFloat numBitsInMantissa.   
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   546
    nM2 := nM := self numBitsInMantissa.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   547
    nM1 ~= nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   548
        nM1 > nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   549
            m2 := m2 bitShift:(nM1-nM2).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   550
            nM := nM1
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   551
        ] ifFalse:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   552
            m1 := m1 bitShift:(nM2-nM1).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   553
            nM := nM2
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   554
        ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   555
    ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   556
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   557
    e1 := anIEEEFloat exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   558
    e2 := self exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   559
    e := (e1 - anIEEEFloat eBias) + (e2 - self eBias).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   560
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   561
    "/ 1xxxx....xxxx * 1xxxx....xxxx
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   562
    m := m1 * m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   563
    "/ now have nB bits too many
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   564
    e := e - nM.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   565
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   566
    signBit := (self negative == anIEEEFloat negative) ifTrue:[0] ifFalse:[1].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   567
    m == 0 ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   568
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   569
    hi := m highBit.    
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   570
    shift := (nM + 1) - hi. 
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   571
    m := m bitShift:shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   572
    e := e - shift.
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   573
    m := m bitAnd:(1 bitShift:nM)-1. 
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   574
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   575
    e := e + self eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   576
    ^ self class 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   577
        size:(self basicSize*8) exponentSize:exponentSize 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   578
        fraction:m exponent:e signBit:signBit.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   579
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   580
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   581
     self assert:((IEEEFloat fromFloat:1.0) * (IEEEFloat fromFloat:1.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   582
     self assert:((IEEEFloat fromFloat:1.0) * (IEEEFloat fromFloat:1.0)) exponent = 1.0 exponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   583
     self assert:((IEEEFloat fromFloat:1.0) * (IEEEFloat fromFloat:1.0)) mantissaBits = 1.0 mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   584
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   585
     self assert:((4.0 asIEEEFloat) * (2.0 asIEEEFloat)) = (8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   586
     self assert:((-4.0 asIEEEFloat) * (2.0 asIEEEFloat)) = (-8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   587
     self assert:((4.0 asIEEEFloat) * (-2.0 asIEEEFloat)) = (-8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   588
     self assert:((-4.0 asIEEEFloat) * (-2.0 asIEEEFloat)) = (8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   589
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   590
     self assert:((IEEEFloat fromFloat:100.0) * (IEEEFloat fromFloat:100.0)) = (IEEEFloat fromFloat:10000.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   591
     self assert:((IEEEFloat fromFloat:1e-20) * (IEEEFloat fromFloat:1e20)) = (IEEEFloat fromFloat:(1e-20 * 1e20)) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   592
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   593
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   594
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   595
quotientFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   596
    "/ anIEEEFloat / self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   597
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   598
    |m1 m2 e1 e2 m e signBit nM1 nM2 nM hi shift|
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   599
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   600
    "/ m1 / m2 / e1 - e2
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   601
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   602
    m1 := anIEEEFloat mantissaBits.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   603
    m1 == 0 ifTrue:[^ anIEEEFloat ].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   604
    m2 := self mantissaBits.        
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   605
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   606
    nM1 := anIEEEFloat numBitsInMantissa.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   607
    nM2 := nM := self numBitsInMantissa.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   608
    nM1 ~= nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   609
        nM1 > nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   610
            m2 := m2 bitShift:(nM1-nM2).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   611
            nM := nM1
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   612
        ] ifFalse:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   613
            m1 := m1 bitShift:(nM2-nM1).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   614
            nM := nM2
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   615
        ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   616
    ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   617
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   618
    e1 := anIEEEFloat exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   619
    e2 := self exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   620
    e := (e1 - anIEEEFloat eBias) - (e2 - self eBias).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   621
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   622
    "/ 1xxxx....xxxx / 1xxxx....xxxx
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   623
    m := (m1 bitShift:nM) // m2.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   624
    "/ rest := m1 \\ m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   625
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   626
    signBit := (self negative == anIEEEFloat negative) ifTrue:[0] ifFalse:[1].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   627
    m == 0 ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   628
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   629
    hi := m highBit.    
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   630
    shift := (nM + 1) - hi. 
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   631
    m := m bitShift:shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   632
    e := e - shift.
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   633
    m := m bitAnd:(1 bitShift:nM)-1. 
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   634
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   635
    e := e + self eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   636
    ^ self class 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   637
        size:(self basicSize*8) exponentSize:exponentSize 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   638
        fraction:m exponent:e signBit:signBit.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   639
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   640
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   641
     self assert:((IEEEFloat fromFloat:1.0) / (IEEEFloat fromFloat:1.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   642
     self assert:((IEEEFloat fromFloat:1.0) / (IEEEFloat fromFloat:1.0)) exponent = 1.0 exponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   643
     self assert:((IEEEFloat fromFloat:1.0) / (IEEEFloat fromFloat:1.0)) mantissaBits = 1.0 mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   644
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   645
     self assert:((4.0 asIEEEFloat) / (2.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   646
     self assert:((-4.0 asIEEEFloat) / (2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   647
     self assert:((4.0 asIEEEFloat) / (-2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   648
     self assert:((-4.0 asIEEEFloat) / (-2.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   649
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   650
     self assert:((IEEEFloat fromFloat:100.0) / (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:50.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   651
     self assert:((IEEEFloat fromFloat:1e-20) / (IEEEFloat fromFloat:1e20)) = (IEEEFloat fromFloat:(1e-20 / 1e20)) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   652
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   653
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   654
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   655
sumFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   656
    "/ anIEEEFloat + self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   657
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   658
    |m1 m2 e1 e2 m e signBit hi shift nM1 nM2 nM|
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   659
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   660
    "/ bring to same exponent, add m1 + m2, normalize
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   661
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   662
    m1 := anIEEEFloat mantissaBits. 
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   663
    m1 == 0 ifTrue:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   664
        "/ always produce a positive zero
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   665
        self isZero ifTrue:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   666
            self negative ifTrue:[ ^ self copy basicAt:(self basicSize) put:0; yourself ].
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   667
        ].
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   668
        ^ self
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   669
    ].
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   670
    m2 := self mantissaBits.        
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   671
    m2 == 0 ifTrue:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   672
        anIEEEFloat isZero ifTrue:[
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   673
            anIEEEFloat negative ifTrue:[ ^ anIEEEFloat copy basicAt:(anIEEEFloat basicSize) put:0; yourself].
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   674
        ].
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   675
        ^ anIEEEFloat
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   676
    ].
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   677
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   678
    nM1 := anIEEEFloat numBitsInMantissa.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   679
    nM2 := nM := self numBitsInMantissa.
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   680
    nM1 ~= nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   681
        nM1 > nM2 ifTrue:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   682
            m2 := m2 bitShift:(nM1-nM2).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   683
            nM := nM1
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   684
        ] ifFalse:[
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   685
            m1 := m1 bitShift:(nM2-nM1).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   686
            nM := nM2
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   687
        ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   688
    ].
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   689
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   690
    e1 := anIEEEFloat exponentBits - anIEEEFloat eBias.
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   691
    e2 := self exponentBits - self eBias.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   692
    e := e1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   693
    e1 = e2 ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   694
        e1 > e2 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   695
            m2 := m2 rightShift:(e1 - e2).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   696
            e := e1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   697
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   698
            "/ e2 > e1
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   699
            m1 := m1 rightShift:(e2 - e1).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   700
            e := e2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   701
        ]
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   702
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   703
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   704
    signBit := 0.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   705
    "/ ok, add the mantissae
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   706
    self negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   707
        anIEEEFloat negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   708
            "/ - (anIEEEFloat + self)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   709
            m := m1 + m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   710
            signBit := 1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   711
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   712
            "/ anIEEEFloat - self 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   713
            m := m1 - m2
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   714
        ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   715
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   716
        anIEEEFloat negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   717
            "/ self - anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   718
            m := m2 - m1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   719
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   720
            "/ (anIEEEFloat + self)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   721
            m := m1 + m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   722
        ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   723
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   724
    m == 0 ifTrue:[^ self class zero].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   725
    m < 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   726
        m := m negated.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   727
        signBit := 1-signBit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   728
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   729
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   730
    hi := m highBit.    
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   731
    shift := (nM + 1) - hi. 
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   732
    m := m bitShift:shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   733
    e := e - shift.
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   734
    m := m bitAnd:(1 bitShift:nM)-1. 
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   735
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   736
    ^ self class 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   737
        size:(self basicSize*8) exponentSize:exponentSize 
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   738
        fraction:m exponent:(e + self eBias) signBit:signBit.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   739
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   740
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   741
     seee eeee  eeee mmmm  mmmm mmmm  mmmm mmmm  mmmm mmmm  mmmm mmmm  mmmm mmmm  mmmm mmmm 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   742
     0100 0000  0000 0000  0000 ......                                                       2.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   743
     0011 1111  1111 0000  0000 ......                                                       1.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   744
     0400 0000  0001 0000  0000 ......                                                       4.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   745
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   746
     self assert:(IEEEFloat fromFloat:1.0) exponent = 1.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   747
     self assert:(IEEEFloat fromFloat:1.0) mantissaBits = 1.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   748
     self assert:(IEEEFloat fromFloat:1.0) eBias = 1.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   749
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   750
     self assert:(IEEEFloat fromFloat:2.0) exponent = 2.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   751
     self assert:(IEEEFloat fromFloat:2.0) mantissaBits = 2.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   752
     self assert:(IEEEFloat fromFloat:2.0) eBias = 2.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   753
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   754
     self assert:(IEEEFloat fromFloat:4.0) exponent = 4.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   755
     self assert:(IEEEFloat fromFloat:4.0) mantissaBits = 4.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   756
     self assert:(IEEEFloat fromFloat:4.0) eBias = 4.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   757
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   758
     self assert:(IEEEFloat fromFloat:3.0) exponent = 3.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   759
     self assert:(IEEEFloat fromFloat:3.0) mantissaBits = 3.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   760
     self assert:(IEEEFloat fromFloat:3.0) eBias = 3.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   761
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   762
     self assert:(IEEEFloat fromFloat:10.0) exponent = 10.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   763
     self assert:(IEEEFloat fromFloat:10.0) mantissaBits = 10.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   764
     self assert:(IEEEFloat fromFloat:10.0) eBias = 10.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   765
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   766
     self assert:(IEEEFloat fromFloat:1e-3) exponent = 1e-3 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   767
     self assert:(IEEEFloat fromFloat:1e-3) mantissaBits = 1e-3 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   768
     self assert:(IEEEFloat fromFloat:1e-3) eBias = 1e-3 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   769
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   770
     (IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:1.0) = (IEEEFloat fromFloat:2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   771
     ((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:1.0)) exponent = 2.0 exponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   772
     ((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:1.0)) mantissaBits = 2.0 mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   773
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   774
     self assert:((-4.0 asIEEEFloat) + (2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   775
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   776
     (IEEEFloat fromFloat:2.0)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   777
     self assert:((IEEEFloat fromFloat:2.0) + (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:4.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   778
     self assert:((IEEEFloat fromFloat:4.0) + (IEEEFloat fromFloat:4.0)) = (IEEEFloat fromFloat:8.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   779
     self assert:((IEEEFloat fromFloat:0.0) + (IEEEFloat fromFloat:1.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   780
     self assert:((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:0.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   781
     self assert:((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:3.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   782
     self assert:((IEEEFloat fromFloat:100.0) + (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:102.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   783
     self assert:((IEEEFloat fromFloat:2.0) + (IEEEFloat fromFloat:100.0)) = (IEEEFloat fromFloat:102.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   784
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   785
     self assert:((IEEEFloat fromFloat:4.0) + (IEEEFloat fromFloat:-2.0)) = (IEEEFloat fromFloat:2.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   786
     self assert:((IEEEFloat fromFloat:8.0) + (IEEEFloat fromFloat:-2.0)) = (IEEEFloat fromFloat:6.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   787
     self assert:((IEEEFloat fromFloat:100.0) + (IEEEFloat fromFloat:-2.0)) = (IEEEFloat fromFloat:98.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   788
     self assert:((IEEEFloat fromFloat:-2.0) + (IEEEFloat fromFloat:100.0)) = (IEEEFloat fromFloat:98.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   789
     self assert:((IEEEFloat fromFloat:-2.0) + (IEEEFloat fromFloat:-100.0)) = (IEEEFloat fromFloat:-102.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   790
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   791
     self assert:((IEEEFloat fromFloat:-0.1) + (IEEEFloat fromFloat:0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   792
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   793
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   794
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   795
!IEEEFloat methodsFor:'inspecting'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   796
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   797
inspectorExtraAttributes
5345
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   798
    ^ super inspectorExtraAttributes "/ #()
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   799
! !
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   800
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   801
!IEEEFloat methodsFor:'mathematical functions'!
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   802
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   803
log10
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   804
    "return log base-10 of the receiver.
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   805
     Raises an exception, if the receiver is less or equal to zero.
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   806
     Here, fallback to the general logarithm code."
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   807
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   808
    ^ self ln / (self coerce:Float ln10)
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   809
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   810
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   811
!IEEEFloat methodsFor:'printing & storing'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   812
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   813
printOn:aStream
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   814
    thisContext isRecursive ifTrue:[
5345
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   815
        aStream nextPutAll:'IEEEFloat (recursion error while printing)'.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   816
        ^ self.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   817
    ].
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   818
    "/ super printOn:aStream.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   819
    PrintfScanf printf:'%g' on:aStream argument:self.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   820
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   821
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   822
!IEEEFloat methodsFor:'queries'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   823
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   824
eBias
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   825
    "Answer the exponent's bias;
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   826
     that is the offset of the zero exponent when stored"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   827
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   828
    ^ (1 bitShift:exponentSize-1) - 1
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   829
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   830
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   831
     1.0 numBitsInExponent 11
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   832
     1.0 eBias             1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   833
     1.0 emin              -1022
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   834
     1.0 emax              1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   835
     1.0 fmin              2.2250738585072E-308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   836
     1.0 fmax              1.79769313486232E+308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   837
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   838
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   839
5345
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   840
epsilon
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   841
    ^ self radix asFloat raisedToInteger:(1 - self precision)
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   842
!
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   843
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   844
numBitsInExponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   845
    ^ exponentSize
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   846
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   847
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   848
     1.0 numBitsInExponent 11
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   849
     1.0 numBitsInMantissa 52
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   850
     1.0 precision         53
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   851
     1.0 decimalPrecision  16
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   852
     1.0 eBias             1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   853
     1.0 emin              -1022
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   854
     1.0 emax              1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   855
     1.0 fmin              2.2250738585072E-308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   856
     1.0 fmax              1.79769313486232E+308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   857
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   858
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   859
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   860
numBitsInMantissa
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   861
    "answer the number of bits in the mantissa (the significant).
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   862
     This is an IEEE float,
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   863
        where n*8 - 1 - exponentSize (n=nr of bytes)
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   864
     bits are available in the mantissa (the hidden bit is not counted here):
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   865
        s ee...ee mmm...mmm
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   866
    "
5334
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   867
fcba54f692d0 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
   868
    ^ (self basicSize * 8) - exponentSize - 1 "/ sign
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   869
!
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   870
5345
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   871
precision
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   872
    ^ self numBitsInMantissa + 1 - self numBitsInIntegerPart 
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   873
!
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   874
5342
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   875
radix
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   876
    "Answer the exponent's radix"
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   877
ff3fcae67b03 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 5341
diff changeset
   878
    ^ 2
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   879
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   880
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   881
!IEEEFloat methodsFor:'testing'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   882
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   883
isFinite
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   884
    "return true, if the receiver is a finite float (not NaN or +/-INF)"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   885
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   886
   ^ self exponentBits ~= ((1 bitShift:self numBitsInExponent)-1)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   887
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   888
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   889
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   890
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   891
isInfinite
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   892
    "return true, if the receiver is an infinite float (+/-INF)"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   893
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   894
   ^ (self exponentBits = ((1 bitShift:self numBitsInExponent)-1))
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   895
   and:[ self mantissaBits = 0 ]
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   896
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   897
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   898
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   899
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   900
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   901
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   902
isNaN
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   903
    "return true, if the receiver is an invalid float (NaN - not a number)"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   904
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   905
   ^ (self exponentBits = ((1 bitShift:self numBitsInExponent)-1))
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   906
   and:[ self mantissaBits ~= 0 ]
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   907
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   908
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   909
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   910
5333
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   911
isZero
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   912
    "return true, if the receiver is zero"
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   913
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   914
    1 to:self basicSize-1 do:[:i | 
5333
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   915
        (self basicAt:i) ~~ 0 ifTrue:[^ false].
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   916
    ].
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   917
    ((self basicAt:self basicSize) bitAnd:16r7F) ~~ 0 ifTrue:[^ false].     
5333
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   918
    ^ true
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   919
5355
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   920
    "
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   921
     0.0 negated = 0.0
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   922
     0.0 negated isZero
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   923
     0.0 asIEEEFloat isZero
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   924
     0.0 asIEEEFloat negated isZero   
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   925
     0.0 asIEEEFloat = 0.0        
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   926
     0.0 asIEEEFloat negated = 0.0   
e07f5bcb8485 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5346
diff changeset
   927
    "
5333
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   928
!
7e56ac13f641 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 5331
diff changeset
   929
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   930
negative
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   931
    "return true if the receiver is less than zero."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   932
5356
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   933
    |sz hi|
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   934
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   935
    sz := self basicSize.
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   936
    ((hi := self basicAt:sz) bitTest:16r80) ifTrue:[
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   937
        "/ possibly negative; but could still be a negative zero
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   938
        hi == 16r80 ifFalse:[^ true].
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   939
        1 to:sz-1 do:[:i | (self basicAt:i) == 0 ifFalse:[^ true]].
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   940
        "/ yes - it is -0.0
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   941
    ].
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   942
    ^ false
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   943
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   944
    "
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   945
     -1.0 asIEEEFloat negative  
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   946
     0.0 asIEEEFloat negative   
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   947
     -0.0 asIEEEFloat negative  
c5036483d628 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5355
diff changeset
   948
    "
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   949
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   950
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   951
positive
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   952
    "return true if the receiver is greater or equal to zero."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   953
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   954
    ^ ((self basicAt:self basicSize) bitTest:16r80) not
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   955
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   956
5345
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   957
!IEEEFloat methodsFor:'truncation & rounding'!
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   958
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   959
ceilingAsFloat
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   960
    "return the smallest integer-valued float greater or equal to the receiver.
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   961
     This is much like #ceiling, but avoids a (possibly expensive) conversion
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   962
     of the result to an integer.
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   963
     It may be useful, if the result is to be further used in another float-operation."
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   964
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   965
    self halt.
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   966
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   967
    "
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   968
     1.5 asIEEEFloat ceilingAsFloat
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
   969
    "
5346
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   970
!
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   971
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   972
fractionPart
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   973
    "extract the after-decimal fraction part.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   974
     such that (self truncated + self fractionPart) = self"
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   975
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   976
    |e eB n m nM|
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   977
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   978
    e := self exponentBits.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   979
    eB := self eBias.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   980
    e < eB ifTrue:[
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   981
        "/ integer part is zero
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   982
        ^ self
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   983
    ].
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   984
    m := self mantissaBits.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   985
    n := e - eB + 1.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   986
    e := eB - 1.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   987
    nM := self numBitsInMantissa. 
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   988
    m := (m bitShift:n) bitAnd:(1 bitShift:nM)-1.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   989
    "/ normalize
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   990
    [m highBit == nM] whileTrue:[
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   991
        m := m bitShift:1.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   992
        e := e - 1.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   993
    ].
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   994
    ^ ((self class basicNew:self basicSize) exponentSize:exponentSize)
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   995
        setFraction:m exponent:e signBit:(self negative ifTrue:[1] ifFalse:[0]).
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   996
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   997
    "
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   998
     1.5 asIEEEFloat ceilingAsFloat
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
   999
    "
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1000
!
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1001
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1002
truncated
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1003
    "return the receiver truncated towards zero as an integer"
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1004
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1005
    ^ super truncated.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1006
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1007
    "
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1008
     1.5 asIEEEFloat truncated
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1009
    "
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1010
!
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1011
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1012
truncatedAsFloat
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1013
    "return the receiver truncated towards zero as a float.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1014
     This is much like #truncated, but avoids a (possibly expensive) conversion
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1015
     of the result to an integer.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1016
     It may be useful, if the result is to be further used in another
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1017
     float-operation."
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1018
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1019
    ^ self - self fractionPart.
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1020
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1021
    "
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1022
     1.5  truncatedAsFloat
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1023
     1.0  truncatedAsFloat
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1024
     1.5 asIEEEFloat truncatedAsFloat
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1025
     1.0 asIEEEFloat truncatedAsFloat
fc0657f18862 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 5345
diff changeset
  1026
    "
5345
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
  1027
! !
81044fb6e21b #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5342
diff changeset
  1028
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1029
!IEEEFloat class methodsFor:'documentation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1030
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1031
version_CVS
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1032
    ^ '$Header$'
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1033
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1034