!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: smalldouble.gs,v 1.21 2008-01-09 22:50:18 stever Exp $
!  File: smalldouble.gs
!
! Superclass Hierarchy:
!   SmallDouble, BinaryFloat, Number, Magnitude, Object.
!
!=========================================================================

! SmallDouble class is created in bom.c

! Most primitives are shared with class Float ; the shared primitives
!  will handle receiver that are either a Float or a SmallDouble .

removeallmethods SmallDouble
removeallclassmethods SmallDouble
set class SmallDouble

! fixed 33609
category: 'For Documentation Installation only'
classmethod:
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This class represents 8-byte binary floating point numbers, as defined in IEEE
 standard 754, but with a reduced exponent.  
 SmallDouble has 8 bits of exponent, compared to 11 bits of exponent in
 an IEEE-754 8-byte float.

 You may not create subclasses of SmallDouble.

 Each SmallDouble contains a 61 bit value.  The floats are stored on Disk and
 in object memory in big-endian IEEE format.  GemStone Smalltalk primitives and
 GemBuilder for C (GCI) float conversion functions automatically convert 
 the format of a float to or from the machine''s native format, as required.

 In big-endian layout,
  An IEEE 64 bit binary float (a C double) has
   seeeeeee|eeeeffff|ffffffff|ffffffff|ffffffff|ffffffff|ffffffff|ffffffff
   If (e > 0) the double has value (-1 * s) * 2^^(e-0x3ff) * 1.f  .
   If (e == 0) and f != 0 ,
     the double has value (-1 * s) * 2^^(e-0x3fe) * 0.f  (i.e. subnormal) .
   zero is represented as s==0, e==0, f==0  . See Sparc V9 Arch Manual pg 28.

  An instance of SmallDouble has this OopType format:
   eeeeeeee|ffffffff|ffffffff|ffffffff|ffffffff|ffffffff|ffffffff|ffffs110
   which is the same number of bits of mantissa as a C double, but
    only 8 bits of exponent as compared to 11 bits of exponent in C double.
  If the C double has value zero , the SmallDouble has all bits zero,
   otherwise the SmallDouble has non-zero exponent, and
     the value is (-1 * s) * 2^^(e - 0x7f ) * 1.f
  There are no subnormal or NaN SmallDoubles .
  Thus SmallDoubles can represent  C double that have value zero
  or that have exponent bits in range 0x381 to 0x3ff,
   which correspends to about 5.0e-39 to 6.0e+38 , which
   is also the range of  C 4-byte float  .
 '.
doc documentClassWith: txt.

self description: doc.
%

! edited comments to fix 37047
category: 'Instance Creation'
classmethod:
new

"Returns a Float equal to PlusSignalingNaN."

<primitive: 139>
^ self _primitiveFailed: #new
%

category: 'Instance Creation'
classmethod:
fromString: aString

"Returns an instance of SmallDouble or Float, constructed from aString.  The String
 must contain only Characters representing the object to be created, although
 leading and trailing blanks are permitted.

 If the string represents an exceptional float, it must contain one of the
 following strings, with leading and trailing blanks permitted:
    'PlusInfinity', 'MinusInfinity', 'PlusQuietNaN',
    'MinusQuietNaN', 'PlusSignalingNaN', or 'MinusSignalingNaN'.

 If the string does not conform to the above rules, an error may be generated,
 or a signaling NaN may be returned.

 If the string is larger than 8191 bytes, an error is generated."

<primitive: 120>
aString _validateClass: String .
^ self _primitiveFailed: #fromString:
%
category: 'Instance Creation'
classmethod:
fromStringLocaleC: aString

"Same as fromString:  except that decimal point in aString must use  $.  "

^ self _mathPrim: aString opcode:3 
%

category: 'Accessing'
method:
denominator

"Returns the denominator of a Fraction representing the receiver."

   "If an infinite or quiet NaN, returns self"
| kind |
kind := self _getKind .
(kind >= 3) ifTrue:[ "exceptional"
  (kind == 3 "infinity") | (kind == 5 "quiet NaN") ifTrue: [ ^self ].

   "If a signaling NaN, raise a floating point exception & returns self"
  (kind == 6 "signaling NaN") ifTrue:[
      SmallDouble _raiseInvalidOperationException.
      ^self _makeQuietNaN
  ].
].
^ (self asFraction) denominator
%

