IEEEFloat.st
author Claus Gittinger <cg@exept.de>
Sun, 24 Nov 2019 16:20:48 +0100
changeset 5278 f83cbbc43aad
child 5324 0867b8fdd273
permissions -rw-r--r--
initial checkin
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5278
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:libbasic2' }"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ NameSpace: Smalltalk }"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
LimitedPrecisionReal variableByteSubclass:#IEEEFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:'exponentSize'
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	category:'Magnitude-Numbers'
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
!IEEEFloat class methodsFor:'documentation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
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
    Unfinished, ongoing work
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
    soft float emulation for arbitrary IEEE float formats.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
    This is very very slow and should only be used when importing 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
    funny sized floating point numbers (such as float24 or float8) from
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
    external sources, or to simulate computations on otherwise unsupported floating pnt numbers.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
"
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
!IEEEFloat class methodsFor:'instance creation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
size:numBits exponentSize:exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
    ^ (self basicNew:(numBits // 8)) exponentSize:exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
     self size:256 exponentSize:19
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
size:numBits exponentSize:exponentSize fromFloat:aFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) setValueFromFloat:aFloat
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
     self size:256 exponentSize:19 fromFloat:1.0
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
     self size:256 exponentSize:19 fromFloat:2.0
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
size:numBits exponentSize:exponentSize fromInteger:anInteger
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    ^ ((self basicNew:(numBits // 8)) exponentSize:exponentSize) setValueFromInteger:anInteger
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
     self size:256 exponentSize:19 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
     self size:256 exponentSize:19 fromInteger:2
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
!IEEEFloat class methodsFor:'queries'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
isAbstract
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
    "Return if this class is an abstract class.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
     True is returned here for myself only; false for subclasses.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
     Abstract subclasses must redefine this again."
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
    ^ self == IEEEFloat.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
!IEEEFloat methodsFor:'accessing'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
exponentSize
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    ^ exponentSize
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
exponentSize:something
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
    exponentSize := something.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
setValueFromInteger:intValue
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
    "/ how many bits are there, in this int
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
    |absValue myNumBits numBitsInNumber shift|
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
    absValue := intValue abs. 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
    numBitsInNumber := absValue highBit.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
    myNumBits := (self basicSize * 8) - 1 "sign" - exponentSize.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
    shift := myNumBits - numBitsInNumber. 
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
    numBitsInNumber > myNumBits ifTrue:[
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
        self halt.
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
    ] ifFalse:[
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
        "/ number:
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
        "/    1xxxxxxx...xxxxx
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
        "/ myRep:
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
        "/    seee...eeexxxxxxxxxx
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
        absValue digitLength to:1 by:-1 do:[:byteIndex |
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
            
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
        ].
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
    ].
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
    "/ cut off some bits
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
    "Float numBitsInExponent
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
     self size:16 exponentSize:4 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
     self size:32 exponentSize:11 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
     self size:256 exponentSize:19 fromInteger:1
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
     self size:256 exponentSize:19 fromInteger:2
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
    "
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
!IEEEFloat class methodsFor:'documentation'!
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
version_CVS
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    ^ '$Header$'
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
! !
f83cbbc43aad initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109