IEEEFloat.st
author Claus Gittinger <cg@exept.de>
Sun, 01 Dec 2019 06:14:58 +0100
changeset 5331 bd628a8e55a6
parent 5324 0867b8fdd273
child 5333 7e56ac13f641
permissions -rw-r--r--
#BUGFIX by exept class: IEEEFloat comment/format in: #= changed: #productFromIEEEFloat: #quotientFromIEEEFloat: #sumFromIEEEFloat:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
     1
"{ Encoding: utf8 }"
Claus Gittinger <cg@exept.de>
parents: 5278
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.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
!IEEEFloat class methodsFor:'instance creation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    29
fromFloat:aFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    30
    |nB f|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    31
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    32
    nB := aFloat byteSize.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    33
    f := self basicNew:nB.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    34
    1 to:nB do:[:i |
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    35
        f basicAt:i put:(aFloat byteAt:i)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    36
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    37
    f exponentSize:(aFloat numBitsInExponent).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    38
    ^ f
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    39
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    40
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    41
     self fromFloat:1.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    42
     self fromFloat:2.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    43
     self fromFloat:1.0 asShortFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    44
     self fromFloat:2.0 asShortFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    45
     self fromFloat:1.0 asLongFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    46
     self fromFloat:2.0 asLongFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    47
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    48
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    49
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
size:numBits exponentSize:exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    ^ (self basicNew:(numBits // 8)) exponentSize:exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
     self size:256 exponentSize:19
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    55
     self size:16 exponentSize:5
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    56
     self size:(1.0 basicSize * 8) exponentSize:(1.0 numBitsInExponent)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    57
    "
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
size:numBits exponentSize:exponentSize fraction:anInteger exponent:exp signBit:signBit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    61
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    62
            setFraction:anInteger exponent:exp signBit:signBit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    63
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    64
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    65
     self size:256 exponentSize:19 fromInteger:1
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    66
     self size:256 exponentSize:19 fromInteger:2
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
size:numBits exponentSize:exponentSize fromFloat:aFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) setValueFromFloat:aFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
     self size:256 exponentSize:19 fromFloat:1.0
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
     self size:256 exponentSize:19 fromFloat:2.0
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
size:numBits exponentSize:exponentSize fromInteger:anInteger
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) setValueFromInteger:anInteger
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
     self size:256 exponentSize:19 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
     self size:256 exponentSize:19 fromInteger:2
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    88
!IEEEFloat class methodsFor:'coercing & converting'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    89
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    90
coerce:aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    91
    "convert the argument aNumber into an instance of the receiver (class) and return it."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    92
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    93
    ^ aNumber asIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    94
! !
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    96
!IEEEFloat class methodsFor:'constants'!
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    98
unity
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
    99
    ^ 1.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   100
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   101
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   102
zero
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   103
    ^ 0.0
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
!IEEEFloat methodsFor:'accessing'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   108
exponentBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   109
    "return the bits of my exponent.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   110
     These might be biased.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   111
     My bytes are stored LSB first; thus we have to fetch the high exponent bytes."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   112
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   113
   |nBytes nExpBytes e|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   114
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   115
   nBytes := self basicSize.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   116
   nExpBytes := (exponentSize + 7) // 8.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   117
   "/ seee eeee eeee mmmm mmmm ....
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   118
   e := (self basicAt:nBytes) bitAnd:16r7F.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   119
   2 to:nExpBytes do:[:eI |
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   120
        e := (e bitShift:8) bitOr:(self basicAt:nBytes + 1 - eI)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   121
   ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   122
   "/ 0eee eeee eeee mmmm
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   123
   e := e rightShift:(nExpBytes * 8) - 1 "sign" - exponentSize.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   124
   "/ 0000 0eee eeee eeee 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   125
   ^ e
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   126
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   127
   "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   128
    (self size:32 exponentSize:8) inspect.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   129
   "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   130
   "construct a soft-shortFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   131
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   132
    |f sf|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   133
    sf := 1.0 asShortFloat.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   134
    f := self size:(sf basicSize * 8) exponentSize:(sf numBitsInExponent).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   135
    1 to:sf basicSize do:[:i | f basicAt:i put:(sf basicAt:i)].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   136
    f inspect
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   137
   "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   138
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   139
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   140
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   141
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
    ^ exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
exponentSize:something
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
    exponentSize := something.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   150
mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   151
    "return the bits of my mantissa (incl. the hidden bit).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   152
     My bytes are stored LSB first."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   153
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   154
    |bits hiddenBit mask c|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   155
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   156
    bits := self digitBytes asIntegerMSB:false.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   157
    bits == 0 ifTrue:[^ 0].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   158
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   159
    hiddenBit := (1 bitShift:self numBitsInMantissa).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   160
    mask := hiddenBit-1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   161
    c := bits bitAnd:mask.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   162
    "/ TODO: care for subnormals (exponent = 0)!!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   163
    ^ c bitOr:hiddenBit.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   164
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   165
    " 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   166
     (self size:32 exponentSize:8) inspect.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   167
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   168
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   169
   "construct a soft-shortFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   170
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   171
    |f sf|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   172
    sf := 1.0 asShortFloat.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   173
    f := self size:(sf basicSize * 8) exponentSize:(sf numBitsInExponent).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   174
    1 to:sf basicSize do:[:i | f basicAt:i put:(sf basicAt:i)].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   175
    f inspect
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   176
   "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   177
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   178
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   179
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   180
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   181
setFraction:fraction exponent:exponent signBit:signBit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   182
    |bits|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   183
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   184
    bits := (fraction 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   185
            bitOr:(exponent bitShift:self numBitsInMantissa))
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   186
            bitOr:(signBit bitShift:(self basicSize * 8) - 1). 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   187
    1 to:self basicSize do:[:i | self basicAt:i put:(bits digitAt:i)].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   188
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   189
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   190
     (self size:64 exponentSize:11) setFraction:0 exponent:1024 signBit:0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   191
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   192
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   193
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
setValueFromInteger:intValue
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
    "/ how many bits are there, in this int
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
    |absValue myNumBits numBitsInNumber shift|
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
    absValue := intValue abs. 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
    numBitsInNumber := absValue highBit.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
    myNumBits := (self basicSize * 8) - 1 "sign" - exponentSize.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
    shift := myNumBits - numBitsInNumber. 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
    numBitsInNumber > myNumBits ifTrue:[
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
        self halt.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
    ] ifFalse:[
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
        "/ number:
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
        "/    1xxxxxxx...xxxxx
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
        "/ myRep:
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
        "/    seee...eeexxxxxxxxxx
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
        absValue digitLength to:1 by:-1 do:[:byteIndex |
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
            
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
        ].
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
    ].
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
    "/ cut off some bits
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
    "Float numBitsInExponent
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
     self size:16 exponentSize:4 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
     self size:32 exponentSize:11 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
     self size:256 exponentSize:19 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
     self size:256 exponentSize:19 fromInteger:2
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   225
!IEEEFloat methodsFor:'arithmetic'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   226
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   227
* aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   228
    thisContext isRecursive ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   229
    ^ aNumber productFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   230
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   231
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   232
+ aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   233
    thisContext isRecursive ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   234
    ^ aNumber sumFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   235
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   236
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   237
     (-2.0 asIEEEFloat)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   238
     (2.0 asIEEEFloat)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   239
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   240
     self assert:((4.0 asIEEEFloat) + (2.0 asIEEEFloat)) = (6.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   241
     self assert:((4.0 asIEEEFloat) + (-2.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   242
     self assert:((-4.0 asIEEEFloat) + (-2.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   243
     self assert:((-4.0 asIEEEFloat) + (2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   244
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   245
     self assert:((2.0 asIEEEFloat) + (4.0 asIEEEFloat)) = (6.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   246
     self assert:((2.0 asIEEEFloat) + (-4.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   247
     self assert:((-2.0 asIEEEFloat) + (-4.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   248
     self assert:((-2.0 asIEEEFloat) + (4.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   249
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   250
     self assert:((IEEEFloat fromFloat:0.1) + (IEEEFloat fromFloat:-0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   251
     self assert:((IEEEFloat fromFloat:-0.1) + (IEEEFloat fromFloat:0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   252
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   253
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   254
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   255
- aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   256
    thisContext isRecursive ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   257
    ^ aNumber differenceFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   258
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   259
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   260
     self assert:((4.0 asIEEEFloat) - (2.0 asIEEEFloat)) = (2.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   261
     self assert:((4.0 asIEEEFloat) - (-2.0 asIEEEFloat)) = (6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   262
     self assert:((-4.0 asIEEEFloat) - (-2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   263
     self assert:((-4.0 asIEEEFloat) - (2.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   264
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   265
     self assert:((2.0 asIEEEFloat) - (4.0 asIEEEFloat)) = (-2.0 asIEEEFloat)   
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   266
     self assert:((2.0 asIEEEFloat) - (-4.0 asIEEEFloat)) = (6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   267
     self assert:((-2.0 asIEEEFloat) - (-4.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   268
     self assert:((-2.0 asIEEEFloat) - (4.0 asIEEEFloat)) = (-6.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   269
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   270
     self assert:((IEEEFloat fromFloat:0.1) - (IEEEFloat fromFloat:0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   271
     self assert:((IEEEFloat fromFloat:0.1) - (IEEEFloat fromFloat:-0.1)) = (IEEEFloat fromFloat:0.2)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   272
     self assert:((IEEEFloat fromFloat:-0.1) - (IEEEFloat fromFloat:-0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   273
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   274
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   275
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   276
/ aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   277
    thisContext isRecursive ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   278
    ^ aNumber quotientFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   279
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   280
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   281
negated
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   282
    |f highByte|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   283
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   284
    f := self copy.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   285
    highByte := self basicAt:(self basicSize).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   286
    f basicAt:(self basicSize) put:(highByte bitXor:16r80).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   287
    ^ f.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   288
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   289
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   290
     self assert:(IEEEFloat fromFloat:2.0) negated = (IEEEFloat fromFloat:-2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   291
     self assert:(IEEEFloat fromFloat:2.0) negated negated = (IEEEFloat fromFloat:2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   292
     self assert:(IEEEFloat fromFloat:-2.0) negated = (IEEEFloat fromFloat:2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   293
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   294
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   295
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   296
!IEEEFloat methodsFor:'coercing & converting'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   297
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   298
generality
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   299
    ^ 97   "/ between OctaFloat and LargeFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   300
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   301
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   302
     1 asShortFloat generality 70
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   303
     1 asFloat generality      80
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   304
     1 asLongFloat generality  90
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   305
     1 asQuadFloat generality
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   306
     1 asQDouble generality    95
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   307
     1 asLargeFloat generality 100
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
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   311
!IEEEFloat methodsFor:'comparing'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   312
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   313
< aNumber
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   314
self halt.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   315
thisContext isRecursive ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   316
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   317
    ^ aNumber lessFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   318
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   319
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   320
= aNumber
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   321
    thisContext isRecursive ifTrue:[self halt].
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   322
    ^ aNumber equalFromIEEEFloat:self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   323
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   325
!IEEEFloat methodsFor:'double dispatching'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   326
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   327
differenceFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   328
    "/ anIEEEFloat - self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   329
    ^ self negated sumFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   330
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   331
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   332
equalFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   333
    anIEEEFloat basicSize == self basicSize ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   334
        anIEEEFloat exponentSize == exponentSize ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   335
            1 to:self basicSize do:[:i |
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   336
                (self basicAt:i) = (anIEEEFloat basicAt:i) ifFalse:[^ false].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   337
            ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   338
            ^ true.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   339
        ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   340
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   341
    "/ more complicated compare
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   342
    self halt.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   343
    ^ false.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   344
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   345
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   346
lessFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   347
    ||
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   348
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   349
    anIEEEFloat basicSize == self basicSize ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   350
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   351
    self halt.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   352
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   353
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   354
productFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   355
    "/ anIEEEFloat * self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   356
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   357
    |m1 m2 e1 e2 m e signBit nB hi shift|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   358
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   359
    "/ for now:
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   360
    self assert:(self numBitsInMantissa == anIEEEFloat numBitsInMantissa).
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   361
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   362
    "/ m1 * m2 / e1 + e2
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   363
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   364
    m1 := anIEEEFloat mantissaBits. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   365
    m2 := self mantissaBits.        
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   366
    e1 := anIEEEFloat exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   367
    e2 := self exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   368
    e := (e1 - anIEEEFloat eBias) + (e2 - self eBias).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   369
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   370
    nB := self numBitsInMantissa.  "/ exl. hidden bit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   371
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   372
    "/ 1xxxx....xxxx * 1xxxx....xxxx
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   373
    m := m1 * m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   374
    "/ now have nB bits too many
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   375
    e := e - nB.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   376
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   377
    signBit := (self negative == anIEEEFloat negative) ifTrue:[0] ifFalse:[1].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   378
    m == 0 ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   379
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   380
    hi := m highBit.    
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   381
    shift := (nB + 1) - hi. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   382
    m := m bitShift:shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   383
    e := e - shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   384
    m := m bitAnd:(1 bitShift:nB)-1. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   385
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   386
    e := e + self eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   387
    ^ self class 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   388
        size:(self basicSize*8) exponentSize:exponentSize 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   389
        fraction:m exponent:e signBit:signBit.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   390
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   391
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   392
     self assert:((IEEEFloat fromFloat:1.0) * (IEEEFloat fromFloat:1.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   393
     self assert:((IEEEFloat fromFloat:1.0) * (IEEEFloat fromFloat:1.0)) exponent = 1.0 exponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   394
     self assert:((IEEEFloat fromFloat:1.0) * (IEEEFloat fromFloat:1.0)) mantissaBits = 1.0 mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   395
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   396
     self assert:((4.0 asIEEEFloat) * (2.0 asIEEEFloat)) = (8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   397
     self assert:((-4.0 asIEEEFloat) * (2.0 asIEEEFloat)) = (-8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   398
     self assert:((4.0 asIEEEFloat) * (-2.0 asIEEEFloat)) = (-8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   399
     self assert:((-4.0 asIEEEFloat) * (-2.0 asIEEEFloat)) = (8.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   400
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   401
     self assert:((IEEEFloat fromFloat:100.0) * (IEEEFloat fromFloat:100.0)) = (IEEEFloat fromFloat:10000.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   402
     self assert:((IEEEFloat fromFloat:1e-20) * (IEEEFloat fromFloat:1e20)) = (IEEEFloat fromFloat:(1e-20 * 1e20)) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   403
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   404
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   405
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   406
quotientFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   407
    "/ anIEEEFloat / self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   408
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   409
    |m1 m2 e1 e2 m e signBit nB hi shift|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   410
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   411
    "/ for now:
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   412
    self assert:(self numBitsInMantissa == anIEEEFloat numBitsInMantissa).
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   413
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   414
    "/ m1 / m2 / e1 - e2
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   415
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   416
    m1 := anIEEEFloat mantissaBits. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   417
    m2 := self mantissaBits.        
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   418
    e1 := anIEEEFloat exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   419
    e2 := self exponentBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   420
    e := (e1 - anIEEEFloat eBias) - (e2 - self eBias).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   421
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   422
    nB := self numBitsInMantissa.  "/ exl. hidden bit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   423
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   424
    "/ 1xxxx....xxxx / 1xxxx....xxxx
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   425
    m := (m1 bitShift:nB) // m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   426
    "/ rest := m1 \\ m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   427
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   428
    signBit := (self negative == anIEEEFloat negative) ifTrue:[0] ifFalse:[1].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   429
    m == 0 ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   430
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   431
    hi := m highBit.    
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   432
    shift := (nB + 1) - hi. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   433
    m := m bitShift:shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   434
    e := e - shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   435
    m := m bitAnd:(1 bitShift:nB)-1. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   436
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   437
    e := e + self eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   438
    ^ self class 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   439
        size:(self basicSize*8) exponentSize:exponentSize 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   440
        fraction:m exponent:e signBit:signBit.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   441
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   442
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   443
     self assert:((IEEEFloat fromFloat:1.0) / (IEEEFloat fromFloat:1.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   444
     self assert:((IEEEFloat fromFloat:1.0) / (IEEEFloat fromFloat:1.0)) exponent = 1.0 exponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   445
     self assert:((IEEEFloat fromFloat:1.0) / (IEEEFloat fromFloat:1.0)) mantissaBits = 1.0 mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   446
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   447
     self assert:((4.0 asIEEEFloat) / (2.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   448
     self assert:((-4.0 asIEEEFloat) / (2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   449
     self assert:((4.0 asIEEEFloat) / (-2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   450
     self assert:((-4.0 asIEEEFloat) / (-2.0 asIEEEFloat)) = (2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   451
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   452
     self assert:((IEEEFloat fromFloat:100.0) / (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:50.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   453
     self assert:((IEEEFloat fromFloat:1e-20) / (IEEEFloat fromFloat:1e20)) = (IEEEFloat fromFloat:(1e-20 / 1e20)) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   454
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   455
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   456
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   457
sumFromIEEEFloat:anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   458
    "/ anIEEEFloat + self
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   459
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   460
    |m1 m2 e1 e2 m e signBit nB hi shift|
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   461
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   462
    "/ for now:
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   463
    self assert:(self numBitsInMantissa == anIEEEFloat numBitsInMantissa).
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   464
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   465
    "/ bring to same exponent, add m1 + m2, normalize
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   466
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   467
    m1 := anIEEEFloat mantissaBits. m1 == 0 ifTrue:[^ self].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   468
    m2 := self mantissaBits.        m2 == 0 ifTrue:[^ anIEEEFloat].
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   469
    e1 := anIEEEFloat exponentBits - anIEEEFloat eBias.
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   470
    e2 := self exponentBits - self eBias.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   471
    e := e1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   472
    e1 = e2 ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   473
        e1 > e2 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   474
            m2 := m2 rightShift:(e1 - e2).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   475
            e := e1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   476
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   477
            "/ e2 > e1
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   478
            m1 := m1 rightShift:(e2 - e1).
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   479
            e := e2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   480
        ]
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   481
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   482
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   483
    signBit := 0.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   484
    "/ ok, add the mantissae
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   485
    self negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   486
        anIEEEFloat negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   487
            "/ - (anIEEEFloat + self)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   488
            m := m1 + m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   489
            signBit := 1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   490
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   491
            "/ anIEEEFloat - self 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   492
            m := m1 - m2
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   493
        ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   494
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   495
        anIEEEFloat negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   496
            "/ self - anIEEEFloat
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   497
            m := m2 - m1.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   498
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   499
            "/ (anIEEEFloat + self)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   500
            m := m1 + m2.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   501
        ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   502
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   503
    m == 0 ifTrue:[^ self class zero].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   504
    m < 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   505
        m := m negated.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   506
        signBit := 1-signBit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   507
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   508
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   509
    nB := self numBitsInMantissa.  "/ exl. hidden bit
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   510
    hi := m highBit.    
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   511
    shift := (nB + 1) - hi. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   512
    m := m bitShift:shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   513
    e := e - shift.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   514
    m := m bitAnd:(1 bitShift:nB)-1. 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   515
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   516
    ^ self class 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   517
        size:(self basicSize*8) exponentSize:exponentSize 
5331
bd628a8e55a6 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 5324
diff changeset
   518
        fraction:m exponent:(e + self eBias)  signBit:signBit.
5324
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   519
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   520
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   521
     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
   522
     0100 0000  0000 0000  0000 ......                                                       2.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   523
     0011 1111  1111 0000  0000 ......                                                       1.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   524
     0400 0000  0001 0000  0000 ......                                                       4.0
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   525
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   526
     self assert:(IEEEFloat fromFloat:1.0) exponent = 1.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   527
     self assert:(IEEEFloat fromFloat:1.0) mantissaBits = 1.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   528
     self assert:(IEEEFloat fromFloat:1.0) eBias = 1.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   529
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   530
     self assert:(IEEEFloat fromFloat:2.0) exponent = 2.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   531
     self assert:(IEEEFloat fromFloat:2.0) mantissaBits = 2.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   532
     self assert:(IEEEFloat fromFloat:2.0) eBias = 2.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   533
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   534
     self assert:(IEEEFloat fromFloat:4.0) exponent = 4.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   535
     self assert:(IEEEFloat fromFloat:4.0) mantissaBits = 4.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   536
     self assert:(IEEEFloat fromFloat:4.0) eBias = 4.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   537
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   538
     self assert:(IEEEFloat fromFloat:3.0) exponent = 3.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   539
     self assert:(IEEEFloat fromFloat:3.0) mantissaBits = 3.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   540
     self assert:(IEEEFloat fromFloat:3.0) eBias = 3.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   541
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   542
     self assert:(IEEEFloat fromFloat:10.0) exponent = 10.0 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   543
     self assert:(IEEEFloat fromFloat:10.0) mantissaBits = 10.0 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   544
     self assert:(IEEEFloat fromFloat:10.0) eBias = 10.0 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   545
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   546
     self assert:(IEEEFloat fromFloat:1e-3) exponent = 1e-3 exponent.  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   547
     self assert:(IEEEFloat fromFloat:1e-3) mantissaBits = 1e-3 mantissaBits.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   548
     self assert:(IEEEFloat fromFloat:1e-3) eBias = 1e-3 eBias.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   549
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   550
     (IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:1.0) = (IEEEFloat fromFloat:2.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   551
     ((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:1.0)) exponent = 2.0 exponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   552
     ((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:1.0)) mantissaBits = 2.0 mantissaBits
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   553
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   554
     self assert:((-4.0 asIEEEFloat) + (2.0 asIEEEFloat)) = (-2.0 asIEEEFloat)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   555
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   556
     (IEEEFloat fromFloat:2.0)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   557
     self assert:((IEEEFloat fromFloat:2.0) + (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:4.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   558
     self assert:((IEEEFloat fromFloat:4.0) + (IEEEFloat fromFloat:4.0)) = (IEEEFloat fromFloat:8.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   559
     self assert:((IEEEFloat fromFloat:0.0) + (IEEEFloat fromFloat:1.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   560
     self assert:((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:0.0)) = (IEEEFloat fromFloat:1.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   561
     self assert:((IEEEFloat fromFloat:1.0) + (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:3.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   562
     self assert:((IEEEFloat fromFloat:100.0) + (IEEEFloat fromFloat:2.0)) = (IEEEFloat fromFloat:102.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   563
     self assert:((IEEEFloat fromFloat:2.0) + (IEEEFloat fromFloat:100.0)) = (IEEEFloat fromFloat:102.0) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   564
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   565
     self assert:((IEEEFloat fromFloat:4.0) + (IEEEFloat fromFloat:-2.0)) = (IEEEFloat fromFloat:2.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   566
     self assert:((IEEEFloat fromFloat:8.0) + (IEEEFloat fromFloat:-2.0)) = (IEEEFloat fromFloat:6.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   567
     self assert:((IEEEFloat fromFloat:100.0) + (IEEEFloat fromFloat:-2.0)) = (IEEEFloat fromFloat:98.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   568
     self assert:((IEEEFloat fromFloat:-2.0) + (IEEEFloat fromFloat:100.0)) = (IEEEFloat fromFloat:98.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   569
     self assert:((IEEEFloat fromFloat:-2.0) + (IEEEFloat fromFloat:-100.0)) = (IEEEFloat fromFloat:-102.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   570
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   571
     self assert:((IEEEFloat fromFloat:-0.1) + (IEEEFloat fromFloat:0.1)) = (IEEEFloat fromFloat:0.0)  
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   572
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   573
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   574
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   575
!IEEEFloat methodsFor:'inspecting'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   576
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   577
inspectorExtraAttributes
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   578
    ^ #()
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
!IEEEFloat methodsFor:'printing & storing'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   582
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   583
displayOn:aStream
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   584
aStream nextPutAll:'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   585
^ self.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   586
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   587
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   588
displayString
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   589
^ 'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   590
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   591
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   592
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   593
printOn:aStream
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   594
aStream nextPutAll:'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   595
^ self.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   596
    thisContext isRecursive ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   597
        aStream nextPutAll:'IEEEFloat (error while printing)'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   598
        ^ self.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   599
    ].
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   600
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   601
    PrintfScanf printf:'%g' on:aStream argument:self.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   602
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   603
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   604
printOn:aStream base:b
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   605
aStream nextPutAll:'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   606
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   607
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   608
printOn:aStream base:b showRadix:showRadix
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   609
aStream nextPutAll:'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   610
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   611
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   612
printOn:aStream thousandsSeparator:thousandsSeparator
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   613
aStream nextPutAll:'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   614
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   615
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   616
printString
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   617
^ 'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   618
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   619
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   620
printStringFormat:formatString
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   621
^ 'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   622
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   623
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   624
printStringRadix:base
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   625
^ 'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   626
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   627
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   628
printStringRadix:base showRadix:showRadixBoolean
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   629
^ 'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   630
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   631
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   632
printStringScientific
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   633
^ 'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   634
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   635
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   636
printfPrintString:formatString
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   637
^ 'IEEEFloat'.
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   638
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   639
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   640
!IEEEFloat methodsFor:'queries'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   641
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   642
eBias
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   643
    "Answer the exponent's bias;
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   644
     that is the offset of the zero exponent when stored"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   645
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   646
    ^ (1 bitShift:exponentSize-1) - 1
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   647
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   648
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   649
     1.0 numBitsInExponent 11
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   650
     1.0 eBias             1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   651
     1.0 emin              -1022
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   652
     1.0 emax              1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   653
     1.0 fmin              2.2250738585072E-308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   654
     1.0 fmax              1.79769313486232E+308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   655
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   656
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   657
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   658
numBitsInExponent
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   659
    ^ exponentSize
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   660
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   661
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   662
     1.0 numBitsInExponent 11
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   663
     1.0 numBitsInMantissa 52
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   664
     1.0 precision         53
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   665
     1.0 decimalPrecision  16
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   666
     1.0 eBias             1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   667
     1.0 emin              -1022
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   668
     1.0 emax              1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   669
     1.0 fmin              2.2250738585072E-308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   670
     1.0 fmax              1.79769313486232E+308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   671
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   672
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   673
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   674
numBitsInMantissa
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   675
    ^ (self basicSize * 8) 
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   676
    - 1 "/ sign
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   677
    - exponentSize
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   678
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   679
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   680
     1.0 numBitsInExponent 11
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   681
     1.0 numBitsInMantissa 52
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   682
     1.0 precision         53
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   683
     1.0 decimalPrecision  16
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   684
     1.0 eBias             1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   685
     1.0 emin              -1022
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   686
     1.0 emax              1023
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   687
     1.0 fmin              2.2250738585072E-308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   688
     1.0 fmax              1.79769313486232E+308
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   689
    "
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   690
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   691
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   692
!IEEEFloat methodsFor:'testing'!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   693
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   694
isFinite
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   695
    "return true, if the receiver is a finite float (not NaN or +/-INF)"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   696
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   697
   ^ self exponentBits ~= ((1 bitShift:self numBitsInExponent)-1)
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   698
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   699
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   700
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   701
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   702
isInfinite
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   703
    "return true, if the receiver is an infinite float (+/-INF)"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   704
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   705
   ^ (self exponentBits = ((1 bitShift:self numBitsInExponent)-1))
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   706
   and:[ self mantissaBits = 0 ]
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   707
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   708
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   709
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   710
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   711
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   712
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   713
isNaN
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   714
    "return true, if the receiver is an invalid float (NaN - not a number)"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   715
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   716
   ^ (self exponentBits = ((1 bitShift:self numBitsInExponent)-1))
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   717
   and:[ self mantissaBits ~= 0 ]
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   718
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   719
    "Modified: 12.2.1997 / 16:45:27 / cg"
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   720
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   721
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   722
negative
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   723
    "return true if the receiver is less than zero."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   724
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   725
    ^ (self basicAt:self basicSize) bitTest:16r80
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   726
!
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   727
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   728
positive
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   729
    "return true if the receiver is greater or equal to zero."
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   730
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   731
    ^ ((self basicAt:self basicSize) bitTest:16r80) not
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   732
! !
Claus Gittinger <cg@exept.de>
parents: 5278
diff changeset
   733
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
!IEEEFloat class methodsFor:'documentation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
version_CVS
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
    ^ '$Header$'
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739