category: 'Accessing'
method:
_getKind

"Returns an integer, 1...6, for the kind of the receiver."

<primitive: 110>

^ self _primitiveFailed: #_getKind
%

category: 'Accessing'
method:
numerator

"Returns the numerator of a Fraction representing the receiver."

   "If an infinite or quiet NaN, returns self"
| kind |
kind := self _getKind .

kind >= 3 ifTrue:[ "exceptional"
  (kind == 3 "infinity") | (kind == 5 "quiet NaN") ifTrue: [ ^self ].

   "If a signaling NaN, raise a floating point exception & returns self"
  (kind == 6 "signaling NaN") ifTrue: [
      SmallDouble _raiseInvalidOperationException.
      ^self _makeQuietNaN
   ].
].
^ (self asFraction) numerator
%

category: 'Accessing'
method:
sign

"Returns 1 if the receiver is greater than zero, -1 if the receiver is
 less than zero, and zero if the receiver is zero."

<primitive: 130>
^ self _primitiveFailed: #sign
%

category: 'Formatting'
method:
asString

"Returns a String corresponding to the value of the receiver.  Where applicable,
 returns one of the following Strings: 'PlusInfinity', 'MinusInfinity',
 'PlusQuietNaN', 'MinusQuietNaN', 'PlusSignalingNaN', or 'MinusSignalingNaN'."

<primitive: 131>
^ self _primitiveFailed: #asString
%

category: 'Formatting'
method:
asStringLocaleC

"Result is same as for asString, except that decimal point is always
 using  $.   For use in passivation/activation "

^ self _mathPrim: 13
%

category: 'Formatting'
method:
asStringUsingFormat: anArray

"Returns a String corresponding to the receiver, using the format specified by
 anArray.  The Array contains three elements: two Integers and a Boolean.
 Generates an error if any element of the Array is missing or is of the wrong
 class.

 The first element of the Array (an Integer between -1000 and 1000)
 specifies a minimum number of Characters in the result String (that is,
 the 'width' of the string).  If this element is positive, the resulting
 String is padded with blanks to the right of the receiver.  If this element
 is negative, the blanks are added to the left of the receiver.  If the
 value of this element is not large enough to completely represent the SmallDouble,
 a longer String will be generated.

 The second element of the Array (a positive Integer less than 1000)
 specifies the maximum number of digits to display to the right of the
 decimal point.  If the value of this element exceeds the number of digits
 required to completely specify the SmallDouble, only the required number of digits
 are actually displayed.  If the value of this element is insufficient to
 completely specify the SmallDouble, the value of the SmallDouble is rounded up or
 down before it is displayed.

 The third element of the Array (a Boolean) indicates whether or not to display
 the magnitude using exponential notation.  (The value true indicates
 exponential notation and false indicates decimal notation.)

 For example, the number 12.3456 displayed with two different format Arrays
 would appear as follows:

 Format          Output
 #(10 5 true)    ' 1.23456E1'
 #(10 2 false)   '12.34'"

^ self _mathPrim: anArray opcode: 1
%

category: 'Converting'
method:
asFloat    

"Returns the receiver."

^ self
%

category: 'Private'
method:
_asFloat    

"Returns an instance of Float equal to the receiver. This method
 is for use in testing the image and it is a performance and space
 degradation to use this in applications."

^ self _mathPrim: 10
%

! fix 34045
category: 'Private'
method: 
_sign

"Returns 1 if the receiver is greater than zero, -1 if the receiver is
 less than zero, 1 if the receiver is 0.0 and -1 if the receiver is -0.0 ."
 
^ self _mathPrim: 11
% 


! fix 34045
category: 'Converting'
method:
asDecimalFloat

