[strongtalk] r184 committed - LargeInteger ST source changes

[codesite...@google.com]

Revision: 184
Author: StephenLRees
Date: Sun Dec 6 13:13:29 2009
Log: LargeInteger ST source changes
http://code.google.com/p/strongtalk/source/detail?r=184

Modified:
/branches/gcc-linux/StrongtalkSource/Integer.dlt
/branches/gcc-linux/StrongtalkSource/LargeInteger.dlt
/branches/gcc-linux/StrongtalkSource/LargeIntegerTest.dlt
/branches/gcc-linux/StrongtalkSource/Number.dlt
/branches/gcc-linux/StrongtalkSource/SmallInteger.dlt

=======================================
--- /branches/gcc-linux/StrongtalkSource/Integer.dlt Sun Jun 7 15:02:00
2009
+++ /branches/gcc-linux/StrongtalkSource/Integer.dlt Sun Dec 6 13:13:29
2009
@@ -106,7 +106,7 @@
bitAnd: o <X> ^<Self|X>
{where X <Integer> is arg 1}

- self unimplemented!
+ ^o bitAndFromInteger: self!

bitAt: index <Int> ^<Int>
"Return the bit at the specified bit index, with the low bit being index
1"
@@ -120,7 +120,7 @@
bitOr: o <X> ^<Self|X>
{where X <Integer> is arg 1}

- self unimplemented!
+ ^o bitOrFromInteger: self!

bitShift: shift <Int> ^<Int>

@@ -129,7 +129,7 @@
bitXor: o <X> ^<Self|X>
{where X <Integer> is arg 1}

- self unimplemented!
+ ^o bitXorFromInteger: self!

highBit ^<SmallInt>

@@ -334,6 +334,10 @@
lower := oldHigher \\ lower. ].
^higher!

+rem: a <Number> ^<X>
+ {where X <Number> is returnType of #remFromInteger: message of arg 1}
+ ^guaranteed <X> (a remFromInteger: self)!
+
truncated ^<Int>

^self! !
@@ -414,6 +418,14 @@
"%generated code- do not modify"
^self addFromInteger: o!

+bitAndFromInteger: arg <Integer>
+
+ self unimplemented!
+
+bitOrFromInteger: arg <Integer>
+
+ self unimplemented!
+
equalFromInteger: o <Integer> ^<Boolean>

^o = self asLargeInteger!
@@ -448,6 +460,10 @@
"%generated code- do not modify"
^self multiplyFromInteger: o!

+remFromInteger: o <Integer> ^<Integer>
+
+ self unimplemented!
+
subtractFromInteger: o <Integer> ^<Integer>

^o - self asLargeInteger!
=======================================
--- /branches/gcc-linux/StrongtalkSource/LargeInteger.dlt Sat Nov 1
12:10:49 2008
+++ /branches/gcc-linux/StrongtalkSource/LargeInteger.dlt Sun Dec 6
13:13:29 2009
@@ -63,6 +63,48 @@
[ 20 factorial = (Integer readFrom: '2432902008176640000' readStream) ]
verify.
! !

+! (Delta mirrorFor: #LargeInteger) methodsFor: 'bit operations' !
+
+
+<< bits <Int> ^ <Int>
+
+ bits < 0 ifTrue: [self error: 'shift right should not be negative'].
+ ^self bitShift: bits!
+
+>> bits <Int> ^ <Int>
+
+ bits < 0 ifTrue: [self error: 'shift left should not be negative'].
+ ^self bitShift: bits negated!
+
+bitAnd: arg <Number> ^ <Int>
+
+ ^{{self primitiveIndexedByteLargeIntegerAnd: arg
+ ifFail: [:err|
+ #FirstArgumentHasWrongType == err
+ ifTrue: [super bitAnd: arg]
+ ifFalse: [self error: err]]}}!
+
+bitOr: arg <Number> ^ <Int>
+
+ ^{{self primitiveIndexedByteLargeIntegerOr: arg
+ ifFail: [:err|
+ #FirstArgumentHasWrongType == err
+ ifTrue: [super bitOr: arg]
+ ifFalse: [self error: err]]}}!
+
+bitShift: bits <Int> ^ <Int>
+
+ ^{{self primitiveIndexedByteLargeIntegerShift: bits
+ ifFail: [:err | self error: err]}}!
+
+bitXor: arg <Number> ^ <Int>
+
+ ^{{self primitiveIndexedByteLargeIntegerXor: arg
+ ifFail: [:err|
+ #FirstArgumentHasWrongType == err
+ ifTrue: [super bitXor: arg]
+ ifFalse: [self error: err]]}}! !
+
! (Delta mirrorFor: #LargeInteger) methodsFor: 'converting' !


@@ -82,7 +124,12 @@
ifTrue: [ super // arg ]
ifFalse: [ self error: 'LargeInteger //: ', err ]
]
- }}! !
+ }}!
+
+rem: arg <Number> ^ <Number>
+
+ ^{{self primitiveIndexedByteLargeIntegerRem: arg asLargeInteger
+ ifFail: [ :err <Symbol> | self nonPrimitiveRem: arg error: err ]}}! !

