LargeFloat.st
author Stefan Vogel <sv@exept.de>
Fri, 05 Sep 2003 12:29:15 +0200
changeset 7602 d048f13cd50a
parent 7552 4e9947615379
child 8634 2c838074e754
permissions -rw-r--r--
Exception classes initialize themself. Use exception class names instead of class variables.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 2003 by eXept Software AG
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
              All Rights Reserved
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"{ Package: 'stx:libbasic' }"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
LimitedPrecisionReal subclass:#LargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	instanceVariableNames:'exponent mantissa precision'
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	classVariableNames:'Zero One NaN PositiveInfinity NegativeInfinity Pi_1000 E_1000'
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	poolDictionaries:''
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	category:'Magnitude-Numbers'
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
!LargeFloat class methodsFor:'documentation'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
copyright
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
 COPYRIGHT (c) 2003 by eXept Software AG
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
              All Rights Reserved
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
 This software is furnished under a license and may be used
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 only in accordance with the terms of that license and with the
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 be provided or otherwise made available to, or used by, any
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 other person.  No title to or ownership of the software is
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
 hereby transferred.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
documentation
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
"
7547
7c6a67444648 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7546
diff changeset
    40
    Experimental Code.
7c6a67444648 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7546
diff changeset
    41
    The implementation is neither complete nor tuned for performance - Still being developed.
7c6a67444648 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7546
diff changeset
    42
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    This class provides arbitrary precision floats. These are represented as:
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
      exponent,
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
      mantissa
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    [author:]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
        Claus Gittinger
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    [see also:]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
        Number
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
        Float LongFloat ShortFloat Fraction FixedPoint 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
        SmallInteger LargeInteger
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
examples
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
     (1 to:1000) inject:1 asLargeFloat into:[:p :m | p * m]          
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
    61
     (1 to:1000) inject:1 into:[:p :m | p * m]                 
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
     Time millisecondsToRun:[ 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
        (1 to:20000) inject:1 asLargeFloat into:[:p :m | p * m]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
     ]  
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
     Time millisecondsToRun:[ 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
        (1 to:20000) inject:1 into:[:p :m | p * m]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
     ]   
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
!LargeFloat class methodsFor:'instance creation'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
fromInteger:anInteger
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
    ^ self basicNew 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
        mantissa:anInteger 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
        exponent:0
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
     LargeFloat fromInteger:123456
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
     1 asLargeFloat       
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
     2 asLargeFloat       
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
     1000 factorial asLargeFloat             
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
fromLimitedPrecisionReal:aLimitedPrecisionReal
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
    |shifty numBytes numBitsInMantissa maskMantissa numBitsInExponent maskExponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
     numIntegerBits numBits biasExponent lpRealClass sign expPart fractionPart fraction exp|
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
    aLimitedPrecisionReal isFinite ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
        aLimitedPrecisionReal isNaN ifTrue:[^ self NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
        aLimitedPrecisionReal > 0 ifTrue:[^ self infinity].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
        ^ self negativeInfinity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
    lpRealClass := aLimitedPrecisionReal class.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
    numBytes := aLimitedPrecisionReal basicSize.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
    numBitsInMantissa := lpRealClass numBitsInMantissa. maskMantissa := (1 bitShift:numBitsInMantissa) - 1.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    numBitsInExponent := lpRealClass numBitsInExponent. maskExponent := (1 bitShift:numBitsInExponent) - 1.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
    numIntegerBits := lpRealClass numBitsInIntegerPart.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
    numBits := numBitsInMantissa + numBitsInExponent. 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
    biasExponent := maskExponent bitShift:-1.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    shifty := LargeInteger basicNew numberOfDigits:numBytes.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
    UninterpretedBytes isBigEndian ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
        1 to:numBytes do:[:i | shifty digitAt:(numBytes+1-i) put:(aLimitedPrecisionReal basicAt:i)].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
    ] ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
        1 to:numBytes do:[:i | shifty digitAt:i put:(aLimitedPrecisionReal basicAt:i)].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
    sign := (shifty bitAt:numBits+1) == 0 ifTrue: [1] ifFalse: [-1].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
    expPart := (shifty bitShift:numBitsInMantissa negated) bitAnd: maskExponent.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
    fractionPart := shifty bitAnd:maskMantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    ( expPart=0 and: [ fractionPart=0 ] ) ifTrue: [ ^ self zero  ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
    numIntegerBits == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
        " Replace omitted leading 1 in fraction (Notice: quadIEEE format does not do this)"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
        fraction := fractionPart bitOr: (maskMantissa + 1).
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
    ] ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
        fraction := fractionPart.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
    "Unbias exponent"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
    exp := biasExponent - expPart + (numBitsInMantissa - numIntegerBits).
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
    ^ self basicNew 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
        mantissa:(fraction * sign) 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
        exponent:(exp negated)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
     1.0 asLargeFloat       
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
     2.0 asLargeFloat       
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
     20000.0 asLargeFloat   
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
     2e6 asLargeFloat                                  
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
     1e300 asLargeFloat             
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
     2e300 asLargeFloat             
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
     0.5 asLargeFloat      
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
     0.25 asLargeFloat     
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
     (1.0/20000.0) asLargeFloat 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
     2e-6 asLargeFloat        
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
     2e-300 asLargeFloat      
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
     -1.0 asLargeFloat       
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
     -0.5 asLargeFloat      
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
     Float NaN asLargeFloat              
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
     Float infinity asLargeFloat         
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
     Float negativeInfinity asLargeFloat 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