"Returns a DecimalFloat representing the receiver."

 | kind aString |

 kind := self _getKind .
 kind > 2 ifTrue:[
   kind == 4 ifTrue:[ 
     self == -0.0 ifTrue:[ ^ -0.0f0 ]
                   ifFalse:[ ^ 0.0f0 ] .
     ].
   kind == 3 ifTrue:[
     self sign < 0 ifTrue:[ ^ DecimalMinusInfinity ]
                  ifFalse:[ ^ DecimalPlusInfinity ].
     ].
   kind == 5 ifTrue:[
     self sign < 0 ifTrue:[ ^ DecimalMinusQuietNaN ]
                  ifFalse:[ ^ DecimalPlusQuietNaN ].
     ].
   self sign < 0 ifTrue:[ ^ DecimalMinusSignalingNaN ]
                 ifFalse:[ ^ DecimalPlusSignalingNaN ].
   ].

 aString := self asString .
 ^ DecimalFloat fromString: aString .

%

category: 'Converting'
method:
asSmallFloat

"Returns the receiver.  SmallFloat is a deprecated class and
 SmallDouble is a more compact representation with greater range
 and precision than SmallFloat, so most operations that used to
 return a SmallFloat should now return a SmallDouble."

^ self
%

! asFraction inherited from BinaryFloat

category: 'Converting'
method:
_coerce: aNumber

"Returns an instance of SmallDouble with the same value as 'aNumber'."

"This method must be defined by all subclasses of Number."

^ aNumber asFloat
%

category: 'Converting'
method:
_generality

"Returns the integer that represents the ordering of the receiver in the
 generality hierarchy."

"Reimplemented from Number"

^ 85
%

category: 'Converting'
method:
_makeQuietNaN

"This method returns a quiet NaN with the same sign as the input NaN.  If the
 input is not a NaN, this method returns the receiver."

   "Is the receiver a NaN?"
| kind |
kind := self _getKind .
(kind == 6 "quiet NaN") | (kind == 5 "signaling NaN")
  ifFalse: [ ^self ]
  ifTrue: [ (self sign < 0)
                ifFalse: [ ^PlusQuietNaN ]
                ifTrue: [ ^MinusQuietNaN ] ]
%

category: 'Comparing'
method:
< aNumber

"Returns true if the receiver is less than aNumber; returns false otherwise."

<primitive: 118>
aNumber _validateClass: Number.
^ self < aNumber asFloat
%

category: 'Comparing'
method:
<= aNumber

"Returns true if the receiver is less than aNumber; returns false otherwise."

<primitive: 121>
aNumber _validateClass: Number.
^ self <= aNumber asFloat
%

category: 'Comparing'
method:
= aNumber

"Returns true if the receiver is equal to aNumber; returns false otherwise."

<primitive: 119>
(aNumber isKindOf: Number)
   ifTrue: [^ self = aNumber asFloat].
^ false
%

category: 'Comparing'
method:
~= aNumber

"Returns true if the receiver is not equal to aNumber; returns false
 otherwise."

<primitive: 177>
(aNumber isKindOf: Number)
   ifTrue: [^ self ~= aNumber asFloat].
^ true
%

category: 'Comparing'
method:
hash

"Returns a numerical hash code for the receiver."

"Two Numbers for which = is true, must have the same hash value."

^ self _mathPrim: 8
%

! >= inherited from Magnitude
! > inherited from Magnitude
! ~= inherited from Magnitude


category: 'Truncation and Rounding'
method:
ceiling

"Returns the integer that is closest to the receiver, on the same side
 of the receiver as positive infinity.
 If receiver is a signaling NaN, raise a floating point exception"

<primitive: 658>
| kind |
kind := self _getKind .
kind >= 5 ifTrue:[
  (kind == 6 "signaling NaN") ifTrue: [ SmallDouble _raiseInvalidOperationException ].
  "If a NaN, returns correct sign of self"
  ^self _makeQuietNaN 
].
^ self _primitiveFailed: #ceiling
%

category: 'Truncation and Rounding'
method:
floor

"Returns the integer that is closest to the receiver, on the same side
 of the receiver as negative infinity."

<primitive: 657>
| kind |
kind := self _getKind .
kind >= 5 ifTrue:[
  (kind == 6 "signaling NaN" ) ifTrue: [ SmallDouble _raiseInvalidOperationException ].
  "If a NaN, returns correct sign of self"
  ^self _makeQuietNaN
].
^ self _primitiveFailed: #floor
%