! (Delta mirrorFor: #LargeInteger) methodsFor: 'printing' !

@@ -117,7 +164,21 @@
ifFalse: [ result < 0
ifTrue: [ -1 ]
ifFalse: [ 0 ]
- ]! !
+ ]!
+
+nonPrimitiveDiv: a <Number> error: err <Symbol> ^<Int>
+ "This is invoked on primitive failure"
+
+ ^err == #FirstArgumentHasWrongType
+ ifTrue: [ super // a ]
+ ifFalse: [ self error: 'LargeInteger //: ', err ]!
+
+nonPrimitiveRem: a <Number> error: err <Symbol> ^<Int>
+ "This is invoked on primitive failure"
+
+ ^err == #FirstArgumentHasWrongType
+ ifTrue: [ super rem: a ]
+ ifFalse: [ self error: 'LargeInteger rem: ', err ]! !

! (Delta mirrorFor: #LargeInteger) methodsFor: 'restricted-double
dispatching' !

@@ -147,6 +208,12 @@
}}.
!

+remFromInteger: o <Integer> ^<Integer>
+
+ ^{{self primitiveIndexedByteLargeIntegerRem: o asLargeInteger
+ ifFail: [ :err <Symbol> | self error: err ]
+ }}!
+
subtractFromInteger: o <Integer> ^<Integer>

