[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