category: 'Truncation and Rounding'
method:
integerPart

"Returns an integer representing the receiver truncated toward zero."

^ self truncated
%

category: 'Truncation and Rounding'
method:
rounded

"Returns the integer nearest in value to the receiver.
 If a signaling NaN, raise a floating point exception"

<primitive: 656>
| kind |
kind := self _getKind .
kind >= 5 ifTrue:[
  (kind == 6 "signaling NaN" ) ifTrue: [ SmallDouble _raiseInvalidOperationException ].
  "If a NaN, returns correct sign of self"
  ^self _makeQuietNaN
].
^ self _primitiveFailed: #rounded
%

category: 'Truncation and Rounding'
method:
roundTo: aNumber

"Returns the multiple of aNumber that is nearest in value to the receiver.
 If a signaling NaN, raise a floating point exception"

<primitive: 659>
| kind |
kind := self _getKind .
kind >= 5 ifTrue:[
  (kind == 6 "signaling NaN") ifTrue: [ SmallDouble _raiseInvalidOperationException ].
  ^self _makeQuietNaN 
].
aNumber = 0 ifTrue:[
  "should have been handled in primitive"
  self _primitiveFailed: #roundTo: 
].
"Handle infinity receivers and exceptional args here"
^ (self / aNumber) rounded * aNumber
%


category: 'Truncation and Rounding'
method:
truncated

"Returns the integer that is closest to the receiver, on the same side
 of the receiver as zero is located.

 If the receiver is an exceptional float (NaN or Infinity) , returns
 the receiver.
"

<primitive: 109>

^ self _primitiveFailed: #truncated
%

category: 'Truncation and Rounding'
method:
truncateTo: aNumber

"Returns the multiple of aNumber that is closest to the receiver, on the
 same side of the receiver as zero is located.  In particular, returns
 the receiver if the receiver is a multiple of aNumber.
 If a signaling NaN, raise a floating point exception"
<primitive: 660>
| kind |
kind := self _getKind .
kind >= 5 ifTrue:[
  (kind == 6 "signaling NaN") ifTrue: [ SmallDouble _raiseInvalidOperationException ].
  ^self _makeQuietNaN
].
aNumber = 0 ifTrue:[
  "should have been handled in primitive"
  self _primitiveFailed: #truncateTo:
].
"Handle infinity receivers and exceptional args here"
 ^ (self quo: aNumber) * aNumber
%

category: 'Arithmetic'
method:
* aNumber

"Multiply the receiver by aNumber and returns the result."

<primitive: 102>
aNumber _validateClass: Number.
^ self * aNumber asFloat
%

category: 'Arithmetic'
method:
+ aNumber

"Returns the sum of the receiver and aNumber."

<primitive: 106>
aNumber _validateClass: Number.
^ self + aNumber asFloat
%

category: 'Arithmetic'
method:
- aNumber

"Returns the difference between the receiver and aNumber."

<primitive: 107>
aNumber _validateClass: Number.
^ self - aNumber asFloat
%

category: 'Arithmetic'
method:
/ aNumber

"Divide the receiver by aNumber and returns the result."

<primitive: 108>
aNumber _validateClass: Number.
^ self / aNumber asFloat
%

category: 'Arithmetic'
method:
sqrt

"Returns the square root of the receiver."
"Reimplemented from Number"

<primitive: 104>
^ self _primitiveFailed: #sqrt
%

category: 'Private'
method:
_mathPrim: opcode

"Trigonometric and other primitive functions:

 opcode   function
    0     exp
    1     cos
    2     sin
    3     tan
    4     arcTan	
    5     arcSin
    6     arcCos
    7     ln
    8     hash
    9     log  base 10
   10     _asFloat 
   11     _sign 
   12     _asFraction 
   13     asStringLocaleC"

<primitive: 136>
^ self _primitiveFailed: #_mathPrim:
%

category: 'Private'
method:
_mathPrim: anArg opcode: opcode

"Mathematics primitive:

 opcode   function
    0     self raisedTo: anArg
    1     asStringUsingFormat: anArg
            argument must be a format descriptor Array
    2     raisedToInteger: anArg"