^o asLargeInteger subtractLargeInteger: self! !
=======================================
--- /branches/gcc-linux/StrongtalkSource/LargeIntegerTest.dlt Sun Sep 13
14:52:44 2009
+++ /branches/gcc-linux/StrongtalkSource/LargeIntegerTest.dlt Sun Dec 6
13:13:29 2009
@@ -12,6 +12,136 @@
! (Delta mirrorFor: #LargeIntegerTest) methodsFor: 'testing' !


+testBitAnd
+
+ self assert: (1 asLargeInteger bitAnd: 1 asLargeInteger) = 1!
+
+testBitAndComplex
+
+ self assert: (16rFFFFFFFF bitAnd: 16rF0F0F0F0) = 16rF0F0F0F0!
+
+testBitAndWithDouble
+
+ self assert: (16rFFFFFFFF bitAnd: 1.0) = 1!
+
+testBitAndWithSmallInteger
+
+ self assert: (16rFFFFFFFF bitAnd: 1) = 1!
+
+testBitOr
+
+ self assert: (1 asLargeInteger bitOr: -1 asLargeInteger) = -1!
+
+testBitOrWithDouble
+
+ self assert: (16rFFFFFFFE bitOr: 1.0) = 16rFFFFFFFF!
+
+testBitOrWithSmallInteger
+
+ self assert: (16rFFFFFFFE bitOr: 1) = 16rFFFFFFFF!
+
+testBitShiftWithPositiveShift
+
+ self assert: (2 asLargeInteger bitShift: 1) = 4!
+
+testBitXor
+
+ self assert: (1 asLargeInteger bitXor: -1 asLargeInteger) = -2!
+
+testBitXorWithDouble
+
+ self assert: (16rFFFFFFFF bitXor: 1.0) = 16rFFFFFFFE!
+
+testBitXorWithSmallInteger
+
+ self assert: (16rFFFFFFFE bitXor: 16rF) = 16rFFFFFFF1!
+
+testDivision
+
+ self assert: 16r100000000 // 16r10000 = 16r10000!
+
+testDivisionWithLargeNegativeDividend
+
+ self assert: -16r100000001 // 16r100000000 = -16r2!
+
+testDivisionWithLargeNegativeDivisor
+
+ self assert: 16r111111111 // -16r111111110 = -16r2!
+
+testDivisionWithNegativeDividend
+
+ self assert: -16r100000001 // 16r10000 = -16r10001!
+
+testDivisionWithNegativeDivisor
+
+ self assert: 16r100000001 // -16r10000 = -16r10001!
+
+testDivisionWithRounding
+
+ self assert: 16r100000001 // 16r10000 = 16r10000!
+
+testIntegerDivisionNegativeDenominator
+
+ self assert: (1 negated asLargeInteger isKindOf: LargeInteger).
+ self assert: 1 asLargeInteger // 2 negated asLargeInteger = -1.
+ self assert: 3 asLargeInteger // 2 negated asLargeInteger = -2!
+
+testIntegerDivisionNegativeNumerator
+
+ self assert: (1 negated asLargeInteger isKindOf: LargeInteger).
+ self assert: 1 negated asLargeInteger // 2 asLargeInteger = -1.
+ self assert: 3 negated asLargeInteger // 2 asLargeInteger = -2!
+
+testIntegerDivisionNegativeNumeratorAndDenominator
+
+ self assert: (1 negated asLargeInteger isKindOf: LargeInteger).
+ self assert: 1 negated asLargeInteger // 2 negated asLargeInteger = 0.
+ self assert: 3 negated asLargeInteger // 2 negated asLargeInteger = 1!
+
+testQuo
+
+ self assert: (16r100000000 quo: 16r10000) = 16r10000!
+
+testQuoWithLargeNegativeDivisor
+
+ self assert: (16r111111111 quo: -16r111111110) = -16r1!
+
+testQuoWithNegativeDividend
+
+ self assert: (-16r100000001 quo: 16r10000) = -16r10000!
+
+testQuoWithNegativeDivisor
+
+ self assert: (16r100000001 quo: -16r10000) = -16r10000!
+
+testQuoWithRounding
+
+ self assert: (16r100000001 quo: 16r10000) = 16r10000!
+
+testRemWithLargeNegativeDivisor
+
+ | result |
+ result := (16r111111111 rem: -16r111111110).
+ self assert: result = 1!
+
+testShiftLeft
+
+ self assert: 2 asLargeInteger >> 1 = 1!
+
+testShiftLeftWithError
+
+ self should: [2 asLargeInteger >> -1]
+ raise: Error!
+
+testShiftRight
+
+ self assert: 2 asLargeInteger << 1 = 4!
+
+testShiftRightWithError
+
+ self should: [2 asLargeInteger << -1]
+ raise: Error!
+
testUnderflow

self deny: SmallInteger maxVal + 1 * 8 + 1 negated = -1! !
=======================================
--- /branches/gcc-linux/StrongtalkSource/Number.dlt Sat Nov 1 12:10:49 2008
+++ /branches/gcc-linux/StrongtalkSource/Number.dlt Sun Dec 6 13:13:29 2009
@@ -368,6 +368,18 @@
"%generated code- do not modify"
^self + o asFloat!

+bitAndFromInteger: arg <Integer> ^ <Integer>
+
+ ^arg bitAnd: self asInteger!
+
+bitOrFromInteger: arg <Integer> ^ <Integer>
+
+ ^arg bitOr: self asInteger!
+
+bitXorFromInteger: arg <Integer> ^ <Integer>
+
+ ^arg bitXor: self asInteger!
+
divideFromFloat: o <Float> ^<Number>
"%generated code- do not modify"
^o / self asFloat!
=======================================
--- /branches/gcc-linux/StrongtalkSource/SmallInteger.dlt Sat Nov 1
12:10:49 2008
+++ /branches/gcc-linux/StrongtalkSource/SmallInteger.dlt Sun Dec 6
13:13:29 2009
@@ -454,6 +454,18 @@
addFromSmallInteger: o <SmallInteger> ^<Int>
self error: 'can''t happen because of double dispatching, but need for
typing'!

+bitAndFromInteger: arg <Integer> ^ <Integer>
+
+ ^arg bitAnd: self asLargeInteger!
+
+bitOrFromInteger: arg <Integer> ^ <Integer>
+
+ ^arg bitOr: self asLargeInteger!
+
+bitXorFromInteger: arg <Integer> ^ <Integer>
+
+ ^arg bitXor: self asLargeInteger!
+
equalFromSmallInteger: o <SmallInteger> ^<Boolean>
self error: 'can''t happen because of double dispatching'!