[Vm-dev] VM Maker: VMMaker.oscog-eem.1779.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Apr 8 00:27:36 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1779.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1779
Author: eem
Time: 7 April 2016, 5:26:14.093395 pm
UUID: eb3139fc-9d6f-432c-83b9-099675dcb37d
Ancestors: VMMaker.oscog-eem.1778
Fix simulation of the LargeIntegersPlugin. The issue is that interpreterProxy firstIndexableField: answers a CArray whose unitSize reflects the object's unit size, and becuase LargeIntegers are byte objects, the CArray is a byte accssor by default. So add InterpreterPlugin>>firstIndexableField:as:, which uses cCoerce:to: to provide a CArray typed as requested, and use it everywhere the LargeIntegersPlugin takes the firstIndexableField of a LargeInteger, and cast to #'unsigned int *'.
Go some way to speed up the warppers by
a) improving CArray>at:[put:] to assume unitSize is a suitable power of two, and
b) add CFloatArray to access float or double
Later on we can add CUnsignedIntegerArray, as required.
N.B. While this fixes simulation of the LargeIntegerPlugin there is still something wrong under simulation in whatever produces large fonts. Start up the Squeak 5.0 release image with the "Squeak 5.0 Release Notes" text in huge letters in a workspace towards the front and you'll notice that in the simulator none of the large fonts are displayed, although the text from "Fast Become" works fine.
=============== Diff against VMMaker.oscog-eem.1778 ===============
Item was changed:
----- Method: CArray>>at: (in category 'accessing') -----
at: offset
+ | address |
+ address := unitSize * offset + self ptrAddress.
+ ^unitSize <= 2
+ ifTrue:
+ [unitSize = 1
+ ifTrue: [interpreter byteAt: address]
+ ifFalse: [interpreter shortAt: address]]
+ ifFalse:
+ [unitSize = 4
+ ifTrue: [interpreter long32At: address]
+ ifFalse: [interpreter long64At: address]]!
- | ptrAddress |
- ptrAddress := self ptrAddress.
- unitSize = 1 ifTrue: [^ interpreter byteAt: ptrAddress + offset].
- unitSize = 2 ifTrue: [^ interpreter shortAt: ptrAddress + (offset * 2)].
- unitSize = 4 ifTrue: [^ interpreter long32At: ptrAddress + (offset * 4)].
- unitSize = 8 ifTrue: [^ interpreter long64At: ptrAddress + (offset * 8)].
- self halt: 'Can''t handle unitSize ', unitSize printString!
Item was changed:
----- Method: CArray>>at:put: (in category 'accessing') -----
at: offset put: val
+ | address |
+ address := unitSize * offset + self ptrAddress.
+ ^unitSize <= 2
+ ifTrue:
+ [unitSize = 1
+ ifTrue: [interpreter byteAt: address put: val]
+ ifFalse: [interpreter shortAt: address put: val]]
+ ifFalse:
+ [unitSize = 4
+ ifTrue: [interpreter long32At: address put: val]
+ ifFalse: [interpreter long64At: address put: val]]!
- | ptrAddress |
- ptrAddress := self ptrAddress.
- unitSize = 1 ifTrue: [^ interpreter byteAt: ptrAddress + offset put: val].
- unitSize = 2 ifTrue: [^ interpreter byteAt: ptrAddress + (offset * 2) put: val].
- unitSize = 4 ifTrue: [^ interpreter long32At: ptrAddress + (offset * 4) put: val].
- unitSize = 8 ifTrue: [^ interpreter long64At: ptrAddress + (offset * 8) put: val].
- self halt: 'Can''t handle unitSize ', unitSize printString!
Item was changed:
----- Method: CArray>>interpreter:address:unitSize: (in category 'private') -----
interpreter: interpreterSimulator address: arrayAddress unitSize: numBytes
interpreter := interpreterSimulator.
arrayBaseAddress := arrayAddress.
+ self unitSize: numBytes.
+ ptrOffset := 0!
- unitSize := numBytes.
- ptrOffset := 0.
- !
Item was changed:
----- Method: CArray>>unitSize: (in category 'accessing') -----
unitSize: n
+ (n isPowerOfTwo and: [n <= 8]) ifFalse:
+ [self error: 'unitSize must be 1, 2, 4 or 8'].
unitSize := n!
Item was added:
+ CArray subclass: #CFloatArray
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-InterpreterSimulation'!
+
+ !CFloatArray commentStamp: 'eem 4/7/2016 09:39' prior: 0!
+ A CFloatArray is a subclass of CArray that provides access via C float or double values!
Item was added:
+ ----- Method: CFloatArray>>at: (in category 'accessing') -----
+ at: offset
+ | address |
+ address := unitSize * offset + self ptrAddress.
+ ^unitSize >= 4
+ ifTrue:
+ [unitSize = 4
+ ifTrue: [Float fromIEEE32Bit: (interpreter long32At: address)]
+ ifFalse: [Float fromIEEE64BitWord: (interpreter long64At: address)]]
+ ifFalse:
+ [self error: 'unitSize must be 4 or 8']!
Item was added:
+ ----- Method: CFloatArray>>at:put: (in category 'accessing') -----
+ at: offset put: val
+ | address |
+ address := unitSize * offset + self ptrAddress.
+ ^unitSize >= 4
+ ifTrue:
+ [unitSize = 4
+ ifTrue: [interpreter long32At: address put: val]
+ ifFalse: [interpreter long64At: address put: val]]
+ ifFalse:
+ [self error: 'unitSize must be 4 or 8']!
Item was changed:
----- Method: Integer>>coerceTo:sim: (in category '*VMMaker-interpreter simulator') -----
coerceTo: cTypeString sim: interpreter
| unitSize |
cTypeString last = $* ifTrue: "C pointer"
[unitSize := cTypeString caseOf: {
['char *'] -> [1].
['short *'] -> [2].
['int *'] -> [4].
+ ['float *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 4; yourself].
+ ['double *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 8; yourself].
- ['long *'] -> [interpreter wordSize].
- ['float *'] -> [4].
- ['double *'] -> [8].
['unsigned *'] -> [4].
['unsigned int *'] -> [4].
+ ['unsigned char *'] -> [1].
+ ['signed char *'] -> [1].
+ ['unsigned short *'] -> [2].
- ['unsigned char *'] -> [4].
- ['unsigned short *'] -> [4].
['oop *'] -> [interpreter bytesPerOop].
}
+ otherwise: [interpreter wordSize].
- otherwise: [ (cTypeString beginsWith: 'char') ifTrue: [1] ifFalse: [interpreter wordSize] ].
^CArray basicNew
interpreter: interpreter address: self unitSize: unitSize;
yourself].
+ ^self "C number (int, char, float, etc)"!
- ^ self "C number (int, char, float, etc)"!
Item was added:
+ ----- Method: InterpreterPlugin>>firstIndexableField:as: (in category 'casting support') -----
+ firstIndexableField: obj as: cType
+ <inline: true>
+ ^interpreterProxy cCoerce: (interpreterProxy firstIndexableField: obj) to: cType!
Item was changed:
----- Method: LargeIntegersPlugin>>createLargeFromSmallInteger: (in category 'oop util') -----
createLargeFromSmallInteger: anOop
"anOop has to be a SmallInteger!!"
| val res pDigit byteSize digitSize |
<var: #pDigit type: #'unsigned int *'>
val := interpreterProxy integerValueOf: anOop.
byteSize := self byteSizeOfCSI: val.
res := self createLargeIntegerNeg: val < 0 byteLength: byteSize.
+ pDigit := self firstIndexableField: res as: #'unsigned int *'.
- pDigit := interpreterProxy firstIndexableField: res.
digitSize := byteSize + 3 // 4.
1 to: digitSize do: [:ix | self cDigitOf: pDigit at: ix - 1 put: (self digitOfCSI: val at: ix)].
^ res!
Item was changed:
----- Method: LargeIntegersPlugin>>digit:Lshift: (in category 'oop functions') -----
digit: anOop Lshift: shiftCount
"Attention: this method invalidates all oop's!! Only newOop is valid at return."
"Does not normalize."
| newOop highBit newDigitLen newByteLen oldDigitLen |
oldDigitLen := self digitSizeOfLargeInt: anOop.
+ (highBit := self cDigitHighBit: (self firstIndexableField: anOop as: #'unsigned int *')
- (highBit := self cDigitHighBit: (interpreterProxy firstIndexableField: anOop)
len: oldDigitLen) = 0 ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop) indexableSize: 1].
newByteLen := highBit + shiftCount + 7 // 8.
self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop)
indexableSize: newByteLen].
newDigitLen := newByteLen + 3 // 4.
self
cDigitLshift: shiftCount
+ from: (self firstIndexableField: anOop as: #'unsigned int *')
- from: (interpreterProxy firstIndexableField: anOop)
len: oldDigitLen
+ to: (self firstIndexableField: newOop as: #'unsigned int *')
- to: (interpreterProxy firstIndexableField: newOop)
len: newDigitLen.
^ newOop!
Item was changed:
----- Method: LargeIntegersPlugin>>digit:Rshift:lookfirst: (in category 'oop functions') -----
digit: anOop Rshift: shiftCount lookfirst: a
"Attention: this method invalidates all oop's!! Only newBytes is valid at return."
"Shift right 32*digitShift+bitShift bits, 0<=bitShift<32.
Discard all digits beyond a, and all zeroes at or below a."
"Does not normalize."
| newByteLen newOop oldBitLen newBitLen oldDigitLen newDigitLen |
+ oldBitLen := self cDigitHighBit: (self firstIndexableField: anOop as: #'unsigned int *') len: a.
- oldBitLen := self cDigitHighBit: (interpreterProxy firstIndexableField: anOop) len: a.
oldDigitLen := oldBitLen + 31 // 32.
newBitLen := oldBitLen - shiftCount.
newBitLen <= 0 ifTrue: ["All bits lost"
^ interpreterProxy
instantiateClass: (interpreterProxy fetchClassOf: anOop)
indexableSize: 0].
newByteLen := newBitLen + 7 // 8.
newDigitLen := newByteLen + 3 // 4.
self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop)
indexableSize: newByteLen].
self
cDigitRshift: shiftCount
+ from: (self firstIndexableField: anOop as: #'unsigned int *')
- from: (interpreterProxy firstIndexableField: anOop)
len: oldDigitLen
+ to: (self firstIndexableField: newOop as: #'unsigned int *')
- to: (interpreterProxy firstIndexableField: newOop)
len: newDigitLen.
^ newOop!
Item was changed:
----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') -----
digitAddLarge: firstInteger with: secondInteger
"Does not need to normalize!!"
| over firstDigitLen secondDigitLen shortInt shortDigitLen longInt longDigitLen sum newSum neg |
<var: #over type: #'unsigned int'>
firstDigitLen := self digitSizeOfLargeInt: firstInteger.
secondDigitLen := self digitSizeOfLargeInt: secondInteger.
neg := (interpreterProxy fetchClassOf: firstInteger)
= interpreterProxy classLargeNegativeInteger.
firstDigitLen <= secondDigitLen
ifTrue:
[shortInt := firstInteger.
shortDigitLen := firstDigitLen.
longInt := secondInteger.
longDigitLen := secondDigitLen]
ifFalse:
[shortInt := secondInteger.
shortDigitLen := secondDigitLen.
longInt := firstInteger.
longDigitLen := firstDigitLen].
" sum := Integer new: len neg: firstInteger negative."
self remapOop: #(shortInt longInt ) in: [sum := self createLargeIntegerNeg: neg digitLength: longDigitLen].
over := self
+ cDigitAdd: (self firstIndexableField: shortInt as: #'unsigned int *')
- cDigitAdd: (interpreterProxy firstIndexableField: shortInt)
len: shortDigitLen
+ with: (self firstIndexableField: longInt as: #'unsigned int *')
- with: (interpreterProxy firstIndexableField: longInt)
len: longDigitLen
+ into: (self firstIndexableField: sum as: #'unsigned int *').
- into: (interpreterProxy firstIndexableField: sum).
over > 0
ifTrue:
["sum := sum growby: 1."
self remapOop: sum in: [newSum := self createLargeIntegerNeg: neg byteLength: longDigitLen * 4 + 1].
self
+ cDigitCopyFrom: (self firstIndexableField: sum as: #'unsigned int *')
+ to: (self firstIndexableField: newSum as: #'unsigned int *')
- cDigitCopyFrom: (interpreterProxy firstIndexableField: sum)
- to: (interpreterProxy firstIndexableField: newSum)
len: longDigitLen.
sum := newSum.
"C index!!"
+ self cDigitOf: (self firstIndexableField: sum as: #'unsigned int *')
- self cDigitOf: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: sum) to: 'unsigned int *')
at: longDigitLen put: over]
ifFalse:
[sum := neg
ifTrue: [self normalizeNegative: sum]
ifFalse: [self normalizePositive: sum]].
^ sum!
Item was changed:
----- Method: LargeIntegersPlugin>>digitBitLogic:with:opIndex: (in category 'oop functions') -----
digitBitLogic: firstInteger with: secondInteger opIndex: opIx
"Bit logic here is only implemented for positive integers or Zero;
if rec or arg is negative, it fails."
| firstLarge secondLarge firstLen secondLen shortLen shortLarge longLen longLarge result |
(interpreterProxy isIntegerObject: firstInteger)
ifTrue:
[(interpreterProxy integerValueOf: firstInteger)
< 0 ifTrue: [^ interpreterProxy primitiveFail].
"convert it to a not normalized LargeInteger"
self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse:
[(interpreterProxy fetchClassOf: firstInteger)
= interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail].
firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
ifTrue:
[(interpreterProxy integerValueOf: secondInteger)
< 0 ifTrue: [^ interpreterProxy primitiveFail].
"convert it to a not normalized LargeInteger"
self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse:
[(interpreterProxy fetchClassOf: secondInteger)
= interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail].
secondLarge := secondInteger].
firstLen := self byteSizeOfLargeInt: firstLarge.
secondLen := self byteSizeOfLargeInt: secondLarge.
firstLen < secondLen
ifTrue:
[shortLen := firstLen.
shortLarge := firstLarge.
longLen := secondLen.
longLarge := secondLarge]
ifFalse:
[shortLen := secondLen.
shortLarge := secondLarge.
longLen := firstLen.
longLarge := firstLarge].
self remapOop: #(shortLarge longLarge ) in: [result := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: longLen].
self
cDigitOp: opIx
+ short: (self firstIndexableField: shortLarge as: #'unsigned int *')
- short: (interpreterProxy firstIndexableField: shortLarge)
len: shortLen + 3 // 4
+ long: (self firstIndexableField: longLarge as: #'unsigned int *')
- long: (interpreterProxy firstIndexableField: longLarge)
len: longLen + 3 // 4
+ into: (self firstIndexableField: result as: #'unsigned int *').
- into: (interpreterProxy firstIndexableField: result).
interpreterProxy failed ifTrue: [^ 0].
^ self normalizePositive: result!
Item was changed:
----- Method: LargeIntegersPlugin>>digitCompareLarge:with: (in category 'oop functions') -----
digitCompareLarge: firstInteger with: secondInteger
"Compare the magnitude of firstInteger with that of secondInteger.
Return a code of 1, 0, -1 for firstInteger >, = , < secondInteger"
| firstDigitLen secondDigitLen |
firstDigitLen := self digitSizeOfLargeInt: firstInteger.
secondDigitLen := self digitSizeOfLargeInt: secondInteger.
secondDigitLen ~= firstDigitLen
ifTrue: [secondDigitLen > firstDigitLen
ifTrue: [^ -1 asOop: SmallInteger]
ifFalse: [^ 1 asOop: SmallInteger]].
^ (self
+ cDigitCompare: (self firstIndexableField: firstInteger as: #'unsigned int *')
+ with: (self firstIndexableField: secondInteger as: #'unsigned int *')
- cDigitCompare: (interpreterProxy firstIndexableField: firstInteger)
- with: (interpreterProxy firstIndexableField: secondInteger)
len: firstDigitLen)
asOop: SmallInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>digitDivLarge:with:negative: (in category 'oop functions') -----
digitDivLarge: firstInteger with: secondInteger negative: neg
"Does not normalize."
"Division by zero has to be checked in caller."
| firstDigitLen secondDigitLen quoDigitLen d div rem quo result |
firstDigitLen := self digitSizeOfLargeInt: firstInteger.
secondDigitLen := self digitSizeOfLargeInt: secondInteger.
quoDigitLen := firstDigitLen - secondDigitLen + 1.
quoDigitLen <= 0
ifTrue:
[self remapOop: firstInteger in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
result stAt: 1 put: (0 asOop: SmallInteger).
result stAt: 2 put: firstInteger.
^ result].
"set rem and div to copies of firstInteger and secondInteger, respectively.
However,
to facilitate use of Knuth's algorithm, multiply rem and div by 2 (that
is, shift)
until the high word of div is >=16r80000000"
d := 32 - (self cHighBit32: (self unsafeDigitOfLargeInt: secondInteger at: secondDigitLen)).
self remapOop: firstInteger
in:
[div := self digit: secondInteger Lshift: d.
div := self largeInt: div growTo: (self digitSizeOfLargeInt: div) + 1 * 4].
self remapOop: div
in:
[rem := self digit: firstInteger Lshift: d.
(self digitSizeOfLargeInt: rem) = firstDigitLen
ifTrue: [rem := self largeInt: rem growTo: firstDigitLen + 1 * 4]].
self remapOop: #(div rem ) in: [quo := self createLargeIntegerNeg: neg digitLength: quoDigitLen].
self
+ cDigitDiv: (self firstIndexableField: div as: #'unsigned int *')
- cDigitDiv: (interpreterProxy firstIndexableField: div)
len: (self digitSizeOfLargeInt: div)
+ rem: (self firstIndexableField: rem as: #'unsigned int *')
- rem: (interpreterProxy firstIndexableField: rem)
len: (self digitSizeOfLargeInt: rem)
+ quo: (self firstIndexableField: quo as: #'unsigned int *')
- quo: (interpreterProxy firstIndexableField: quo)
len: (self digitSizeOfLargeInt: quo).
self remapOop: #(quo ) in: [rem := self
digit: rem
Rshift: d
lookfirst: (self digitSizeOfLargeInt: div)
- 1].
"^ Array with: quo with: rem"
self remapOop: #(quo rem ) in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
result stAt: 1 put: quo.
result stAt: 2 put: rem.
^ result!
Item was changed:
----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') -----
digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv
<var: #mInv type: #'unsigned int'>
| firstLen secondLen thirdLen prod |
firstLen := self digitSizeOfLargeInt: firstLarge.
secondLen := self digitSizeOfLargeInt: secondLarge.
thirdLen := self digitSizeOfLargeInt: thirdLarge.
+ (firstLen <= thirdLen and: [secondLen <= thirdLen]) ifFalse: [^interpreterProxy primitiveFail].
+ self remapOop: #(firstLarge secondLarge thirdLarge)
+ in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen * 4].
- firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
- secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
- self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen * 4].
self
+ cDigitMontgomery: (self firstIndexableField: firstLarge as: #'unsigned int *')
+ len: firstLen
+ times: (self firstIndexableField: secondLarge as: #'unsigned int *')
+ len: secondLen
+ modulo: (self firstIndexableField: thirdLarge as: #'unsigned int *')
+ len: thirdLen
+ mInvModB: mInv
+ into: (self firstIndexableField: prod as: #'unsigned int *').
- cDigitMontgomery: (interpreterProxy firstIndexableField: firstLarge)
- len: firstLen
- times: (interpreterProxy firstIndexableField: secondLarge)
- len: secondLen
- modulo: (interpreterProxy firstIndexableField: thirdLarge)
- len: thirdLen
- mInvModB: mInv
- into: (interpreterProxy firstIndexableField: prod).
^self normalizePositive: prod!
Item was changed:
----- Method: LargeIntegersPlugin>>digitMultiplyLarge:with:negative: (in category 'oop functions') -----
digitMultiplyLarge: firstInteger with: secondInteger negative: neg
"Normalizes."
| firstLen secondLen shortInt shortLen longInt longLen prod |
firstLen := self byteSizeOfLargeInt: firstInteger.
secondLen := self byteSizeOfLargeInt: secondInteger.
firstLen <= secondLen
ifTrue:
[shortInt := firstInteger.
shortLen := firstLen.
longInt := secondInteger.
longLen := secondLen]
ifFalse:
[shortInt := secondInteger.
shortLen := secondLen.
longInt := firstInteger.
longLen := firstLen].
+ self remapOop: #(shortInt longInt) in: [prod := self createLargeIntegerNeg: neg byteLength: longLen + shortLen].
- self remapOop: #(shortInt longInt ) in: [prod := self createLargeIntegerNeg: neg byteLength: longLen + shortLen].
self
+ cDigitMultiply: (self firstIndexableField: shortInt as: #'unsigned int *')
- cDigitMultiply: (interpreterProxy firstIndexableField: shortInt)
len: shortLen + 3 // 4
+ with: (self firstIndexableField: longInt as: #'unsigned int *')
- with: (interpreterProxy firstIndexableField: longInt)
len: longLen + 3 // 4
+ into: (self firstIndexableField: prod as: #'unsigned int *')
- into: (interpreterProxy firstIndexableField: prod)
len: longLen + shortLen + 3 // 4.
^neg
ifTrue: [self normalizeNegative: prod]
ifFalse: [self normalizePositive: prod]!
Item was changed:
----- Method: LargeIntegersPlugin>>digitSubLarge:with: (in category 'oop functions') -----
digitSubLarge: firstInteger with: secondInteger
"Normalizes."
| firstDigitLen secondDigitLen larger largeDigitLen smaller smallerDigitLen neg resDigitLen res firstNeg |
firstNeg := (interpreterProxy fetchClassOf: firstInteger)
= interpreterProxy classLargeNegativeInteger.
firstDigitLen := self digitSizeOfLargeInt: firstInteger.
secondDigitLen := self digitSizeOfLargeInt: secondInteger.
firstDigitLen = secondDigitLen ifTrue:
[[firstDigitLen > 1
and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) = (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]]
whileTrue: [firstDigitLen := firstDigitLen - 1].
secondDigitLen := firstDigitLen].
(firstDigitLen < secondDigitLen
or: [firstDigitLen = secondDigitLen
and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) < (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]])
ifTrue:
[larger := secondInteger.
largeDigitLen := secondDigitLen.
smaller := firstInteger.
smallerDigitLen := firstDigitLen.
neg := firstNeg == false]
ifFalse:
[larger := firstInteger.
largeDigitLen := firstDigitLen.
smaller := secondInteger.
smallerDigitLen := secondDigitLen.
neg := firstNeg].
resDigitLen := largeDigitLen.
self remapOop: #(smaller larger)
in: [res := self createLargeIntegerNeg: neg digitLength: resDigitLen].
self
+ cDigitSub: (self firstIndexableField: smaller as: #'unsigned int *')
- cDigitSub: (interpreterProxy firstIndexableField: smaller)
len: smallerDigitLen
+ with: (self firstIndexableField: larger as: #'unsigned int *')
- with: (interpreterProxy firstIndexableField: larger)
len: largeDigitLen
+ into: (self firstIndexableField: res as: #'unsigned int *').
- into: (interpreterProxy firstIndexableField: res).
^neg
ifTrue: [self normalizeNegative: res]
ifFalse: [self normalizePositive: res]!
Item was changed:
----- Method: LargeIntegersPlugin>>highBitOfLargeInt: (in category 'util') -----
highBitOfLargeInt: anOop
<inline: true>
^ self
+ cDigitHighBit: (self firstIndexableField: anOop as: #'unsigned int *')
- cDigitHighBit: (interpreterProxy firstIndexableField: anOop)
len: (self digitSizeOfLargeInt: anOop)!
Item was changed:
----- Method: LargeIntegersPlugin>>largeInt:growTo: (in category 'oop util') -----
largeInt: aBytesObject growTo: newByteLen
"Attention: this method invalidates all oop's!! Only newBytes is valid at return."
"Does not normalize."
| newBytes oldDigitLen newDigitLen copyLen |
self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject)
indexableSize: newByteLen].
newDigitLen := newByteLen + 3 // 4.
oldDigitLen := self digitSizeOfLargeInt: aBytesObject.
+ copyLen := oldDigitLen < newDigitLen
+ ifTrue: [oldDigitLen]
+ ifFalse: [newDigitLen].
- oldDigitLen < newDigitLen
- ifTrue: [copyLen := oldDigitLen]
- ifFalse: [copyLen := newDigitLen].
self
+ cDigitCopyFrom: (self firstIndexableField: aBytesObject as: #'unsigned int *')
+ to: (self firstIndexableField: newBytes as: #'unsigned int *')
- cDigitCopyFrom: (interpreterProxy firstIndexableField: aBytesObject)
- to: (interpreterProxy firstIndexableField: newBytes)
len: copyLen.
+ ^newBytes!
- ^ newBytes!
Item was changed:
----- Method: LargeIntegersPlugin>>unsafeByteOfLargeInt:at: (in category 'util') -----
unsafeByteOfLargeInt: bytesObj at: ix
"Argument bytesObj must not be aSmallInteger!!"
<inline: true>
<returnTypeC: #'unsigned char'>
+ ^(self firstIndexableField: bytesObj as: #'unsigned char *') at: ix - 1!
- ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1!
Item was changed:
----- Method: LargeIntegersPlugin>>unsafeDigitOfLargeInt:at: (in category 'util') -----
unsafeDigitOfLargeInt: anOop at: ix
"Argument must not be aSmallInteger!!"
<inline: true>
<returnTypeC: #'unsigned int'>
+ ^self cDigitOf: (self firstIndexableField: anOop as: #'unsigned int *') at: ix - 1!
- ^self cDigitOf: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: anOop) to: #'unsigned int *') at: ix - 1!
More information about the Vm-dev
mailing list