[Vm-dev] VM Maker: VMMaker.oscog-eem.1779.mcz
Nicolas Cellier
nicolas.cellier.aka.nice at gmail.com
Fri Apr 8 06:50:41 UTC 2016
2016-04-08 2:26 GMT+02:00 <commits at source.squeak.org>:
>
> 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].
>
Hi Eliot,
I presume you suppressed long * and do not need unsigned long * because
they are handled in otherwise.
But there's also no (unsigned) long long * / (u)sqLong *
We never coerce to these types (or only inside cCode: []), or this is
handled elsewhere?
> - ['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!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20160408/af36ad90/attachment-0001.htm
More information about the Vm-dev
mailing list