[BUG][FIX][ENH] LargeIntegers plugin

-- Stephan Rudlof (sr@evolgo.de) "Genius doesn't work on an assembly line basis. You can't simply say, 'Today I will be brilliant.'" -- Kirk, "The Ultimate Computer", stardate 4731.3 --------------0DC1F2341DD6E477001721FA Content-Type: text/plain; charset=us-ascii; name="LargeIntegersPlugin.2.cs" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="LargeIntegersPlugin.2.cs" 'From Squeak2.7alpha of 1 December 1999 [latest update: #1726] on 31 December 1999 at 8:41:05 am'! "Change Set: LargeIntegersPlugin Date: 31 December 1999 Author: Stephan Rudlof Speeds up LargeInteger arithmetics. Preconditions: RecentSlangChanges.1.cs There are TestInterpreterPlugin, CCodeGenerator, TestCodeGenerator in actual versions. File in this change set and generate the module as library according the 'Short Guide for Installing and Testing the LargeIntegers Plugin' found in the postscript. Then you will need the corresponding 'Install LI plugin.1.cs' changeset. " ! Object subclass: #LargeIntegersControl instanceVariableNames: '' classVariableNames: 'UsePlugin ' poolDictionaries: '' category: 'Squeak-TestPlugins'! TestInterpreterPlugin subclass: #LargeIntegersPlugin instanceVariableNames: 'debugFlag forceFailInCFlag ' classVariableNames: 'DebugFlag ForceFailInCFlag RunInSTFlag ' poolDictionaries: '' category: 'Squeak-TestPlugins'! Object subclass: #LargeIntegersTest instanceVariableNames: 'oc1 oc2 ocShift ocShift2 transcript ' classVariableNames: '' poolDictionaries: '' category: 'Squeak-TestPlugins'! Smalltalk renameClassNamed: #LargeIntegerTest as: #LargeIntegersControl! !LargeIntegersControl commentStamp: 'sr 12/30/1999 13:53' prior: 0! LargeIntergersControl controls if LargeIntegersPlugin will be called or not and provides the binding methods between Integer classes and the plugin.! !LargeIntegersControl methodsFor: 'logic' stamp: 'sr 12/30/1999 02:09'! callPrimDigit: aLargeInteger bitShift: shiftCount <primitive: 'primDigitBitShift' module:'LargeIntegers'> ^ LargeIntegersPlugin doPrimitive: 'primDigit:bitShift:' withArguments: {aLargeInteger. shiftCount}! ! !LargeIntegersControl methodsFor: 'logic' stamp: 'sr 12/30/1999 03:45'! digit: anInteger bitShift: shiftCount "Answer anInteger shifted." ^ self callPrimDigit: (anInteger ) bitShift: shiftCount! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 02:09'! callPrimDigitAdd: firstInteger with: secondInteger classLargeNegativeInteger: clni "" <primitive: 'primDigitAddWith' module:'LargeIntegers'> ^ LargeIntegersPlugin doPrimitive: 'primDigitAdd:with:classLargeNegativeInteger:' withArguments: {firstInteger. secondInteger. clni}! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 02:09'! callPrimDigitDiv: firstInteger with: secondInteger negative: neg classLargeNegativeInteger: clni "" "Division by zero leads to primitiveFail." <primitive: 'primDigitDivWithNegative' module:'LargeIntegers'> secondInteger = 0 ifTrue: [^ (ZeroDivide dividend: self) signal]. ^ LargeIntegersPlugin doPrimitive: 'primDigitDiv:with:negative:classLargeNegativeInteger:' withArguments: {firstInteger. secondInteger. neg. clni}! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 02:09'! callPrimDigitMultiply: firstInteger with: secondInteger negative: neg classLargeNegativeInteger: clni "" <primitive: 'primDigitMultiplyWithNegative' module:'LargeIntegers'> ^ LargeIntegersPlugin doPrimitive: 'primDigitMultiply:with:negative:classLargeNegativeInteger:' withArguments: {firstInteger. secondInteger. neg. clni}! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 02:09'! callPrimDigitSubtract: firstInteger with: secondInteger classLargeNegativeInteger: clni "" <primitive: 'primDigitSubtractWith' module:'LargeIntegers'> ^ LargeIntegersPlugin doPrimitive: 'primDigitSubtract:with:classLargeNegativeInteger:' withArguments: {firstInteger. secondInteger. clni}! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 02:09'! callPrimNormalize: anInteger "" <primitive: 'primNormalize' module:'LargeIntegers'> ^ LargeIntegersPlugin doPrimitive: 'primNormalize:' withArguments: {anInteger}! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 06:25'! integerAdd: firstInteger with: secondInteger "Answer the sum of firstInteger and secondInteger." firstInteger negative == secondInteger negative ifTrue: [^ (self callPrimDigitAdd: firstInteger with: secondInteger classLargeNegativeInteger: LargeNegativeInteger) normalize] ifFalse: [^ self callPrimDigitSubtract: firstInteger with: secondInteger classLargeNegativeInteger: LargeNegativeInteger]! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 03:46'! integerDiv: firstInteger with: secondInteger "Answer the division of firstInteger and secondInteger." "A negative secondInteger doesn't hurt, because it is converted in aLargeNegativeInteger inside the plugin." "'abs' after secondInteger arg not necessary here" | quoRem | quoRem _ self callPrimDigitDiv: (firstInteger ) with: secondInteger negative: firstInteger negative ~~ secondInteger negative classLargeNegativeInteger: LargeNegativeInteger. (quoRem at: 2) = 0 ifTrue: [^ self callPrimNormalize: (quoRem at: 1)] ifFalse: [^ (Fraction numerator: firstInteger denominator: secondInteger) reduced]! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 03:46'! integerMultiply: firstInteger with: secondInteger "Answer the multiplication of firstInteger and secondInteger." ^ self callPrimDigitMultiply: (firstInteger) with: secondInteger negative: firstInteger negative ~~ secondInteger negative classLargeNegativeInteger: LargeNegativeInteger! ! !LargeIntegersControl methodsFor: 'arithmetic' stamp: 'sr 12/30/1999 06:24'! integerSubtract: firstInteger with: secondInteger "Answer the subtraction of firstInteger and secondInteger." firstInteger negative == secondInteger negative ifTrue: [^ self callPrimDigitSubtract: firstInteger with: secondInteger classLargeNegativeInteger: LargeNegativeInteger] ifFalse: [^ (self callPrimDigitAdd: firstInteger with: secondInteger classLargeNegativeInteger: LargeNegativeInteger) normalize]! ! !LargeIntegersControl methodsFor: 'comparing' stamp: 'sr 12/30/1999 02:09'! callPrimDigitCompare: firstInteger with: secondInteger "" <primitive: 'primDigitCompareWith' module:'LargeIntegers'> ^ LargeIntegersPlugin doPrimitive: 'primDigitCompare:with:' withArguments: {firstInteger. secondInteger}! ! !LargeIntegersControl methodsFor: 'comparing' stamp: 'sr 12/30/1999 03:46'! integerCompare: firstInteger with: secondInteger "Answer the result of a comparison of firstInteger and secondInteger." ^ self callPrimDigitCompare: ( firstInteger ) with: secondInteger! ! !LargeIntegersControl class methodsFor: 'class initialize' stamp: 'sr 12/30/1999 13:50'! initialize UsePlugin _ false! ! !LargeIntegersControl class methodsFor: 'interface' stamp: 'sr 12/30/1999 02:00'! usePlugin ^ UsePlugin! ! !LargeIntegersControl class methodsFor: 'interface' stamp: 'sr 12/30/1999 02:00'! usePlugin: aBool UsePlugin _ aBool! ! Smalltalk renameClassNamed: #LargeIntegerPlugin as: #LargeIntegersPlugin! !LargeIntegersPlugin commentStamp: 'sr 12/30/1999 13:56' prior: 0! LargeIntegersPlugin provides functions for speeding up LargeInteger arithmetics. 'debug' on the class side is the interesting protocol for users.! !LargeIntegersPlugin reorganize! ('LargeInteger primitives' primDigit:bitShift: primDigitAdd:with:classLargeNegativeInteger: primDigitCompare:with: primDigitDiv:with:negative:classLargeNegativeInteger: primDigitMultiply:with:negative:classLargeNegativeInteger: primDigitSubtract:with:classLargeNegativeInteger: primNormalize:) ('control & support primitives' primAsLargeInteger:classLargeNegativeInteger: primCheckIfCModuleExists primDebug: primForceFailInC:) ('oop functions' bytes:Lshift: bytes:Rshift:bytes:lookfirst: digitAddLarge:with: digitCompareLarge:with: digitDivLarge:with:negative: digitMultiplyLarge:with:negative: digitSubLarge:with: normalize: normalizeNegative: normalizePositive:) ('oop util' bytes:growTo: bytesOrInt:growTo: createLargeFromSmallInteger: myClassLargeNegativeInteger) ('util' byteSize: digitLength: digitOf:at: unsafeByteOf:at:) ('testing' forceFail forceFailInC isBytesObject: runsInC runsInDebugMode runsInSmalltalk) ('debugging' assert: debugMsg: failIfForcedFail msg: think) ('C core' cBytesLshift:from:len:to:len: cCoreBytesRshiftCount:n:m:f:bytes:from:len:to:len: cCoreDigitDivDiv:len:rem:len:quo:len: cDigitAdd:len:with:len:into: cDigitCompare:with:len: cDigitMultiply:len:with:len:into: cDigitSub:len:with:len:into:) ('C core util' cBytesCopyFrom:to:len: cBytesHighBit:len: cBytesReplace:from:to:with:startingAt: cCopyIntVal:toBytes: cDigitLengthOfCSI: cDigitOfCSI:at: cHighBit:) ('crashing' crashPrimLargeIntegerSum:with:) ! !LargeIntegersPlugin methodsFor: 'LargeInteger primitives' stamp: 'sr 12/30/1999 03:42'! primDigit: anInteger bitShift: shiftCount | rShift anInt | self debugMsg: 'primDigit: anInteger bitShift: shiftCount'. self failIfForcedFail. self primitive: 'primDigitBitShift' parameters: #(Integer SmallInteger ) receiver: #Oop. (interpreterProxy isIntegerObject: anInteger) ifTrue: ["convert it to a not normalized LargeInteger" anInt _ self createLargeFromSmallInteger: anInteger]ifFalse:[anInt _ anInteger]. shiftCount >= 0 ifTrue: [^ self bytes: anInt Lshift: shiftCount] ifFalse: [rShift _ 0 - shiftCount. ^ self normalize: (self bytes: anInt Rshift: (rShift bitAnd: 7) bytes: (rShift bitShift: -3) lookfirst: (self byteSize: anInt))]! ]style[(11 9 11 10 5 13 3 4 11 43 3 4 20 4 14 19 15 24 13 4 4 16 18 9 13 45 4 5 3 4 30 9 31 10 4 1 14 4 8 5 9 10 18 6 3 1 3 10 7 4 13 4 13 5 15 6 9 1 15 6 11 2 19 4 11 5 3)f1b,f1cmagenta;ib,f1b,f1cmagenta;ib,f1,f1cmagenta;b,f1,f1cblue;b,f1,f1c152050000,f1,f1cblue;b,f1,f1cblue;b,f1,f1c152050000,f1,f1c152050000,f1,f1c152050000,f1,f1cblue;b,f1,f1cmagenta;b,f1,f1cred;,f1,f1cmagenta;b,f1,f1cblue;b,f1,f1cmagenta;b,f1,f1cmagenta;b,f1,f1c152050000,f1,f1cblue;b,f1,f1cmagenta;b,f1,f1cmagenta;b,f1,f1cmagenta;b,f1,f1c152050000,f1,f1cmagenta;b,f1,f1cblue;b,f1,f1cblue;b,f1,f1cmagenta;b,f1,f1cmagenta;b,f1,f1c152050000,f1,f1cmagenta;b,f1,f1c152050000,f1,f1cblue;b,f1,f1cmagenta;b,f1! ! !LargeIntegersPlugin methodsFor: 'LargeInteger primitives' stamp: 'sr 12/30/1999 03:01'! primDigitAdd: firstInteger with: secondInteger classLargeNegativeInteger: clni "" | firstInt secondInt | self debugMsg: 'primDigitAdd: firstInteger with: secondInteger'. self failIfForcedFail. self primitive: 'primDigitAddWith' parameters: #(Integer Integer Class ) receiver: #Oop. self var: #pByte declareC: 'unsigned char * pByte'. (interpreterProxy isIntegerObject: firstInteger) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: secondInteger. firstInt _ self createLargeFromSmallInteger: firstInteger. secondInt _ interpreterProxy popRemappableOop] ifFalse: [firstInt _ firstInteger. secondInt _ secondInteger]. (interpreterProxy isIntegerObject: secondInt) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: firstInt. secondInt _ self createLargeFromSmallInteger: secondInt. firstInt _ interpreterProxy popRemappableOop]. ^ self digitAddLarge: firstInt with: secondInt! ! !LargeIntegersPlugin methodsFor: 'LargeInteger primitives' stamp: 'sr 12/30/1999 03:29'! primDigitCompare: firstInteger with: secondInteger | firstVal secondVal | self debugMsg: 'primDigitCompare: firstInteger with: secondInteger'. self failIfForcedFail. self primitive: 'primDigitCompareWith' parameters: #(Integer Integer ) receiver: #Oop. "shortcut: aSmallInteger has to be smaller in Magnitude as aLargeInteger" (interpreterProxy isIntegerObject: firstInteger) ifTrue: ["first" (interpreterProxy isIntegerObject: secondInteger) ifTrue: ["second" (firstVal _ interpreterProxy integerValueOf: firstInteger) > (secondVal _ interpreterProxy integerValueOf: secondInteger) ifTrue: [^ 1 asOop: SmallInteger"first > second"] ifFalse: [firstVal < secondVal ifTrue: [^ -1 asOop: SmallInteger"first < second"] ifFalse: [^ 0 asOop: SmallInteger"first = second"]]] ifFalse: ["SECOND" ^ -1 asOop: SmallInteger"first < SECOND"]] ifFalse: ["FIRST" (interpreterProxy isIntegerObject: secondInteger) ifTrue: ["second" ^ 1 asOop: SmallInteger"FIRST > second"] ifFalse: ["SECOND" ^ self digitCompareLarge: firstInteger with: secondInteger]]! ! !LargeIntegersPlugin methodsFor: 'LargeInteger primitives' stamp: 'sr 12/30/1999 03:01'! primDigitDiv: firstInteger with: secondInteger negative: neg classLargeNegativeInteger: clni "" | firstInt secondInt | self debugMsg: 'primDigitDiv: firstInteger with: secondInteger negative: neg'. self failIfForcedFail. self primitive: 'primDigitDivWithNegative' parameters: #(Integer Integer Boolean Class ) receiver: #Oop. self var: #pByte declareC: 'unsigned char * pByte'. (interpreterProxy isIntegerObject: firstInteger) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: secondInteger. firstInt _ self createLargeFromSmallInteger: firstInteger. secondInt _ interpreterProxy popRemappableOop] ifFalse: [firstInt _ firstInteger. secondInt _ secondInteger]. (interpreterProxy isIntegerObject: secondInt) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: firstInt. secondInt _ self createLargeFromSmallInteger: secondInt. firstInt _ interpreterProxy popRemappableOop]. ^ self digitDivLarge: firstInt with: secondInt negative: neg! ! !LargeIntegersPlugin methodsFor: 'LargeInteger primitives' stamp: 'sr 12/30/1999 03:02'! primDigitMultiply: firstInteger with: secondInteger negative: neg classLargeNegativeInteger: clni "" | firstInt secondInt | self debugMsg: 'primDigitMultiply: firstInteger with: secondInteger negative: neg'. self failIfForcedFail. self primitive: 'primDigitMultiplyWithNegative' parameters: #(Integer Integer Boolean Class ) receiver: #Oop. self var: #pByte declareC: 'unsigned char * pByte'. (interpreterProxy isIntegerObject: firstInteger) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: secondInteger. firstInt _ self createLargeFromSmallInteger: firstInteger. secondInt _ interpreterProxy popRemappableOop] ifFalse: [firstInt _ firstInteger. secondInt _ secondInteger]. (interpreterProxy isIntegerObject: secondInt) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: firstInt. secondInt _ self createLargeFromSmallInteger: secondInt. firstInt _ interpreterProxy popRemappableOop]. ^ self digitMultiplyLarge: firstInt with: secondInt negative: neg! ! !LargeIntegersPlugin methodsFor: 'LargeInteger primitives' stamp: 'sr 12/30/1999 03:02'! primDigitSubtract: firstInteger with: secondInteger classLargeNegativeInteger: clni "" | firstInt secondInt | self debugMsg: 'primDigitSubtract: firstInteger with: secondInteger'. self failIfForcedFail. self primitive: 'primDigitSubtractWith' parameters: #(Integer Integer Class ) receiver: #Oop. self var: #pByte declareC: 'unsigned char * pByte'. (interpreterProxy isIntegerObject: firstInteger) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: secondInteger. firstInt _ self createLargeFromSmallInteger: firstInteger. secondInt _ interpreterProxy popRemappableOop] ifFalse: [firstInt _ firstInteger. secondInt _ secondInteger]. (interpreterProxy isIntegerObject: secondInt) ifTrue: ["convert it to a not normalized LargeInteger" interpreterProxy pushRemappableOop: firstInt. secondInt _ self createLargeFromSmallInteger: secondInt. firstInt _ interpreterProxy popRemappableOop]. ^ self digitSubLarge: firstInt with: secondInt! ! !LargeIntegersPlugin methodsFor: 'LargeInteger primitives' stamp: 'sr 12/30/1999 03:36'! primNormalize: anInteger self debugMsg: 'primNormalize: anInteger'. self failIfForcedFail. self primitive: 'primNormalize' parameters: #(Integer ) receiver: #Oop. (interpreterProxy isIntegerObject: anInteger) ifTrue: [^ anInteger asOop: SmallInteger]. ^ self normalize: anInteger! ! !LargeIntegersPlugin methodsFor: 'control & support primitives' stamp: 'sr 12/29/1999 20:57'! primAsLargeInteger: anInteger classLargeNegativeInteger: clni "Converts a SmallInteger into a - non normalized!! - LargeInteger; aLargeInteger will be returned unchanged. Will only be called for converting the first argument of the plugin methods for test purposes: plugin methods in Integer - but not SmallInteger!! - classes needn't convert their first argument (because it must be a LargeInteger). Do not check for forced fail, because we need this conversion to test the plugin in ST during forced fail, too." self debugMsg: 'primAsLargeInteger: anInteger'. self primitive: 'primAsLargeInteger' parameters: #(Integer Class) receiver: #Oop. (interpreterProxy isIntegerObject: anInteger) ifTrue: [^ self createLargeFromSmallInteger: anInteger] ifFalse: [^ anInteger]! ! !LargeIntegersPlugin methodsFor: 'control & support primitives' stamp: 'sr 12/27/1999 19:00'! primCheckIfCModuleExists "If calling this primitive fails, then C module does not exist. Do not check for forced fail, because we want to know if module exists during forced fail, too." self primitive: 'primCheckIfCModuleExists' parameters: #() receiver: #Oop. ^ true asOop: Boolean! ! !LargeIntegersPlugin methodsFor: 'control & support primitives' stamp: 'sr 12/27/1999 19:02'! primDebug: aBool "In ST simulation changing C var 'debug' has no effect, cause every prim call creates a new instance. Do not check for forced fail, because we want to change status during forced fail, too." self primitive: 'primDebug' parameters: #(Boolean ) receiver: #Oop. debugFlag _ aBool! ! !LargeIntegersPlugin methodsFor: 'control & support primitives' stamp: 'sr 12/27/1999 19:06'! primForceFailInC: aBool "In ST simulation changing C var 'forceFailInC' has no effect, cause every prim call creates a new instance. Do not check for forced fail, because we want to change status during forced fail, too." self primitive: 'primForceFailInC' parameters: #(Boolean ) receiver: #Oop. forceFailInCFlag _ aBool! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/27/1999 22:05'! bytes: aBytesOop Lshift: shiftCount "Attention: this method invalidates all oop's!! Only newBytes is valid at return." "Does not normalize." | newBytes oldBytes highBit newLen oldLen | oldLen _ self byteSize: aBytesOop. (highBit _ self cBytesHighBit: (interpreterProxy firstIndexableField: aBytesOop) len: oldLen) = 0 ifTrue: [^ 0 asOop: SmallInteger]. newLen _ highBit + shiftCount + 7 // 8. interpreterProxy pushRemappableOop: aBytesOop. newBytes _ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) indexableSize: newLen. oldBytes _ interpreterProxy popRemappableOop. self cBytesLshift: shiftCount from: (interpreterProxy firstIndexableField: oldBytes) len: oldLen to: (interpreterProxy firstIndexableField: newBytes) len: newLen. ^ newBytes! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/27/1999 22:06'! bytes: aBytesOop Rshift: anInteger bytes: b lookfirst: a "Attention: this method invalidates all oop's!! Only newBytes is valid at return." "Shift right 8*b+anInteger bits, 0<=n<8. Discard all digits beyond a, and all zeroes at or below a." "Does not normalize." | n x f m digit i oldLen newLen newBytes oldBytes | n _ 0 - anInteger. x _ 0. f _ n + 8. i _ a. m _ 255 bitShift: 0 - f. digit _ self digitOf: aBytesOop at: i. [((digit bitShift: n) bitOr: x) = 0 and: [i ~= 1]] whileTrue: [x _ digit bitShift: f. "Can't exceed 8 bits" i _ i - 1. digit _ self digitOf: aBytesOop at: i]. i <= b ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) indexableSize: 0"Integer new: 0 neg: self negative"]. "All bits lost" oldLen _ self byteSize: aBytesOop. newLen _ i - b. interpreterProxy pushRemappableOop: aBytesOop. newBytes _ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) indexableSize: newLen. oldBytes _ interpreterProxy popRemappableOop. "r _ Integer new: i - b neg: self negative." " count _ i. " self cCoreBytesRshiftCount: i n: n m: m f: f bytes: b from: (interpreterProxy firstIndexableField: oldBytes) len: oldLen to: (interpreterProxy firstIndexableField: newBytes) len: newLen. ^ newBytes! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/27/1999 22:06'! digitAddLarge: firstInteger with: secondInteger "Does not need to normalize!!" | over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass | self var: #over declareC: 'unsigned char over'. firstLen _ self byteSize: firstInteger. secondLen _ self byteSize: secondInteger. resClass _ interpreterProxy fetchClassOf: firstInteger. firstLen <= secondLen ifTrue: [shortInt _ firstInteger. shortLen _ firstLen. longInt _ secondInteger. longLen _ secondLen] ifFalse: [shortInt _ secondInteger. shortLen _ secondLen. longInt _ firstInteger. longLen _ firstLen]. " sum _ Integer new: len neg: firstInteger negative." interpreterProxy pushRemappableOop: shortInt. interpreterProxy pushRemappableOop: longInt. sum _ interpreterProxy instantiateClass: resClass indexableSize: longLen. longInt _ interpreterProxy popRemappableOop. shortInt _ interpreterProxy popRemappableOop. over _ self cDigitAdd: (interpreterProxy firstIndexableField: shortInt) len: shortLen with: (interpreterProxy firstIndexableField: longInt) len: longLen into: (interpreterProxy firstIndexableField: sum). over > 0 ifTrue: ["sum _ sum growby: 1." interpreterProxy pushRemappableOop: sum. newSum _ interpreterProxy instantiateClass: resClass indexableSize: longLen + 1. sum _ interpreterProxy popRemappableOop. self cBytesCopyFrom: (interpreterProxy firstIndexableField: sum) to: (interpreterProxy firstIndexableField: newSum) len: longLen. sum _ newSum. "C index!!" (self cCoerce: (interpreterProxy firstIndexableField: sum) to: 'unsigned char *') at: longLen put: over]. ^ sum! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/27/1999 22:06'! digitCompareLarge: firstInteger with: secondInteger "Compare the magnitude of firstInteger with that of secondInteger. Return a code of 1, 0, -1 for firstInteger >, = , < secondInteger" | firstLen secondLen | firstLen _ self byteSize: firstInteger. secondLen _ self byteSize: secondInteger. secondLen ~= firstLen ifTrue: [secondLen > firstLen ifTrue: [^ -1 asOop: SmallInteger] ifFalse: [^ 1 asOop: SmallInteger]]. ^ (self cDigitCompare: (interpreterProxy firstIndexableField: firstInteger) with: (interpreterProxy firstIndexableField: secondInteger) len: firstLen) asOop: SmallInteger! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/31/1999 05:51'! digitDivLarge: firstInteger with: secondInteger negative: neg "2.7: change ..myClassLargeNegativeInteger.." "Does not normalize." | firstLen secondLen resultClass l d div firstInt rem quo res | firstLen _ self byteSize: firstInteger. secondLen _ self byteSize: secondInteger. neg ifTrue: [resultClass _ self myClassLargeNegativeInteger] ifFalse: [resultClass _ interpreterProxy classLargePositiveInteger]. "Division by zero has to be checked in caller." l _ firstLen - secondLen + 1. l <= 0 ifTrue: [interpreterProxy pushRemappableOop: firstInteger. res _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. firstInt _ interpreterProxy popRemappableOop. interpreterProxy stObject: res at: 1 put: (0 asOop: SmallInteger). interpreterProxy stObject: res at: 2 put: firstInt. ^ res]. "d _ 8 - arg lastDigit highBit." d _ 8 - (self cHighBit: (self unsafeByteOf: secondInteger at: secondLen)). interpreterProxy pushRemappableOop: firstInteger. div _ self bytes: secondInteger Lshift: d. firstInt _ interpreterProxy popRemappableOop. interpreterProxy pushRemappableOop: firstInt. div _ self bytesOrInt: div growTo: (self digitLength: div) + 1. firstInt _ interpreterProxy popRemappableOop. interpreterProxy pushRemappableOop: div. "shifts so high order word is >=128" rem _ self bytes: firstInt Lshift: d. div _ interpreterProxy popRemappableOop. (self digitLength: rem) = firstLen ifTrue: [interpreterProxy pushRemappableOop: div. rem _ self bytesOrInt: rem growTo: firstLen + 1. div _ interpreterProxy popRemappableOop]. "makes a copy and shifts" interpreterProxy pushRemappableOop: div. interpreterProxy pushRemappableOop: rem. quo _ interpreterProxy instantiateClass: resultClass indexableSize: l. "quo _ Integer new: l neg: neg." rem _ interpreterProxy popRemappableOop. div _ interpreterProxy popRemappableOop. self cCoreDigitDivDiv: (interpreterProxy firstIndexableField: div) len: (self digitLength: div) rem: (interpreterProxy firstIndexableField: rem) len: (self digitLength: rem) quo: (interpreterProxy firstIndexableField: quo) len: (self digitLength: quo). interpreterProxy pushRemappableOop: quo. rem _ self bytes: rem Rshift: d bytes: 0 lookfirst: (self digitLength: div) - 1. "dl" quo _ interpreterProxy popRemappableOop. "^ Array with: quo with: rem" interpreterProxy pushRemappableOop: quo. interpreterProxy pushRemappableOop: rem. res _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. rem _ interpreterProxy popRemappableOop. quo _ interpreterProxy popRemappableOop. interpreterProxy stObject: res at: 1 put: quo. interpreterProxy stObject: res at: 2 put: rem. ^ res! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/29/1999 20:54'! digitMultiplyLarge: firstInteger with: secondInteger negative: neg "2.7: change ..myClassLargeNegativeInteger.." "Normalizes." | firstLen secondLen shortInt shortLen longInt longLen prod resultClass | firstLen _ self byteSize: firstInteger. secondLen _ self byteSize: secondInteger. firstLen <= secondLen ifTrue: [shortInt _ firstInteger. shortLen _ firstLen. longInt _ secondInteger. longLen _ secondLen] ifFalse: [shortInt _ secondInteger. shortLen _ secondLen. longInt _ firstInteger. longLen _ firstLen]. neg ifTrue: [resultClass _ self myClassLargeNegativeInteger] ifFalse: [resultClass _ interpreterProxy classLargePositiveInteger]. interpreterProxy pushRemappableOop: shortInt. interpreterProxy pushRemappableOop: longInt. prod _ interpreterProxy instantiateClass: resultClass indexableSize: longLen + shortLen. longInt _ interpreterProxy popRemappableOop. shortInt _ interpreterProxy popRemappableOop. self cDigitMultiply: (interpreterProxy firstIndexableField: shortInt) len: shortLen with: (interpreterProxy firstIndexableField: longInt) len: longLen into: (interpreterProxy firstIndexableField: prod). ^ self normalize: prod! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/29/1999 21:20'! digitSubLarge: firstInteger with: secondInteger "2.7: change ..myClassLargeNegativeInteger.." "Normalizes." | firstLen secondLen class larger largerLen smaller smallerLen neg resLen res firstNeg | firstNeg _ (interpreterProxy fetchClassOf: firstInteger) = self myClassLargeNegativeInteger. firstLen _ self byteSize: firstInteger. secondLen _ self byteSize: secondInteger. firstLen = secondLen ifTrue: [[(self digitOf: firstInteger at: firstLen) = (self digitOf: secondInteger at: firstLen) and: [firstLen > 1]] whileTrue: [firstLen _ firstLen - 1]. secondLen _ firstLen]. (firstLen < secondLen or: [firstLen = secondLen and: [(self digitOf: firstInteger at: firstLen) < (self digitOf: secondInteger at: firstLen)]]) ifTrue: [larger _ secondInteger. largerLen _ secondLen. smaller _ firstInteger. smallerLen _ firstLen. neg _ firstNeg == false] ifFalse: [larger _ firstInteger. largerLen _ firstLen. smaller _ secondInteger. smallerLen _ secondLen. neg _ firstNeg]. resLen _ largerLen. neg ifTrue: [class _ self myClassLargeNegativeInteger] ifFalse: [class _ interpreterProxy classLargePositiveInteger]. interpreterProxy pushRemappableOop: smaller. interpreterProxy pushRemappableOop: larger. res _ interpreterProxy instantiateClass: class indexableSize: resLen. larger _ interpreterProxy popRemappableOop. smaller _ interpreterProxy popRemappableOop. self cDigitSub: (interpreterProxy firstIndexableField: smaller) len: smallerLen with: (interpreterProxy firstIndexableField: larger) len: largerLen into: (interpreterProxy firstIndexableField: res). ^ self normalize: res! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/22/1999 14:34'! normalize: aLargeInteger "Check for leading zeroes and return shortened copy if so." (interpreterProxy fetchClassOf: aLargeInteger) = interpreterProxy classLargePositiveInteger ifTrue: [^ self normalizePositive: aLargeInteger] ifFalse: [^ self normalizeNegative: aLargeInteger]! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/27/1999 20:31'! normalizeNegative: aLargeNegativeInteger "Check for leading zeroes and return shortened copy if so" "First establish len = significant length" | sLen val len oldLen minVal | len _ oldLen _ self digitLength: aLargeNegativeInteger. [len ~= 0 and: [(self unsafeByteOf: aLargeNegativeInteger at: len) = 0]] whileTrue: [len _ len - 1]. len = 0 ifTrue: [^ 0 asOop: SmallInteger]. "Now check if in SmallInteger range" sLen _ 4. "SmallInteger minVal digitLength" len <= sLen ifTrue: ["SmallInteger minVal" minVal _ -1073741824. (len < sLen or: [(self digitOf: aLargeNegativeInteger at: sLen) < (self cDigitOfCSI: minVal at: sLen) "minVal lastDigit"]) ifTrue: ["If high digit less, then can be small" val _ 0. len to: 1 by: -1 do: [:i | val _ val * 256 - (self unsafeByteOf: aLargeNegativeInteger at: i)]. ^ val asOop: SmallInteger]. 1 to: sLen do: [:i | "If all digits same, then = minVal (sr: minVal digits 1 to 3 are 0)" (self digitOf: aLargeNegativeInteger at: i) = (self cDigitOfCSI: minVal at: i) ifFalse: ["Not so; return self shortened" len < oldLen ifTrue: ["^ self growto: len" ^ self bytes: aLargeNegativeInteger growTo: len] ifFalse: [^ aLargeNegativeInteger]]]. ^ minVal asOop: SmallInteger]. "Return self, or a shortened copy" len < oldLen ifTrue: ["^ self growto: len" ^ self bytes: aLargeNegativeInteger growTo: len] ifFalse: [^ aLargeNegativeInteger]! ! !LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'sr 12/27/1999 20:31'! normalizePositive: aLargePositiveInteger "Check for leading zeroes and return shortened copy if so" "First establish len = significant length" | sLen val len oldLen | len _ oldLen _ self digitLength: aLargePositiveInteger. [len ~= 0 and: [(self unsafeByteOf: aLargePositiveInteger at: len) = 0]] whileTrue: [len _ len - 1]. len = 0 ifTrue: [^ 0 asOop: SmallInteger]. "Now check if in SmallInteger range" sLen _ 4. "SmallInteger maxVal digitLength." (len <= sLen and: [(self digitOf: aLargePositiveInteger at: sLen) <= (self cDigitOfCSI: 1073741823 at: sLen) "SmallInteger maxVal"]) ifTrue: ["If so, return its SmallInt value" val _ 0. len to: 1 by: -1 do: [:i | val _ val * 256 + (self unsafeByteOf: aLargePositiveInteger at: i)]. ^ val asOop: SmallInteger]. "Return self, or a shortened copy" len < oldLen ifTrue: ["^ self growto: len" ^ self bytes: aLargePositiveInteger growTo: len] ifFalse: [^ aLargePositiveInteger]! ! !LargeIntegersPlugin methodsFor: 'oop util' stamp: 'sr 12/27/1999 22:06'! bytes: aBytesObject growTo: newLen "Attention: this method invalidates all oop's!! Only newBytes is valid at return." "Does not normalize." | newBytes oldBytes oldLen copyLen | interpreterProxy pushRemappableOop: aBytesObject. newBytes _ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject) indexableSize: newLen. oldBytes _ interpreterProxy popRemappableOop. oldLen _ self byteSize: oldBytes. oldLen < newLen ifTrue: [copyLen _ oldLen] ifFalse: [copyLen _ newLen]. self cBytesCopyFrom: (interpreterProxy firstIndexableField: oldBytes) to: (interpreterProxy firstIndexableField: newBytes) len: copyLen. ^ newBytes! ! !LargeIntegersPlugin methodsFor: 'oop util' stamp: 'sr 12/29/1999 20:50'! bytesOrInt: oop growTo: len "2.7: change ..myClassLargeNegativeInteger.." "Attention: this method invalidates all oop's!! Only newBytes is valid at return." | newBytes val class | (interpreterProxy isIntegerValue: oop) ifTrue: [val _ interpreterProxy integerValueOf: oop. val < 0 ifTrue: [class _ self myClassLargeNegativeInteger] ifFalse: [class _ interpreterProxy classLargePositiveInteger]. newBytes _ interpreterProxy instantiateClass: class indexableSize: len. self cCopyIntVal: val toBytes: newBytes] ifFalse: [newBytes _ self bytes: oop growTo: len]. ^ newBytes! ! !LargeIntegersPlugin methodsFor: 'oop util' stamp: 'sr 12/29/1999 21:19'! createLargeFromSmallInteger: anOop "anOop has to be a SmallInteger!!" | val class size res pByte | self var: #pByte declareC: 'unsigned char * pByte'. val _ interpreterProxy integerValueOf: anOop. val < 0 ifTrue: [class _ self myClassLargeNegativeInteger] ifFalse: [class _ interpreterProxy classLargePositiveInteger]. size _ self cDigitLengthOfCSI: val. res _ interpreterProxy instantiateClass: class indexableSize: size. pByte _ interpreterProxy firstIndexableField: res. 1 to: size do: [:ix | pByte at: ix - 1 put: (self cDigitOfCSI: val at: ix)]. ^ res! ! !LargeIntegersPlugin methodsFor: 'oop util' stamp: 'sr 12/29/1999 21:25'! myClassLargeNegativeInteger self assert: (interpreterProxy is: (interpreterProxy stackObjectValue: 0) KindOf: 'Class'). ^ interpreterProxy stackObjectValue: 0! ]style[(27 2 4 10 16 6 16 19 1 13 7 6 16 19 1)f1b,f1,f1cblue;b,f1,f1cblue;b,f1,f1cblue;b,f1,f1c152050000,f1,f1c152050000,f1,f1cblue;b,f1,f1c152050000! ! !LargeIntegersPlugin methodsFor: 'util' stamp: 'sr 12/27/1999 22:19'! byteSize: oop "Precondition: oop is not anInteger." "Function #byteSizeOf: is used by the interpreter, be careful with name clashes..." ^ interpreterProxy slotSizeOf: oop! ! !LargeIntegersPlugin methodsFor: 'util' stamp: 'sr 12/27/1999 07:33'! digitLength: oop (interpreterProxy isIntegerObject: oop) ifTrue: [^ self cDigitLengthOfCSI: (interpreterProxy integerValueOf: oop)] ifFalse: [^ self byteSize: oop]! ! !LargeIntegersPlugin methodsFor: 'util' stamp: 'sr 12/27/1999 22:07'! digitOf: oop at: ix self cCode: '' inSmalltalk: [self flag: #think]. (interpreterProxy isIntegerObject: oop) ifTrue: [^ self cDigitOfCSI: (interpreterProxy integerValueOf: oop) at: ix] ifFalse: [ix > (self byteSize: oop) ifTrue: [^ 0] ifFalse: [^ self unsafeByteOf: oop at: ix]]! ! !LargeIntegersPlugin methodsFor: 'util' stamp: 'sr 12/27/1999 22:01'! unsafeByteOf: bytesOop at: ix "Argument bytesOop must not be aSmallInteger!!" ^ interpreterProxy integerValueOf: (interpreterProxy stObject: bytesOop at: ix)! ! !LargeIntegersPlugin methodsFor: 'testing' stamp: 'sr 12/27/1999 04:58'! forceFail "" ^ self runsInC and: [self forceFailInC]! ! !LargeIntegersPlugin methodsFor: 'testing' stamp: 'sr 12/27/1999 05:08'! forceFailInC "ST class var 'ForceFailInCFlag' corresponds to C var 'forceFailInCFlag'." ^ self cCode: 'forceFailInCFlag' inSmalltalk: [ForceFailInCFlag]! ! !LargeIntegersPlugin methodsFor: 'testing' stamp: 'sr 12/23/1999 19:27'! isBytesObject: oop ^ (interpreterProxy isIntegerObject: oop) not and: [interpreterProxy isBytes: oop]! ! !LargeIntegersPlugin methodsFor: 'testing' stamp: 'sr 12/27/1999 04:57'! runsInC "" ^ self cCode: '1' inSmalltalk: [false]! ! !LargeIntegersPlugin methodsFor: 'testing' stamp: 'sr 12/27/1999 05:08'! runsInDebugMode "ST class var 'DebugFlag' corresponds to C var 'debugFlag'." ^ self cCode: 'debugFlag' inSmalltalk: [DebugFlag]! ! !LargeIntegersPlugin methodsFor: 'testing' stamp: 'sr 12/27/1999 04:58'! runsInSmalltalk "" ^ self runsInC not! ! !LargeIntegersPlugin methodsFor: 'debugging' stamp: 'sr 12/27/1999 04:57'! assert: aBool self runsInDebugMode ifTrue: [aBool ifFalse: [self msg: 'Assertion failed!!'. ^ interpreterProxy primitiveFail]]. ^ true! ! !LargeIntegersPlugin methodsFor: 'debugging' stamp: 'sr 12/27/1999 04:57'! debugMsg: s "ST class var 'Debug' corresponds to C var 'debug'." self var: #s declareC: 'char *s'. self runsInDebugMode ifTrue: [self msg: s]! ! !LargeIntegersPlugin methodsFor: 'debugging' stamp: 'sr 12/27/1999 04:25'! failIfForcedFail self forceFail ifTrue: [self debugMsg: 'forced fail'. ^ interpreterProxy primitiveFail]! ! !LargeIntegersPlugin methodsFor: 'debugging' stamp: 'sr 12/21/1999 14:59'! msg: s self var: #s declareC: 'char *s'. self cCode: 'fprintf(stderr, "\n%s", s)' inSmalltalk: [Transcript cr; show: s; endEntry]! ! !LargeIntegersPlugin methodsFor: 'debugging' stamp: 'sr 12/27/1999 05:06'! think "Flag for marking methods for later thinking." ^ self error: 'should not be called'! ! !LargeIntegersPlugin methodsFor: 'C core' stamp: 'sr 12/24/1999 05:57'! cBytesLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo "C indexed!!" | byteShift bitShift carry rShift mask limit digit lastIx | self returnTypeC: 'int'. self var: #pTo declareC: 'unsigned char * pTo'. self var: #pFrom declareC: 'unsigned char * pFrom'. self var: #lenFrom declareC: 'int lenFrom'. self var: #lenTo declareC: 'int lenTo'. byteShift _ shiftCount // 8. bitShift _ shiftCount \ 8. bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts" "C indexed!!" ^ self cBytesReplace: pTo from: byteShift to: lenTo - 1 with: pFrom startingAt: 0]. carry _ 0. rShift _ bitShift - 8. mask _ 255 bitShift: 0 - bitShift. limit _ byteShift - 1. 0 to: limit do: [:i | pTo at: i put: 0]. limit _ lenTo - byteShift - 2. self assert: limit < lenFrom. 0 to: limit do: [:i | digit _ pFrom at: i. pTo at: i + byteShift put: (((digit bitAnd: mask) bitShift: bitShift) bitOr: carry). carry _ digit bitShift: rShift]. lastIx _ limit + 1. lastIx > (lenFrom - 1) ifTrue: [digit _ 0] ifFalse: [digit _ pFrom at: lastIx]. pTo at: lastIx + byteShift put: (((digit bitAnd: mask) bitShift: bitShift) bitOr: carry). carry _ digit bitShift: rShift. self assert: carry = 0! ! !LargeIntegersPlugin methodsFor: 'C core' stamp: 'sr 12/23/1999 18:46'! cCoreBytesRshiftCount: count n: n m: m f: f bytes: b from: pFrom len: fromLen to: pTo len: toLen | x digit | self var: #pTo declareC: 'unsigned char * pTo'. self var: #pFrom declareC: 'unsigned char * pFrom'. self assert: b < fromLen. x _ (pFrom at: b) bitShift: n. self assert: count - 1 < fromLen. b + 1 to: count - 1 do: [:j | digit _ pFrom at: j. pTo at: j - b - 1 put: (((digit bitAnd: m) bitShift: f) bitOr: x). "Avoid values > 8 bits" x _ digit bitShift: n]. count = fromLen ifTrue: [digit _ 0] ifFalse: [digit _ pFrom at: count]. pTo at: count - b - 1 put: (((digit bitAnd: m) bitShift: f) bitOr: x)! ! !LargeIntegersPlugin methodsFor: 'C core' stamp: 'sr 12/27/1999 23:13'! cCoreDigitDivDiv: pDiv len: divLen rem: pRem len: remLen quo: pQuo len: quoLen | dl ql dh dnh j qhi qlo t hi lo r3 l a cond | self var: #pDiv declareC: 'unsigned char * pDiv'. self var: #pRem declareC: 'unsigned char * pRem'. self var: #pQuo declareC: 'unsigned char * pQuo'. dl _ divLen - 1. "Last actual byte of data" ql _ quoLen. dh _ pDiv at: dl - 1. dl = 1 ifTrue: [dnh _ 0] ifFalse: [dnh _ pDiv at: dl - 2]. 1 to: ql do: [:k | "maintain quo*arg+rem=self" "Estimate rem/div by dividing the leading to bytes of rem by dh." "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles." j _ remLen + 1 - k. "r1 _ rem digitAt: j." (pRem at: j - 1) = dh ifTrue: [qhi _ qlo _ 15 "i.e. q=255"] ifFalse: ["Compute q = (r1,r2)//dh, t = (r1,r2)\dh. Note that r1,r2 are bytes, not nibbles. Be careful not to generate intermediate results exceeding 13 bits." "r2 _ (rem digitAt: j - 1)." t _ ((pRem at: j - 1) bitShift: 4) + ((pRem at: j - 2) bitShift: -4). qhi _ t // dh. t _ (t \ dh bitShift: 4) + ((pRem at: j - 2) bitAnd: 15). qlo _ t // dh. t _ t \ dh. "Next compute (hi,lo) _ q*dnh" hi _ qhi * dnh. lo _ qlo * dnh + ((hi bitAnd: 15) bitShift: 4). hi _ (hi bitShift: -4) + (lo bitShift: -8). lo _ lo bitAnd: 255. "Correct overestimate of q. Max of 2 iterations through loop -- see Knuth vol. 2" j < 3 ifTrue: [r3 _ 0] ifFalse: [r3 _ pRem at: j - 3]. [(t < hi or: [t = hi and: [r3 < lo]]) ifTrue: ["i.e. (t,r3) < (hi,lo)" qlo _ qlo - 1. lo _ lo - dnh. lo < 0 ifTrue: [hi _ hi - 1. lo _ lo + 256]. cond _ hi >= dh] ifFalse: [cond _ false]. cond] whileTrue: [hi _ hi - dh]. qlo < 0 ifTrue: [qhi _ qhi - 1. qlo _ qlo + 16]]. "Subtract q*div from rem" l _ j - dl. a _ 0. 1 to: divLen do: [:i | hi _ (pDiv at: i - 1) * qhi. lo _ a + (pRem at: l - 1) - ((hi bitAnd: 15) bitShift: 4) - ((pDiv at: i - 1) * qlo). pRem at: l - 1 put: lo - (lo // 256 * 256). "sign-tolerant form of (lo bitAnd: 255)" a _ lo // 256 - (hi bitShift: -4). l _ l + 1]. a < 0 ifTrue: ["Add div back into rem, decrease q by 1" qlo _ qlo - 1. l _ j - dl. a _ 0. 1 to: divLen do: [:i | a _ (a bitShift: -8) + (pRem at: l - 1) + (pDiv at: i - 1). pRem at: l - 1 put: (a bitAnd: 255). l _ l + 1]]. pQuo at: quoLen - k put: (qhi bitShift: 4) + qlo]! ! !LargeIntegersPlugin methodsFor: 'C core' stamp: 'sr 12/17/1999 09:48'! cDigitAdd: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes "pByteRes len = longLen; returns over.." | accum limit | self returnTypeC: 'unsigned char'. self var: #pByteShort declareC: 'unsigned char * pByteShort'. self var: #pByteLong declareC: 'unsigned char * pByteLong'. self var: #pByteRes declareC: 'unsigned char * pByteRes'. self var: #shortLen declareC: 'int shortLen'. self var: #longLen declareC: 'int longLen'. self var: #accum declareC: 'int accum'. self var: #limit declareC: 'int limit'. accum _ 0. limit _ shortLen - 1. 0 to: limit do: [:i | accum _ (accum bitShift: -8) + (pByteShort at: i) + (pByteLong at: i). pByteRes at: i put: (accum bitAnd: 255)]. limit _ longLen - 1. shortLen to: limit do: [:i | accum _ (accum bitShift: -8) + (pByteLong at: i). pByteRes at: i put: (accum bitAnd: 255)]. ^ accum bitShift: -8! ! !LargeIntegersPlugin methodsFor: 'C core' stamp: 'sr 12/27/1999 21:24'! cDigitCompare: pFirst with: pSecond len: len "Precondition: pFirst len = pSecond len." | secondDigit ix firstDigit | self var: #pFirst declareC: 'unsigned char * pFirst'. self var: #pSecond declareC: 'unsigned char * pSecond'. ix _ len - 1. [ix >= 0] whileTrue: [(secondDigit _ pSecond at: ix) ~= (firstDigit _ pFirst at: ix) ifTrue: [secondDigit < firstDigit ifTrue: [^ 1] ifFalse: [^ -1]]. ix _ ix - 1]. ^ 0! ! !LargeIntegersPlugin methodsFor: 'C core' stamp: 'sr 12/21/1999 09:56'! cDigitMultiply: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes "pByteRes len = longLen * shortLen" | limitLong digit k carry limitShort ab | self returnTypeC: 'unsigned char'. self var: #pByteShort declareC: 'unsigned char * pByteShort'. self var: #pByteLong declareC: 'unsigned char * pByteLong'. self var: #pByteRes declareC: 'unsigned char * pByteRes'. self var: #shortLen declareC: 'int shortLen'. self var: #longLen declareC: 'int longLen'. self var: #carry declareC: 'int carry'. self var: #limitLong declareC: 'int limitLong'. self var: #limitShort declareC: 'int limitShort'. self var: #digit declareC: 'int digit'. self var: #ab declareC: 'int ab'. self var: #k declareC: 'int k'. (shortLen = 1 and: [(pByteShort at: 0) = 0]) ifTrue: [^ 0]. (longLen = 1 and: [(pByteLong at: 0) = 0]) ifTrue: [^ 0]. "prod starts out all zero" limitShort _ shortLen - 1. 0 to: limitShort do: [:i | (digit _ pByteShort at: i) ~= 0 ifTrue: [k _ i. carry _ 0. "Loop invariant: 0<=carry<=0377, k=i+j-1 (ST)" "-> Loop invariant: 0<=carry<=0377, k=i+j (C) (?)" limitLong _ longLen - 1. 0 to: limitLong do: [:j | ab _ (pByteLong at: j) * digit + carry + (pByteRes at: k). carry _ ab bitShift: -8. pByteRes at: k put: (ab bitAnd: 255). k _ k + 1]. pByteRes at: k put: carry]]. ^ 0! ! !LargeIntegersPlugin methodsFor: 'C core' stamp: 'sr 12/22/1999 07:47'! cDigitSub: pByteSmall len: smallLen with: pByteLarge len: largeLen into: pByteRes | z limit | self var: #pByteSmall declareC: 'unsigned char * pByteSmall'. self var: #pByteLarge declareC: 'unsigned char * pByteLarge'. self var: #pByteRes declareC: 'unsigned char * pByteRes'. self var: #smallLen declareC: 'int smallLen'. self var: #largeLen declareC: 'int largeLen'. z _ 0. "Loop invariant is -1<=z<=1" limit _ smallLen - 1. 0 to: limit do: [:i | z _ z + (pByteLarge at: i) - (pByteSmall at: i). pByteRes at: i put: z - (z // 256 * 256). "sign-tolerant form of (z bitAnd: 255)" z _ z // 256]. limit _ largeLen - 1. smallLen to: limit do: [:i | z _ z + (pByteLarge at: i) . pByteRes at: i put: z - (z // 256 * 256). "sign-tolerant form of (z bitAnd: 255)" z _ z // 256]. ! ! !LargeIntegersPlugin methodsFor: 'C core util' stamp: 'sr 12/21/1999 01:26'! cBytesCopyFrom: pFrom to: pTo len: len "" | limit | self returnTypeC: 'int'. self var: #pFrom declareC: 'unsigned char * pFrom'. self var: #pTo declareC: 'unsigned char * pTo'. self var: #len declareC: 'int len'. self var: #limit declareC: 'int limit'. limit _ len - 1. 0 to: limit do: [:i | pTo at: i put: (pFrom at: i)]. ^ 0! ! !LargeIntegersPlugin methodsFor: 'C core util' stamp: 'sr 12/22/1999 15:05'! cBytesHighBit: pByte len: len "Answer the index of the high order bit of the receiver, or zero if the receiver is zero. This method is allowed (and needed) for LargeNegativeIntegers as well, since Squeak's LargeIntegers are sign/magnitude." | realLength lastDigit | self var: #pByte declareC: 'unsigned char * pByte'. realLength _ len. [(lastDigit _ pByte at: realLength - 1) = 0] whileTrue: [(realLength _ realLength - 1) = 0 ifTrue: [^ 0]]. ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))! ! !LargeIntegersPlugin methodsFor: 'C core util' stamp: 'sr 12/23/1999 14:44'! cBytesReplace: pTo from: start to: stop with: pFrom startingAt: repStart "C indexed!!" self returnTypeC: 'int'. self var: #pTo declareC: 'unsigned char * pTo'. self var: #pFrom declareC: 'unsigned char * pFrom'. self var: #start declareC: 'int start'. self var: #stop declareC: 'int stop'. self var: #repStart declareC: 'int repStart'. ^ self cBytesCopyFrom: pFrom + repStart to: pTo + start len: stop - start + 1! ! !LargeIntegersPlugin methodsFor: 'C core util' stamp: 'sr 12/27/1999 11:38'! cCopyIntVal: val toBytes: bytes | pByte | self var: #pByte declareC: 'unsigned char * pByte'. pByte _ interpreterProxy firstIndexableField: bytes. 1 to: (self cDigitLengthOfCSI: val) do: [:ix | pByte at: ix - 1 put: (self cDigitOfCSI: val at: ix)]! ! !LargeIntegersPlugin methodsFor: 'C core util' stamp: 'sr 12/12/1999 05:53'! cDigitLengthOfCSI: csi "Answer the number of indexable fields of a CSmallInteger. This value is the same as the largest legal subscript." self returnTypeC: 'int'. self var: #csi declareC: 'int csi'. (csi < 256 and: [csi > -256]) ifTrue: [^ 1]. (csi < 65536 and: [csi > -65536]) ifTrue: [^ 2]. (csi < 16777216 and: [csi > -16777216]) ifTrue: [^ 3]. ^ 4! ! !LargeIntegersPlugin methodsFor: 'C core util' stamp: 'sr 12/23/1999 15:12'! cDigitOfCSI: csi at: ix "Answer the value of an indexable field in the receiver. LargePositiveInteger uses bytes of base two number, and each is a 'digit' base 256." "ST indexed!!" ix < 0 ifTrue: [interpreterProxy primitiveFail]. ix > 4 ifTrue: [^ 0]. csi < 0 ifTrue: [self cCode: '' inSmalltalk: [csi = -1073741824 ifTrue: ["SmallInteger minVal" "Can't negate minVal -- treat specially" ^ #(0 0 0 64 ) at: ix]]. ^ (0 - csi bitShift: 1 - ix * 8) bitAnd: 255] ifFalse: [^ (csi bitShift: 1 - ix * 8) bitAnd: 255]! ! !LargeIntegersPlugin methodsFor: 'C core util' stamp: 'sr 12/22/1999 11:53'! cHighBit: uint "Answer the index of the high order bit of the argument, or zero if the argument is zero." | shifted bitNo | self var: #shifted declareC: 'unsigned int shifted'. shifted _ uint. bitNo _ 0. [shifted < 16] whileFalse: [shifted _ shifted bitShift: -4. bitNo _ bitNo + 4]. [shifted = 0] whileFalse: [shifted _ shifted bitShift: -1. bitNo _ bitNo + 1]. ^ bitNo! ! !LargeIntegersPlugin methodsFor: 'crashing' stamp: 'sr 12/11/1999 02:24'! crashPrimLargeIntegerSum: x with: y "test status -> parameter are SmallIntegers" self primitive: 'crashPrimLargeIntegerSum' parameters: #(SmallInteger SmallInteger ) receiver: #Oop. ^ x + y! ! !LargeIntegersPlugin class reorganize! ('class initialization' initialize startUp) ('translation' declareCVarsIn:) ('primitive calls' callPrimDebug: callPrimForceFailInC:) ('debug' checkIfCModuleExists debug: forceFailInC: runInC:) ! !LargeIntegersPlugin class methodsFor: 'class initialization' stamp: 'sr 12/30/1999 02:01'! initialize "LargeIntegerPlugin initialize" super initialize. DebugFlag _ false. ForceFailInCFlag _ false. Smalltalk addToStartUpList: self! ! !LargeIntegersPlugin class methodsFor: 'class initialization' stamp: 'sr 12/30/1999 15:58'! startUp "Mirrors debug flag in module." self checkIfCModuleExists ifTrue: [self callPrimDebug: DebugFlag. self callPrimForceFailInC: ForceFailInCFlag. Transcript cr; show: 'Module LargeIntegers initialized.'. LargeIntegersControl usePlugin: true] ifFalse: [Transcript cr; show: 'Initializing module ''LargeIntegers'' failed: LargeInteger arithmetics will be made with normal speed...'. LargeIntegersControl usePlugin: false]! ! !LargeIntegersPlugin class methodsFor: 'translation' stamp: 'sr 12/29/1999 21:51'! declareCVarsIn: cg cg var: 'debug' declareC: 'static int debug'. cg var: 'forceFailInCFlag' declareC: 'static int forceFailInCFlag'. ! ! !LargeIntegersPlugin class methodsFor: 'primitive calls' stamp: 'sr 12/27/1999 04:34'! callPrimDebug: aBool <primitive: 'primDebug' module:'LargeIntegers'> "In ST its only a syntax check without functionality." ^ LargeIntegerPlugin doPrimitive: 'primDebug:' withArguments: {aBool}! ! !LargeIntegersPlugin class methodsFor: 'primitive calls' stamp: 'sr 12/27/1999 04:31'! callPrimForceFailInC: aBool <primitive: 'primForceFailInC' module:'LargeIntegers'> "In ST its only a syntax check without functionality." ^ LargeIntegerPlugin doPrimitive: 'primForceFailInC:' withArguments: {aBool}! ! !LargeIntegersPlugin class methodsFor: 'debug' stamp: 'sr 12/27/1999 04:33'! checkIfCModuleExists <primitive: 'primCheckIfCModuleExists' module:'LargeIntegers'> ^ false! ! !LargeIntegersPlugin class methodsFor: 'debug' stamp: 'sr 12/27/1999 05:02'! debug: aBool DebugFlag _ aBool. "Mirror 'Debug' in module." self callPrimDebug: aBool! ! !LargeIntegersPlugin class methodsFor: 'debug' stamp: 'sr 12/27/1999 05:00'! forceFailInC: aBool ForceFailInCFlag _ aBool. "Mirror 'ForceFailInC' in module." self callPrimForceFailInC: aBool! ! !LargeIntegersPlugin class methodsFor: 'debug' stamp: 'sr 12/29/1999 21:59'! runInC: aBool ^self forceFailInC: aBool not! ! Smalltalk renameClassNamed: #TestLargeIntegersPlugin as: #LargeIntegersTest! !LargeIntegersTest commentStamp: '<historical>' prior: 0! Some tests for LargeIntegersPlugin functions and their binding to Integer methods.! !LargeIntegersTest methodsFor: 'as yet unclassified' stamp: 'sr 12/30/1999 13:03'! computeOp: anOpSymbol with: arg1 with: arg2 | normalRes pluginRes ok | transcript show: '.' , anOpSymbol. self pluginOff. normalRes _ arg1 perform: anOpSymbol with: arg2. self pluginOn. pluginRes _ arg1 perform: anOpSymbol with: arg2. ok _ normalRes = pluginRes. self pluginOff. ok _ ok & (normalRes = pluginRes). ok ifFalse: [self halt]. ^ ok! ! !LargeIntegersTest methodsFor: 'as yet unclassified' stamp: 'sr 12/30/1999 12:07'! createTestData | tmpPos1 tmpPos2 tmpNeg1 tmpNeg2 | tmpPos1 _ OrderedCollection new. tmpPos2 _ OrderedCollection new. tmpPos1 add: 0. tmpPos2 add: 0. tmpPos1 add: 1. tmpPos2 add: 1. tmpPos1 add: SmallInteger maxVal + 1 * 1000. tmpPos2 add: SmallInteger maxVal. tmpPos1 add: SmallInteger maxVal. tmpPos2 add: 77. tmpPos1 add: (2 raisedTo: 7). tmpPos2 add: (2 raisedTo: 7). tmpPos1 add: (2 raisedTo: 31). tmpPos2 add: (2 raisedTo: 31). tmpPos1 add: (2 raisedTo: 7). tmpPos2 add: (2 raisedTo: 31). tmpPos1 add: (2 raisedTo: 31). tmpPos2 add: (2 raisedTo: 7). tmpPos1 add: (2 raisedTo: 100). tmpPos2 add: (2 raisedTo: 100) - 1. tmpPos1 add: (2 raisedTo: 1000). tmpPos2 add: (2 raisedTo: 1000) - 1. tmpPos1 add: 65535. tmpPos2 add: 3. tmpPos1 add: 3. tmpPos2 add: 65535. tmpNeg1 _ tmpPos1 collect: [:e | e negated]. tmpNeg2 _ tmpPos2 collect: [:e | e negated]. oc1 _ tmpPos1 , tmpPos1 , tmpNeg1 , tmpNeg1. oc2 _ tmpPos2 , tmpNeg2 , tmpNeg2 , tmpPos2. ocShift _ (tmpPos1 collect: [:e | e]) , (tmpPos2 collect: [:e | e]) , (tmpPos1 collect: [:e | e + (2 raisedTo: 32)]) , (tmpPos2 collect: [:e | e + (2 raisedTo: 32)]). ocShift2 _ OrderedCollection new. 0 to: ocShift size - 1 do: [:ix | ocShift2 add: ix]. ocShift _ ocShift , ocShift. ocShift2 addAll: (ocShift2 collect: [:e | e negated]). ! ! !LargeIntegersTest methodsFor: 'as yet unclassified' stamp: 'sr 12/30/1999 11:52'! pluginOff LargeIntegersControl usePlugin: false! ! !LargeIntegersTest methodsFor: 'as yet unclassified' stamp: 'sr 12/30/1999 11:52'! pluginOn LargeIntegersControl usePlugin: true.! ! !LargeIntegersTest methodsFor: 'as yet unclassified' stamp: 'sr 12/30/1999 13:04'! test | ok | self pluginOff. transcript cr; cr; show: 'Testing LargeIntegersPlugin, module runs in ' , (LargeIntegersPlugin checkIfCModuleExists ifTrue: ['C'] ifFalse: ['ST simulated']) , ' mode...'; cr. transcript cr; show: 'operation symbols shown; ''0'' stands for (avoided) divison by ''0'''; cr. ok _ true. oc1 with: oc2 do: [:e1 :e2 | ok _ ok & (self computeOp: #+ with: e1 with: e2) & (self computeOp: #- with: e1 with: e2) & (self computeOp: #* with: e1 with: e2). e2 ~= 0 ifTrue: [ok _ ok & (self computeOp: #/ with: e1 with: e2)] ifFalse: [transcript show: ' 0 ']]. ocShift with: ocShift2 do: [:e1 :e2 | ok _ ok & (self computeOp: #bitShift: with: e1 with: e2)]. ^ ok! ! !LargeIntegersTest methodsFor: 'as yet unclassified' stamp: 'sr 12/30/1999 12:58'! transcript ^transcript! ! !LargeIntegersTest methodsFor: 'as yet unclassified' stamp: 'sr 12/30/1999 12:57'! transcript: aTranscript transcript _ aTranscript! ! !LargeIntegersTest class methodsFor: 'user interface' stamp: 'sr 12/30/1999 14:01'! doIt "Validate computations of plugin." "Needs a Transcript for output!!" "LargeIntegersTest doIt" "" " | tt | tt _ TranscriptStream new. tt openLabel: 'Log ' , self class name." ^ LargeIntegersTest doIt: nil! ! !LargeIntegersTest class methodsFor: 'user interface' stamp: 'sr 12/30/1999 15:22'! doIt: transcript "Validate computations of plugin." "LargeIntegersTest doIt" | tester ok storedPluginMode | tester _ self new. tester transcript: (transcript notNil ifTrue: [transcript] ifFalse: [Transcript]). storedPluginMode _ LargeIntegersControl usePlugin. tester pluginOff. tester transcript cr; show: self class name , ': creating test data...'. tester createTestData. ok _ tester test. tester transcript cr; show: (ok ifTrue: ['-> all is OK!!'] ifFalse: ['-> errors occured...']). self inform: 'Switch plugin on/off by ''LargeIntegersControl class usePlugin: true/false.'''. LargeIntegersControl usePlugin: (ok and: [storedPluginMode]). self inform: 'Currently it is switched ' , (LargeIntegersControl usePlugin ifTrue: ['on!!'] ifFalse: ['off!!']). ^ ok! ! LargeIntegersControl initialize! LargeIntegersPlugin initialize! "Postscript: Init..." LargeIntegersPlugin initialize. LargeIntegersControl initialize. " Short Guide for Installing and Testing the LargeIntegers Plugin Warning: This guide is platform specific regarding compiling informations and can irritate users not working on Linux!! #### First part #### If you just want to use the plugin read this part. Precondition: First you have to have a compilable port of your squeak; for me it is the Linux port from Ian Piumarta. The following explanation are made out of this view, but I think/hope it should be similar on other platforms. Next steps: After a file in of this change set you evaluate LargeIntegersPlugin translateDoInlining: true. This generates a source file 'LargeIntegersPlugin.c' in your working directory. You have to put this source file into a directory called 'LargeIntegers' below '../Sources/src/' leading to the long name '../Sources/src/LargeIntegers/LargeIntegersPlugin.c'. Then type make reconfig make .. Then the makefiles should automatically generate a 'LargeIntegers.so' as '../Sources/i686-pc-linux-gnu/LargeIntegers.so'. You see, the *.so takes the name of its directory. Naming is important, because the plugin functions are called over the name of its *.so module in which they resist ('LargeIntegers.so' in this case). Then you have to put module 'LargeIntegers.so' to the same place where your 'squeak', '*.image' and '*.changes' are. That's it!! First call of the plugin: Now you are back to Squeak/Smalltalk. First it makes sense to check, if the module is reachable from Squeak, what means that it is properly installed. Just start squeak and you will see a message like Module LargeIntegers initialized. or Initializing module 'LargeIntegers' failed: LargeInteger arithmetics will be made with normal speed... in your Transcript window (you need one to see these messages). If the initialization has failed, something is wrong; please check the previous steps again. Startup behavior: If LargeIntegers has been succesfully initialized, the plugin will be switched on automatically; otherwise it is automatically switched off (LargeIntegersControl usePlugin: true/false). Binding of the LargeIntegers plugin with the Squeak system: Now it is time to use the plugin. Therefore you have to file in the second changes file 'Install LI plugin', which binds the module to the Integer classes. After that you have much faster speed, if you compute large integers without any performance loss for smaller ones. Testing the LargeIntegers plugin: Most important method calls are LargeIntegersControl usePlugin: true. , which switches it on, respective LargeIntegersControl usePlugin: false. , which switches the plugin off. Turning off the plugin means that it isn't called from ST and the standard ST methods are used for the computations. The time loss for this check is minimal. Calling LargeIntegersTest doIt uses this method to make every test twice: once with plugin switched on and once with plugin switched off. Then it compares the results to see if they are equal ;-) Be careful: If you stop the computation of this method, the plugin may be in either mode. Speed tests: Switch the plugin off by evaluating LargeIntegersControl usePlugin: false. After that you are able to make a long computation inside standard ST methods, a good example is - I like it very much - evaluating with printIt (otherwise you are waiting without knowing how long) 'printIt' Time millisecondsToRun: [10000 factorial]. (For the non mathematicians: 10000 factorial means 10000!! means 10000 * 9999 * 9998 * 9997 * 9996 * .... * 3 * 2 * 1.) If this takes too much time on your machine you can cut one zero of course ;-) Then you switch the plugin on by evaluating LargeIntegersPlugin usePlugin: true and repeat 'printIt' Time millisecondsToRun: [10000 factorial]. .. Then you have a first impression... Have fun!! Stephan Rudlof (sr@evolgo.de) #### Second part #### If you want to go deeper read this part, otherwise ignore it!! There are some useful class methods for controlling the behavior of the plugin. The method LargeIntegersPlugin debug: true. switches the debug mode on. This mode shows the names of the called functions, which are printed to 'stderr', what is a terminal window under Linux. This slows down the computations, but it is the provement that we are computing really in C!! After that we go to normal mode just by LargeIntegersPlugin debug: false. .. If the plugin is switched on (by LargeIntegersControl usePlugin: true), there is another flag which influences its behavior: LargeIntegersPlugin runInC: true. is the standard, but if LargeIntegersPlugin runInC: false. is set, the called plugin primitives are forced to fail immediately before any expensive computation in C has been made. Then at once the plugin will be simulated in ST. This is a very slow mode for developing and debugging purposes. If the plugin starts to run in C (LargeIntegersPlugin runInC: true.), but the primitive fails during its computation, it will also be simulated in ST. Normally the same error occurs then again in ST, but after that it stops with a debugger window. In normal use this case should not occure!! How to look what happens (LargeIntegersControl usePlugin: true) If you are not sure if you are in C or in Smalltalk, just set the debug mode on and see messages in the terminal from which squeak was started (module functions in C), or in a Transcript window (module functions simulated in ST). Lets assume that run in C is switched off (by LargeIntegersPlugin runInC: false): Then you first see a called function name in the terminal (function called in C), then it returns immediately and you see the same name in the Transcript window. If the messages in the terminal are missing, then there is no terminal (platform dependent?) or the C module is not called at all, because it is not reachable (see above, how to check this)!! Run in C switched on (LargeIntegersPlugin runInC: true): If the messages in the Transcript are missing, the module works correct, because it only runs successful in C. Speed tests: First you have to switch off the debug mode of course (LargeIntegersPlugin debug: false.); and switch on running in C (LargeIntegersPlugin runInC: true). Then you look above for an example. Startup behavior: If LargeIntegers has been succesfully initialized, the plugin will be switched on automatically; otherwise it is automatically switched off (LargeIntegersControl usePlugin: true/false). Important: #debug: and #runInC: settings are preserved between different calls of squeak!! Summary: The LargeIntegers plugin can run in three different manners: - first in C, then after a fail by error restarted in Smalltalk simulation; (usePlugin: true), (runInC: true) - directly after forced fail (this is no error!!) in ST simulation; (usePlugin: true), (runInC: false) - not at all. (usePlugin: false), (runInC: true or false) Have fun!! Stephan Rudlof (sr@evolgo.de) "! --------------0DC1F2341DD6E477001721FA--