<primitive: 179>
opcode == 0 ifTrue:[ anArg _validateClass: SmallDouble ] .
opcode == 1 ifTrue:[
  anArg _validateClass: Array .
  anArg size == 3 ifFalse:[ anArg _error: #rtErrArgOutOfRange ] .
  (anArg at:1 ) _validateClass: SmallInteger .
  (anArg at:2 ) _validateClass: SmallInteger .
  (anArg at:3 ) _validateClass: Boolean .
  ((anArg at:1) < -1000) | ((anArg at:1) > 1000)
      ifTrue:[ anArg _error: #rtErrArgOutOfRange] .
  ((anArg at:2) < 0) | ((anArg at:2) > 1000)
      ifTrue:[ anArg _error: #rtErrArgOutOfRange] .
  ] .
opcode == 2 ifTrue:[ anArg _validateClass: Integer ].
^ self _primitiveFailed: #_mathPrim:opcode:
%

category: 'Private'
classmethod:
_mathPrim: anArg opcode: opcode

"Mathematics primitive:
 opcode   function
    3     fromStringLocaleC: aString"
<primitive: 179>
opcode == 3 ifTrue:[ anArg _validateClass: String ].
^ self _primitiveFailed: #_mathPrim:opcode:
%


category: 'Arithmetic'
method:
exp

"Returns e raised to the power of the receiver."

^ self _mathPrim: 0
%

category: 'Arithmetic'
method:
ln

"Returns the natural logarithm of the receiver."

^ self _mathPrim: 7
%

category: 'Arithmetic'
method:
log10

"Returns the base 10 logarithm of the receiver."

^ self _mathPrim: 9
%

category: 'Arithmetic'
method:
arcCos

"Returns the arc-cosine of the receiver in radians."

^ self _mathPrim: 6
%

category: 'Arithmetic'
method:
arcSin

"Returns the arc-sine of the receiver in radians."

^ self _mathPrim: 5
%

category: 'Arithmetic'
method:
arcTan

"Returns the arc-tangent of the receiver in radians."

^ self _mathPrim: 4
%

category: 'Arithmetic'
method:
cos

"Returns the cosine of the receiver which is treated as an
 angle expressed in radians."

^ self _mathPrim: 1
%

category: 'Arithmetic'
method:
sin

"Returns the sine of the receiver which is treated as an
 angle expressed in radians."

^ self _mathPrim: 2
%

category: 'Arithmetic'
method:
tan

"Returns the tangent of the receiver which is treated as an
 angle expressed in radians."

^ self _mathPrim: 3
%

category: 'Arithmetic'
method:
raisedTo: aNumber

"Returns the receiver raised to the power of the argument."

^ self _mathPrim: aNumber asFloat opcode: 0
%

category: 'Arithmetic'
method:
raisedToInteger: aNumber

"Returns the receiver raised to the power of the argument."

^ self _mathPrim: aNumber opcode: 2
%

category: 'Indexing Support'
method:
_isNaN

"Returns whether the receiver is quiet NaN or signaling NaN.
 This method is only to be used by the indexing subsystem."

^ self _getKind > 4
%

category: 'Storing and Loading'
classmethod:
loadFrom: passiveObj

"Reads from passiveObj the passive form of an object.  Converts the object to
 its active form by loading the information into a new instance of the receiver.
 Returns the new instance."

| inst |

inst := self fromStringLocaleC:  passiveObj upToSeparator .
"no hasRead: here, since SmallDouble is a special"
^inst
%

! BinaryFloat>>writeTo: inherited by SmallDouble

category: 'Storing and Loading'
method:
containsIdentity

"Private."

^true
%
category: 'Testing'
method:
isSpecial

"Returns true if the receiver is a special object."

^ true
%

! put SmallDouble in classHistory of Float for compatibility with
!   previous applications
!
! Fix 35521: only add it if it's not already there!
!
expectvalue 2
run
(Float classHistory includesIdentical: SmallDouble)
  ifFalse:[Float classHistory add: SmallDouble .] .
^Float classHistory size
%