mantissa:m exponent:e
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
    ^ self basicNew mantissa:m exponent:e
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
     LargeFloat mantissa:1 exponent:0 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
     LargeFloat mantissa:2 exponent:0 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
     LargeFloat mantissa:4 exponent:0   
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
     LargeFloat mantissa:8 exponent:0 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
     LargeFloat mantissa:1 exponent:-1
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
     LargeFloat mantissa:1 exponent:-2
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
     LargeFloat mantissa:1 exponent:-3
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
mantissa:m exponent:e precision:p
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
    ^ self basicNew mantissa:m exponent:e precision:p
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
!LargeFloat class methodsFor:'class initialization'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
initialize
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
    NaN := self mantissa:0 exponent:999.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
    PositiveInfinity := self mantissa:0 exponent:1.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
    NegativeInfinity := self mantissa:0 exponent:-1.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
    One := self mantissa:1 exponent:0.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
    Zero := self mantissa:0 exponent:0.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
     LargeFloat initialize
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
!LargeFloat class methodsFor:'constants'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
    ^ NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
     LargeFloat NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
     (0.0 uncheckedDivide:0.0)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
infinity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
    ^ PositiveInfinity 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
     LargeFloat infinity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
     (1.0 uncheckedDivide:0.0)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
negativeInfinity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
    ^ NegativeInfinity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
     LargeFloat negativeInfinity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
     (-1.0 uncheckedDivide:0.0)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
pi
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
    Pi_1000 isNil ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
        Pi_1000 := FixedPoint pi asLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
    ^ Pi_1000.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
     LargeFloat pi
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
unity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
    ^ One
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
     LargeFloat unity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
zero
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
    ^ Zero
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
     LargeFloat zero
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
!LargeFloat methodsFor:'accessing'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
exponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
    ^ exponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
mantissa
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
    ^ mantissa
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
precision
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
    ^ precision ? 200
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
!LargeFloat methodsFor:'arithmetic'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
* aNumber
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
    ^ aNumber productFromLargeFloat:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
+ aNumber
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
    ^ aNumber sumFromLargeFloat:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
     1.0 asLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
- aNumber
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
    ^ aNumber differenceFromLargeFloat:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   273
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
/ aNumber
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
    ^ aNumber quotientFromLargeFloat:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
negated
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
    mantissa = 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
        exponent = 0 ifTrue:[ ^ self ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
        self == NaN ifTrue:[^ self].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
        self == NegativeInfinity ifTrue:[^ PositiveInfinity].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
        ^ NegativeInfinity
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
    ^ self class 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
        mantissa:(mantissa negated)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
        exponent:exponent 
7459
9cc5219fa2cd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7445
diff changeset
   290
        precision:self precision.
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
     LargeFloat unity negated
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
!LargeFloat methodsFor:'coercing & converting'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
asInteger
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
    "return an integer with same value - might truncate"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
    exponent = 0 ifTrue:[^ mantissa].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
    mantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
        "/ INF or NAN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
        ^ self class
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
            raise:#domainErrorSignal
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
            receiver:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
            selector:#asInteger
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
            arguments:#()
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
            errorString:'Cannot represent non-finite as integer'.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
"/        ^ self asMetaNumber.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   315
    exponent > 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   316
        ^ mantissa * (2 raisedTo:exponent)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   318
    ^ mantissa // (2 raisedTo:exponent negated)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   321
     (self new exponent:0 mantissa:100) asInteger 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   322
     (self new exponent:1 mantissa:100) asInteger 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
     (self new exponent:-1 mantissa:100) asInteger 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   324
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   325
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   326
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   327
asLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   328
    "return a large float with same value - thats me"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   329
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   330
    ^ self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   332
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
asTrueFraction
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   334
    "Answer a fraction or integer that EXACTLY represents self."
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   335
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   336
    exponent = 0 ifTrue: [ ^ mantissa].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   337
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
    mantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
        "/ INF or NAN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
        ^ self class
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
            raise:#conversionErrorSignal
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   342
            receiver:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
            selector:#asTrueFraction
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
            arguments:#()
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   345
            errorString:'Cannot represent non-finite float as fraction'.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   346
"/        ^ self asMetaNumber.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   347
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   348
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   349
    exponent > 0 ifTrue: [
7552
4e9947615379 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7550
diff changeset
   350
        ^ mantissa bitShift:exponent 
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   351
    ].
7552
4e9947615379 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7550
diff changeset
   352
    ^ Fraction
4e9947615379 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7550
diff changeset
   353
        numerator: mantissa
4e9947615379 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7550
diff changeset
   354
        denominator: (1 bitShift:exponent negated) 
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   355
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   356
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   357
     0.3 asFloat asTrueFraction   
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   358
     0.3 asShortFloat asTrueFraction  
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   359
     0.3 asLongFloat asTrueFraction   
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
     0.3 asLargeFloat asTrueFraction   
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
     1 asLargeFloat asTrueFraction     
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   363
     2 asLargeFloat asTrueFraction     
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   364
     0.5 asLargeFloat asTrueFraction     
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   365
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   366
     0.25 asLargeFloat asTrueFraction     
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   367
     -0.25 asLargeFloat asTrueFraction    
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   368
     0.125 asLargeFloat asTrueFraction    
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   369
     -0.125 asLargeFloat asTrueFraction    
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   370
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   371
     1.25 asLargeFloat asTrueFraction       
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   372
     3e37 asLargeFloat asTrueFraction     
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   373
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   374
     LargeFloat NaN asTrueFraction               -> error
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   375
     LargeFloat infinity asTrueFraction          -> error
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   376
     LargeFloat negativeInfinity asTrueFraction  -> error
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   377
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   378
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   379
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   380
coerce:aNumber
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   381
    "return the argument as a LargeFloat"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   382
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   383
    ^ aNumber asLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   384
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   385
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   386
generality
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   387
    "return the generality value - see ArithmeticValue>>retry:coercing:"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   388
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   389
    ^ 100
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   390
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   392
!LargeFloat methodsFor:'comparing'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   393
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   394
< aNumber
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   395
    "return true, if the argument is greater"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   396
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   397
    ^ aNumber lessFromLargeFloat:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   398
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   399
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   400
= aNumber
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   401
    "return true, if the argument is equal in value"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   402
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   403
    ^ aNumber equalFromLargeFloat:self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   406
     LargeFloat unity = LargeFloat zero  
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   407
     LargeFloat unity = LargeFloat unity 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   408
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   409
     LargeFloat unity = nil            
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
     LargeFloat unity ~= nil            
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   412
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   413
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   414
hash
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   415
    "return a number for hashing; redefined, since floats compare
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
     by numeric value (i.e. 3.0 = 3), therefore 3.0 hash must be the same
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
     as 3 hash."
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
    exponent == 0 ifTrue:[^ mantissa hash].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
    exponent < 64 ifTrue:[^ (mantissa bitShift:exponent) hash ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
    ^ mantissa hash bitXor:exponent hash
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   422
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   424
     LargeFloat unity hash
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   425
     LargeFloat zero hash
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   426
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
     3 hash       
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
     3.0 hash
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
     3.1 hash  
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   430
     3.14159 hash  
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   431
     31.4159 hash 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
     3.141591 hash 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
     1.234567890123456 hash  
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
     1.234567890123457 hash   
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
     Set withAll:#(3 3.0 99 99.0 3.1415)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   437
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   438
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   439
!LargeFloat methodsFor:'double dispatching'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   440
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   441
differenceFromLargeFloat:aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   442
    |otherExponent otherMantissa e m|
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   443
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   444
    otherExponent := aLargeFloat exponent.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   445
    otherMantissa := aLargeFloat mantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   447
    otherMantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   448
        otherExponent = 0 ifTrue:[^ self negated].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   449
        "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   450
        aLargeFloat isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
        self isFinite ifTrue:[^ aLargeFloat].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
        aLargeFloat sign ~~ self sign ifTrue:[^ self negated].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
        ^ NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
    mantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
        exponent = 0 ifTrue:[^ aLargeFloat].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   457
        "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   458
        self isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
        ^ self negated
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
    otherExponent = exponent ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
        m := otherMantissa - mantissa. 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
        e := exponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
    ] ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
        otherExponent> exponent ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
            m := (otherMantissa bitShift:(otherExponent-exponent)) - mantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
            e := exponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
        ] ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
            m := otherMantissa - (mantissa bitShift:(exponent-otherExponent)).
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
            e := otherExponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   472
        ]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
    ^ self class
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
        mantissa:m 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   476
        exponent:e
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   477
        precision:(self precision min:aLargeFloat precision)
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   478
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
equalFromLargeFloat:aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
    aLargeFloat exponent = exponent ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
        ^ aLargeFloat mantissa = mantissa
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
    "assuming normalized numbers, they cannot be equal then"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
    ^ false
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   488
lessFromLargeFloat:aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   489
    |otherExponent otherMantissa|
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
    otherExponent := aLargeFloat exponent.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   492
    otherMantissa := aLargeFloat mantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   493
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
    otherExponent > exponent ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
        ^ otherMantissa < (mantissa bitShift:(otherExponent-exponent))
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
    otherExponent < exponent ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
        ^ (otherMantissa bitShift:(exponent-otherExponent)) < mantissa
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
    ^ otherMantissa < mantissa
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   503
productFromLargeFloat:aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   504
    |otherMantissa otherExponent|
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   505
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   506
    otherMantissa := aLargeFloat mantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
    otherExponent := aLargeFloat exponent.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   508
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   509
    otherMantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
        otherExponent ~= 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   511
            "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   512
            aLargeFloat isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   513
            self negative ifTrue:[^ aLargeFloat negated].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   514
            ^ aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   515
        ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   517
    mantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   518
        exponent = 0 ifTrue:[^ self].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
        "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   520
        self isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   521
        aLargeFloat negative ifTrue:[^ self negated].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   522
        ^ self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   524
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   525
    ^ self class
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   526
        mantissa:(mantissa * otherMantissa) 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   527
        exponent:(exponent + otherExponent)
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   528
        precision:(self precision min:aLargeFloat precision)
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   529
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   530
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   531
quotientFromLargeFloat:aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   532
    "Return the quotient of the argument, aLargeFloat and the receiver.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   533
     Sent when aLargeFloat does not know how to divide by the receiver."
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   534
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   535
    |otherMantissa otherExponent q|
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   536
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   537
    otherMantissa := aLargeFloat mantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   538
    otherExponent := aLargeFloat exponent.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   539
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   540
    otherMantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   541
        otherExponent = 0 ifTrue:[^ aLargeFloat].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   542
        "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   543
        aLargeFloat isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
        self negative ifTrue:[^ aLargeFloat negated].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   545
        ^ aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   546
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   547
    mantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   548
        exponent = 0 ifTrue:[^ self].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
        "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   550
        self isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   551
        aLargeFloat negative ifTrue:[^ self negated].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   552
        ^ self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   553
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   554
    q := (otherMantissa / mantissa).
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   555
    q isInteger ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   556
        self halt.    
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   557
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
    ^ self class
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   559
        mantissa:q 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   560
        exponent:(otherExponent - exponent)
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   562
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   563
sumFromLargeFloat:aLargeFloat
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
    |otherExponent otherMantissa e m|
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
    otherExponent := aLargeFloat exponent.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
    otherMantissa := aLargeFloat mantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   569
    otherMantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   570
        otherExponent = 0 ifTrue:[^ self].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   571
        "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
        aLargeFloat isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   573
        self isFinite ifTrue:[^ aLargeFloat].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   574
        aLargeFloat sign == self sign ifTrue:[^ aLargeFloat].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   575
        ^ NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   576
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   577
    mantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   578
        exponent = 0 ifTrue:[^ aLargeFloat].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   579
        "/ INF or NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   580
        self isNaN ifTrue:[^ NaN].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   581
        ^ self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   582
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   583
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   584
    otherExponent = exponent ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   585
        m := otherMantissa + mantissa. 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
        e := exponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
    ] ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   588
        otherExponent> exponent ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
            m := (otherMantissa bitShift:(otherExponent-exponent)) + mantissa.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   590
            e := exponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   591
        ] ifFalse:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
            m := otherMantissa + (mantissa bitShift:(exponent-otherExponent)).
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
            e := otherExponent
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
        ]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   595
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   596
    ^ self class
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   597
        mantissa:m 
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   598
        exponent:e
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   599
        precision:(self precision min:aLargeFloat precision)
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   600
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   601
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   602
!LargeFloat methodsFor:'printing'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   603
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   604
printOn:aStream
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   605
    exponent == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   606
        mantissa printOn:aStream.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   607
        aStream nextPutAll:'.0'.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   608
        ^ self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   609
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   610
    mantissa == 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   611
        self == NaN ifTrue:[ aStream nextPutAll:'NAN'. ^ self ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   612
        self == NegativeInfinity ifTrue:[ aStream nextPutAll:'-INF'. ^ self].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
        self == PositiveInfinity ifTrue:[ aStream nextPutAll:'INF'. ^ self].
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   614
        self error:'invalid largeFloat' mayProceed:true.
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   615
        aStream nextPutAll:'Invalid'. ^ self.
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   616
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   618
    exponent > 0 ifTrue:[
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   619
self halt.
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   620
        (mantissa bitShift:exponent) printOn:aStream.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
        aStream nextPutAll:'.0'.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
        ^ self
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   624
    ((mantissa / (1 bitShift:exponent negated)) asFixedPoint:6) printOn:aStream.
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   625
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   626
    "
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   627
    
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   628
    "
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   629
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   630
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   631
!LargeFloat methodsFor:'private'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   632
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   633
mantissa:mantissaArg exponent:exponentArg  
7546
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   634
    "set instance variables.
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   635
     Notice, that the floats value is m * 2^e"
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   636
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   637
    exponent := exponentArg.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   638
    mantissa := mantissaArg.
7550
1c2970e4f2ea still not perfect
Claus Gittinger <cg@exept.de>
parents: 7547
diff changeset
   639
    precision := Infinity positive.
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
    self normalize.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   641
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   642
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
mantissa:mantissaArg exponent:exponentArg precision:precisionArg  
7546
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   644
    "set instance variables.
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   645
     Notice, that the floats value is m * 2^e"
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   646
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   647
    exponent := exponentArg.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   648
    mantissa := mantissaArg.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   649
    precision := precisionArg.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   650
    self normalize
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   651
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   652
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   653
normalize
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   654
    "adjust m & e such that m is the smallest possible 
7546
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   655
     (i.e. has no least significant zero bit).
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   656
     Notice, that the floats value is m * 2^e"
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   657
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   658
    |shift|
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   659
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   660
    shift := mantissa lowBit - 1.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   661
    shift > 0 ifTrue:[
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   662
        mantissa := mantissa bitShift:shift negated.
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   663
        exponent := exponent + shift
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   664
    ].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   665
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   666
    "
7546
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   667
     self mantissa:1 exponent:0
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   668
     self mantissa:2 exponent:0
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   669
     self mantissa:4 exponent:0  
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   670
     self mantissa:8 exponent:0  
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   671
     self mantissa:10 exponent:-1
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   672
     self mantissa:10 exponent:0 
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   673
     self mantissa:10 exponent:1 
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   674
    "
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   675
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
!LargeFloat methodsFor:'testing'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   678
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   679
isFinite
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   680
    ^ mantissa ~= 0 or:[exponent = 0]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   681
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   682
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   683
isInfinite
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   684
    ^ mantissa = 0 and:[exponent ~= 0]
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   685
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   686
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   687
isNaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   688
    ^ self == NaN
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   689
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   690
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   691
isZero
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   692
    ^ self == Zero
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   693
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   695
negative
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   696
    "return true if the receiver is negative"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   697
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
    mantissa == 0 ifTrue:[ ^ exponent negative].
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
    ^ mantissa negative
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   702
sign
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
    "return the sign of the receiver"
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
7546
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   705
    mantissa == 0 ifTrue:[ 
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   706
        "special value for infinites"
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   707
        ^ exponent sign
af752ee13420 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7459
diff changeset
   708
    ].
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
    ^ mantissa sign
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
!LargeFloat class methodsFor:'documentation'!
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
version
7552
4e9947615379 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7550
diff changeset
   715
    ^ '$Header: /cvs/stx/stx/libbasic/LargeFloat.st,v 1.6 2003-08-13 13:11:26 cg Exp $'
7445
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
! !
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
be414e075c9a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
LargeFloat initialize!