[Vm-dev] VM Maker: VMMaker.oscog-nice.1742.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Mar 25 23:14:05 UTC 2016
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1742.mcz
==================== Summary ====================
Name: VMMaker.oscog-nice.1742
Author: nice
Time: 26 March 2016, 12:08:11.776 am
UUID: 12c26a42-336a-4a56-a44f-a9a97fc3d43e
Ancestors: VMMaker.oscog-cb.1741
Refactor LargeIntegers in order to prepare the avent of digits larger than 8 bits.
Most of these refactorings are already applied in classic interpreter VMMaker branch.
Half message were named #bytesOp, the other #digitOp...
Homogenize all message names as #digitOp.
Also homogenize C core message names #cCoreBytes #cCoreDigit #cBytes -> #cDigit...
Rename the rest of #bytes message (whose purpose is to operate on bytesObjects) -> #largeInt (whose effective use is to operate on largeIntegerObjects). This makes the intention a bit clearer.
Remove unused #negative:
Remove debugging stub #think
=============== Diff against VMMaker.oscog-cb.1741 ===============
Item was removed:
- ----- Method: LargeIntegersPlugin>>anyBitOfBytes:from:to: (in category 'util') -----
- anyBitOfBytes: aBytesOop from: start to: stopArg
- "Argument has to be aBytesOop!!"
- "Tests for any magnitude bits in the interval from start to stopArg."
- | magnitude rightShift leftShift stop firstByteIx lastByteIx |
- self
- debugCode: [self msg: 'anyBitOfBytes: aBytesOop from: start to: stopArg'].
- start < 1 | (stopArg < 1)
- ifTrue: [^ interpreterProxy primitiveFail].
- magnitude := aBytesOop.
- stop := stopArg
- min: (self highBitOfBytes: magnitude).
- start > stop
- ifTrue: [^ false].
- firstByteIx := start - 1 // 8 + 1.
- lastByteIx := stop - 1 // 8 + 1.
- rightShift := (start - 1 \\ 8).
- leftShift := 7 - (stop - 1 \\ 8).
- firstByteIx = lastByteIx
- ifTrue: [| digit mask |
- mask := (255 << rightShift) bitAnd: (255 >> leftShift).
- digit := self digitOfBytes: magnitude at: firstByteIx.
- ^ (digit bitAnd: mask)
- ~= 0].
- ((self digitOfBytes: magnitude at: firstByteIx)
- >> rightShift)
- ~= 0
- ifTrue: [^ true].
- firstByteIx + 1
- to: lastByteIx - 1
- do: [:ix | (self digitOfBytes: magnitude at: ix)
- ~= 0
- ifTrue: [^ true]].
- (((self digitOfBytes: magnitude at: lastByteIx)
- << leftShift)
- bitAnd: 255)
- ~= 0
- ifTrue: [^ true].
- ^ false!
Item was added:
+ ----- Method: LargeIntegersPlugin>>anyBitOfLargeInt:from:to: (in category 'util') -----
+ anyBitOfLargeInt: aBytesOop from: start to: stopArg
+ "Argument has to be aBytesOop!!"
+ "Tests for any magnitude bits in the interval from start to stopArg."
+ | magnitude rightShift leftShift stop firstByteIx lastByteIx |
+ self
+ debugCode: [self msg: 'anyBitOfLargeInt: aBytesOop from: start to: stopArg'].
+ start < 1 | (stopArg < 1)
+ ifTrue: [^ interpreterProxy primitiveFail].
+ magnitude := aBytesOop.
+ stop := stopArg
+ min: (self highBitOfLargeInt: magnitude).
+ start > stop
+ ifTrue: [^ false].
+ firstByteIx := start - 1 // 8 + 1.
+ lastByteIx := stop - 1 // 8 + 1.
+ rightShift := (start - 1 \\ 8).
+ leftShift := 7 - (stop - 1 \\ 8).
+ firstByteIx = lastByteIx
+ ifTrue: [| digit mask |
+ mask := (255 << rightShift) bitAnd: (255 >> leftShift).
+ digit := self digitOfLargeInt: magnitude at: firstByteIx.
+ ^ (digit bitAnd: mask)
+ ~= 0].
+ ((self digitOfLargeInt: magnitude at: firstByteIx)
+ >> rightShift)
+ ~= 0
+ ifTrue: [^ true].
+ firstByteIx + 1
+ to: lastByteIx - 1
+ do: [:ix | (self digitOfLargeInt: magnitude at: ix)
+ ~= 0
+ ifTrue: [^ true]].
+ (((self digitOfLargeInt: magnitude at: lastByteIx)
+ << leftShift)
+ bitAnd: 255)
+ ~= 0
+ ifTrue: [^ true].
+ ^ false!
Item was removed:
- ----- Method: LargeIntegersPlugin>>byteSizeOfBytes: (in category 'util') -----
- byteSizeOfBytes: bytesOop
- "Precondition: bytesOop is not anInteger and a bytes object."
- "Function #byteSizeOf: is used by the interpreter, be careful with name
- clashes..."
- ^ interpreterProxy slotSizeOf: bytesOop!
Item was removed:
- ----- Method: LargeIntegersPlugin>>bytes:Lshift: (in category 'oop functions') -----
- bytes: aBytesOop Lshift: shiftCount
- "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
- "Does not normalize."
- | newBytes highBit newLen oldLen |
- oldLen := self byteSizeOfBytes: aBytesOop.
- (highBit := self cBytesHighBit: (interpreterProxy firstIndexableField: aBytesOop)
- len: oldLen) = 0 ifTrue: [^ 0 asOop: SmallInteger].
- newLen := highBit + shiftCount + 7 // 8.
- self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
- indexableSize: newLen].
- self
- cBytesLshift: shiftCount
- from: (interpreterProxy firstIndexableField: aBytesOop)
- len: oldLen
- to: (interpreterProxy firstIndexableField: newBytes)
- len: newLen.
- ^ newBytes!
Item was removed:
- ----- Method: LargeIntegersPlugin>>bytes:Rshift:bytes:lookfirst: (in category 'oop functions') -----
- 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."
- | x f digit i oldLen newLen newBytes |
- x := 0.
- f := 8 - anInteger.
- i := a.
- digit := self digitOfBytes: aBytesOop at: i.
- [((digit >> anInteger)
- bitOr: x)
- = 0 and: [i ~= 1]]
- whileTrue:
- [x := digit << f.
- "Can't exceed 8 bits"
- i := i - 1.
- digit := self digitOfBytes: aBytesOop at: i].
- i <= b ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
- indexableSize: 0"Integer new: 0 neg: self negative"].
- "All bits lost"
- oldLen := self byteSizeOfBytes: aBytesOop.
- newLen := i - b.
- self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
- indexableSize: newLen].
- "r := Integer new: i - b neg: self negative."
- " count := i.
- "
- self
- cCoreBytesRshiftCount: i
- n: anInteger
- f: f
- bytes: b
- from: (interpreterProxy firstIndexableField: aBytesOop)
- len: oldLen
- to: (interpreterProxy firstIndexableField: newBytes)
- len: newLen.
- ^ newBytes!
Item was removed:
- ----- Method: LargeIntegersPlugin>>bytes:growTo: (in category 'oop util') -----
- bytes: aBytesObject growTo: newLen
- "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
- "Does not normalize."
- | newBytes oldLen copyLen |
- self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject)
- indexableSize: newLen].
- oldLen := self byteSizeOfBytes: aBytesObject.
- oldLen < newLen
- ifTrue: [copyLen := oldLen]
- ifFalse: [copyLen := newLen].
- self
- cBytesCopyFrom: (interpreterProxy firstIndexableField: aBytesObject)
- to: (interpreterProxy firstIndexableField: newBytes)
- len: copyLen.
- ^ newBytes!
Item was removed:
- ----- Method: LargeIntegersPlugin>>bytesOrInt:growTo: (in category 'oop util') -----
- bytesOrInt: oop growTo: len
- "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
- | newBytes val class |
- (interpreterProxy isIntegerObject: oop)
- ifTrue:
- [val := interpreterProxy integerValueOf: oop.
- val < 0
- ifTrue: [class := interpreterProxy classLargeNegativeInteger]
- ifFalse: [class := interpreterProxy classLargePositiveInteger].
- newBytes := interpreterProxy instantiateClass: class indexableSize: len.
- self cCopyIntVal: val toBytes: newBytes]
- ifFalse: [newBytes := self bytes: oop growTo: len].
- ^ newBytes!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cByteOp:short:len:long:len:into: (in category 'C core') -----
- cByteOp: opIndex short: pByteShort len: shortLen long: pByteLong len: longLen into: pByteRes
- "pByteRes len = longLen."
- | limit |
- <var: #pByteShort type: 'unsigned char * '>
- <var: #pByteLong type: 'unsigned char * '>
- <var: #pByteRes type: 'unsigned char * '>
- limit := shortLen - 1.
- opIndex = andOpIndex
- ifTrue:
- [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
- bitAnd: (pByteLong at: i))].
- limit := longLen - 1.
- shortLen to: limit do: [:i | pByteRes at: i put: 0].
- ^ 0].
- opIndex = orOpIndex
- ifTrue:
- [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
- bitOr: (pByteLong at: i))].
- limit := longLen - 1.
- shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)].
- ^ 0].
- opIndex = xorOpIndex
- ifTrue:
- [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
- bitXor: (pByteLong at: i))].
- limit := longLen - 1.
- shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)].
- ^ 0].
- ^ interpreterProxy primitiveFail!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cBytesCopyFrom:to:len: (in category 'C core util') -----
- cBytesCopyFrom: pFrom to: pTo len: len
- | limit |
- <returnTypeC: 'int'>
- <var: #pFrom type: 'unsigned char * '>
- <var: #pTo type: 'unsigned char * '>
-
- self cCode: '' inSmalltalk: [
- (interpreterProxy isKindOf: InterpreterSimulator) ifTrue: [
- "called from InterpreterSimulator"
- limit := len - 1.
- 0 to: limit do: [:i |
- interpreterProxy byteAt: pTo + i
- put: (interpreterProxy byteAt: pFrom + i)
- ].
- ^ 0
- ].
- ].
- limit := len - 1.
- 0 to: limit do: [:i | pTo at: i put: (pFrom at: i)].
- ^ 0!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cBytesHighBit:len: (in category 'C core util') -----
- cBytesHighBit: pByte len: len
- "Answer the index (in bits) 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 |
- <var: #pByte type: 'unsigned char * '>
- realLength := len.
- [(lastDigit := pByte at: realLength - 1) = 0]
- whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]].
- ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cBytesLshift:from:len:to:len: (in category 'C core') -----
- cBytesLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo
- "C indexed!!"
- | byteShift bitShift carry limit digit lastIx |
- <returnTypeC: 'int'>
- <var: #pTo type: 'unsigned char * '>
- <var: #pFrom type: 'unsigned char * '>
- 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].
-
- "This implementation use at most 15 bits of carry.
- bitAnd: 255 is only for simulator, useless in C"
- carry := 0.
- limit := byteShift - 1.
- 0 to: limit do: [:i | pTo at: i put: 0].
- limit := lenTo - byteShift - 2.
- self sqAssert: limit < lenFrom.
- 0 to: limit do:
- [:i |
- digit := pFrom at: i.
- carry := (carry >> 8) bitOr: (digit << bitShift).
- pTo at: i + byteShift put: (carry bitAnd: 255)].
- lastIx := limit + 1.
- lastIx > (lenFrom - 1)
- ifTrue: [digit := 0]
- ifFalse: [digit := pFrom at: lastIx].
- carry := (carry >> 8) bitOr: (digit << bitShift).
- pTo at: lastIx + byteShift put: (carry "bitAnd: 255").
- carry := carry >> 8.
- self sqAssert: carry = 0!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cBytesReplace:from:to:with:startingAt: (in category 'C core util') -----
- cBytesReplace: pTo from: start to: stop with: pFrom startingAt: repStart
- "C indexed!!"
- <returnTypeC: 'int'>
- <var: #pTo type: 'unsigned char * '>
- <var: #pFrom type: 'unsigned char * '>
- ^ self
- cBytesCopyFrom: pFrom + repStart
- to: pTo + start
- len: stop - start + 1!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cCoreBytesRshiftCount:n:f:bytes:from:len:to:len: (in category 'C core') -----
- cCoreBytesRshiftCount: count n: n f: f bytes: b from: pFrom len: fromLen to: pTo len: toLen
- | x digit |
- <var: #pTo type: 'unsigned char * '>
- <var: #pFrom type: 'unsigned char * '>
- self sqAssert: b < fromLen.
- n = 0 ifTrue: ["Fast version for byte-aligned shifts"
- "C indexed!!"
- ^self
- cBytesReplace: pTo
- from: 0
- to: toLen - 1
- with: pFrom
- startingAt: b].
-
- "This implementation use at most 16 bits of x"
- x := (pFrom at: b) << f.
- self sqAssert: count - 1 < fromLen.
- b + 1 to: count - 1 do:
- [:j |
- digit := pFrom at: j.
- x := (x >> 8) bitOr: (digit << f).
- pTo at: j - b - 1 put: (x bitAnd: 255)].
- count = fromLen
- ifTrue: [digit := 0]
- ifFalse: [digit := pFrom at: count].
- x := (x >> 8) bitOr: (digit << f).
- pTo at: count - b - 1 put: (x "bitAnd: 255")!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cCoreDigitDivDiv:len:rem:len:quo:len: (in category 'C core') -----
- cCoreDigitDivDiv: pDiv len: divLen rem: pRem len: remLen quo: pQuo len: quoLen
- | dl ql dh dnh j t hi lo r3 l a cond q r1r2 mul |
- <var: #pDiv type: #'unsigned char *'>
- <var: #pRem type: #'unsigned char *'>
- <var: #pQuo type: #'unsigned char *'>
- dl := divLen - 1.
- "Last actual byte of data (ST ix)"
- ql := quoLen.
- dh := pDiv at: dl - 1.
- dnh := dl = 1
- ifTrue: [0]
- ifFalse: [pDiv at: dl - 2].
- 1 to: ql do:
- [:k |
- "maintain quo*arg+rem=self"
- "Estimate rem/div by dividing the leading two bytes of rem by dh."
- "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles."
- "Nibbles are kicked off!! We use full 16 bits now, because we are in
- the year 2000 ;-) [sr]"
- j := remLen + 1 - k.
- "r1 := rem digitAt: j."
- (pRem at: j - 1) = dh
- ifTrue: [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 - 2)."
- r1r2 := ((pRem at: j - 1) bitShift: 8) + (pRem at: j - 2).
- t := r1r2 \\ dh.
- q := r1r2 // dh.
- "Next compute (hi,lo) := q*dnh"
- mul := q * dnh.
- hi := mul bitShift: -8.
- lo := mul 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)"
- q := q - 1.
- lo := lo - dnh.
- lo < 0
- ifTrue:
- [hi := hi - 1.
- lo := lo + 256].
- cond := hi >= dh]
- ifFalse: [cond := false].
- cond]
- whileTrue: [hi := hi - dh]].
- "Subtract q*div from rem"
- l := j - dl.
- a := 0.
- 1 to: divLen do:
- [:i |
- hi := (pDiv at: i - 1) * (q bitShift: -8).
- lo := a + (pRem at: l - 1) - ((pDiv at: i - 1) * (q bitAnd: 255)).
- pRem at: l - 1 put: (self cCode: [lo] inSmalltalk: [lo bitAnd: 255]).
- a := (lo signedBitShift: -8) - hi.
- l := l + 1].
- a < 0 ifTrue: "Add div back into rem, decrease q by 1"
- [q := q - 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: (self cCode: [a] inSmalltalk: [a bitAnd: 255]).
- l := l + 1]].
- pQuo at: quoLen - k put: q]!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitCopyFrom:to:len: (in category 'C core util') -----
+ cDigitCopyFrom: pFrom to: pTo len: len
+ | limit |
+ <returnTypeC: 'int'>
+ <var: #pFrom type: 'unsigned char * '>
+ <var: #pTo type: 'unsigned char * '>
+
+ self cCode: '' inSmalltalk: [
+ (interpreterProxy isKindOf: InterpreterSimulator) ifTrue: [
+ "called from InterpreterSimulator"
+ limit := len - 1.
+ 0 to: limit do: [:i |
+ interpreterProxy byteAt: pTo + i
+ put: (interpreterProxy byteAt: pFrom + i)
+ ].
+ ^ 0
+ ].
+ ].
+ limit := len - 1.
+ 0 to: limit do: [:i | pTo at: i put: (pFrom at: i)].
+ ^ 0
+ !
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitDiv:len:rem:len:quo:len: (in category 'C core') -----
+ cDigitDiv: pDiv len: divLen rem: pRem len: remLen quo: pQuo len: quoLen
+ | dl ql dh dnh j t hi lo r3 l a cond q r1r2 mul |
+ <var: #pDiv type: #'unsigned char *'>
+ <var: #pRem type: #'unsigned char *'>
+ <var: #pQuo type: #'unsigned char *'>
+ dl := divLen - 1.
+ "Last actual byte of data (ST ix)"
+ ql := quoLen.
+ dh := pDiv at: dl - 1.
+ dnh := dl = 1
+ ifTrue: [0]
+ ifFalse: [pDiv at: dl - 2].
+ 1 to: ql do:
+ [:k |
+ "maintain quo*arg+rem=self"
+ "Estimate rem/div by dividing the leading two bytes of rem by dh."
+ "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles."
+ "Nibbles are kicked off!! We use full 16 bits now, because we are in
+ the year 2000 ;-) [sr]"
+ j := remLen + 1 - k.
+ "r1 := rem digitAt: j."
+ (pRem at: j - 1) = dh
+ ifTrue: [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 - 2)."
+ r1r2 := ((pRem at: j - 1) bitShift: 8) + (pRem at: j - 2).
+ t := r1r2 \\ dh.
+ q := r1r2 // dh.
+ "Next compute (hi,lo) := q*dnh"
+ mul := q * dnh.
+ hi := mul bitShift: -8.
+ lo := mul 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)"
+ q := q - 1.
+ lo := lo - dnh.
+ lo < 0
+ ifTrue:
+ [hi := hi - 1.
+ lo := lo + 256].
+ cond := hi >= dh]
+ ifFalse: [cond := false].
+ cond]
+ whileTrue: [hi := hi - dh]].
+ "Subtract q*div from rem"
+ l := j - dl.
+ a := 0.
+ 1 to: divLen do:
+ [:i |
+ hi := (pDiv at: i - 1) * (q bitShift: -8).
+ lo := a + (pRem at: l - 1) - ((pDiv at: i - 1) * (q bitAnd: 255)).
+ pRem at: l - 1 put: (self cCode: [lo] inSmalltalk: [lo bitAnd: 255]).
+ a := (lo signedBitShift: -8) - hi.
+ l := l + 1].
+ a < 0 ifTrue: "Add div back into rem, decrease q by 1"
+ [q := q - 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: (self cCode: [a] inSmalltalk: [a bitAnd: 255]).
+ l := l + 1]].
+ pQuo at: quoLen - k put: q]!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitHighBit:len: (in category 'C core util') -----
+ cDigitHighBit: pByte len: len
+ "Answer the index (in bits) 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 |
+ <var: #pByte type: 'unsigned char * '>
+ realLength := len.
+ [(lastDigit := pByte at: realLength - 1) = 0]
+ whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]].
+ ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitLshift:from:len:to:len: (in category 'C core') -----
+ cDigitLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo
+ "C indexed!!"
+ | byteShift bitShift carry limit digit lastIx |
+ <returnTypeC: 'int'>
+ <var: #pTo type: 'unsigned char * '>
+ <var: #pFrom type: 'unsigned char * '>
+ byteShift := shiftCount // 8.
+ bitShift := shiftCount \\ 8.
+ bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts"
+ "C indexed!!"
+ ^ self
+ cDigitReplace: pTo
+ from: byteShift
+ to: lenTo - 1
+ with: pFrom
+ startingAt: 0].
+
+ "This implementation use at most 15 bits of carry.
+ bitAnd: 255 is only for simulator, useless in C"
+ carry := 0.
+ limit := byteShift - 1.
+ 0 to: limit do: [:i | pTo at: i put: 0].
+ limit := lenTo - byteShift - 2.
+ self sqAssert: limit < lenFrom.
+ 0 to: limit do:
+ [:i |
+ digit := pFrom at: i.
+ carry := (carry >> 8) bitOr: (digit << bitShift).
+ pTo at: i + byteShift put: (carry bitAnd: 255)].
+ lastIx := limit + 1.
+ lastIx > (lenFrom - 1)
+ ifTrue: [digit := 0]
+ ifFalse: [digit := pFrom at: lastIx].
+ carry := (carry >> 8) bitOr: (digit << bitShift).
+ pTo at: lastIx + byteShift put: (carry "bitAnd: 255").
+ carry := carry >> 8.
+ self sqAssert: carry = 0!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitMontgomery:len:times:len:modulo:len:mInvModB:into: (in category 'C core') -----
+ cDigitMontgomery: pBytesFirst
+ len: firstLen
+ times: pBytesSecond
+ len: secondLen
+ modulo: pBytesThird
+ len: thirdLen
+ mInvModB: mInv
+ into: pBytesRes
+
+ | u limit1 limit2 limit3 accum lastByte |
+ <var: #pBytesFirst type: #'unsigned char *'>
+ <var: #pBytesSecond type: #'unsigned char *'>
+ <var: #pBytesThird type: #'unsigned char *'>
+ <var: #pBytesRes type: #'unsigned char *'>
+ <var: #accum type: #usqInt>
+ <var: #u type: #'unsigned char'>
+ <var: #lastByte type: #'unsigned char'>
+ limit1 := firstLen - 1.
+ limit2 := secondLen - 1.
+ limit3 := thirdLen - 1.
+ lastByte := 0.
+ 0 to: limit1 do:
+ [:i |
+ accum := (pBytesRes at: 0) + ((pBytesFirst at: i)*(pBytesSecond at: 0)).
+ u := accum * mInv bitAnd: 255.
+ accum := accum + (u * (pBytesThird at: 0)).
+ 1 to: limit2 do: [:k |
+ accum := (accum >> 8) + (pBytesRes at: k) + ((pBytesFirst at: i)*(pBytesSecond at: k)) + (u * (pBytesThird at: k)).
+ pBytesRes at: k-1 put: (accum bitAnd: 255)].
+ secondLen to: limit3 do: [:k |
+ accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
+ pBytesRes at: k-1 put: (accum bitAnd: 255)].
+ accum := (accum >> 8) + lastByte.
+ pBytesRes at: limit3 put: (accum bitAnd: 255).
+ lastByte := accum >> 8].
+ firstLen to: limit3 do:
+ [:i |
+ accum := (pBytesRes at: 0).
+ u := accum * mInv bitAnd: 255.
+ accum := accum + (u * (pBytesThird at: 0)).
+ 1 to: limit3 do: [:k |
+ accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
+ pBytesRes at: k-1 put: (accum bitAnd: 255)].
+ accum := (accum >> 8) + lastByte.
+ pBytesRes at: limit3 put: (accum bitAnd: 255).
+ lastByte := accum >> 8].
+ (lastByte = 0 and: [(self cDigitCompare: pBytesThird with: pBytesRes len: thirdLen) = 1]) ifFalse: [
+ "self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes"
+ accum := 0.
+ 0 to: limit3 do:
+ [:i |
+ accum := accum + (pBytesRes at: i) - (pBytesThird at: i).
+ pBytesRes at: i put: (self cCode: [accum] inSmalltalk: [accum bitAnd: 255]).
+ accum := accum signedBitShift: -8]].!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitOp:short:len:long:len:into: (in category 'C core') -----
+ cDigitOp: opIndex short: pByteShort len: shortLen long: pByteLong len: longLen into: pByteRes
+ "pByteRes len = longLen."
+ | limit |
+ <var: #pByteShort type: 'unsigned char * '>
+ <var: #pByteLong type: 'unsigned char * '>
+ <var: #pByteRes type: 'unsigned char * '>
+ limit := shortLen - 1.
+ opIndex = andOpIndex
+ ifTrue:
+ [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
+ bitAnd: (pByteLong at: i))].
+ limit := longLen - 1.
+ shortLen to: limit do: [:i | pByteRes at: i put: 0].
+ ^ 0].
+ opIndex = orOpIndex
+ ifTrue:
+ [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
+ bitOr: (pByteLong at: i))].
+ limit := longLen - 1.
+ shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)].
+ ^ 0].
+ opIndex = xorOpIndex
+ ifTrue:
+ [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
+ bitXor: (pByteLong at: i))].
+ limit := longLen - 1.
+ shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)].
+ ^ 0].
+ ^ interpreterProxy primitiveFail!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitReplace:from:to:with:startingAt: (in category 'C core util') -----
+ cDigitReplace: pTo from: start to: stop with: pFrom startingAt: repStart
+ "C indexed!!"
+ <returnTypeC: 'int'>
+ <var: #pTo type: 'unsigned char * '>
+ <var: #pFrom type: 'unsigned char * '>
+ ^ self
+ cDigitCopyFrom: pFrom + repStart
+ to: pTo + start
+ len: stop - start + 1!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitRshift:from:len:to:len: (in category 'C core') -----
+ cDigitRshift: shiftCount from: pFrom len: fromLen to: pTo len: toLen
+ | digit bitShift carry digitShift leftShift limit start |
+ <var: #pTo type: 'unsigned char * '>
+ <var: #pFrom type: 'unsigned char * '>
+ <var: #carry type: 'unsigned int '>
+ <var: #digit type: 'unsigned int '>
+ digitShift := shiftCount // 8.
+ bitShift := shiftCount \\ 8.
+ bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts"
+ "C indexed!!"
+ ^self
+ cDigitReplace: pTo
+ from: 0
+ to: toLen - 1
+ with: pFrom
+ startingAt: digitShift].
+
+ "This implementation use at most 16 bits of x"
+ leftShift := 8 - bitShift.
+ carry := (pFrom at: digitShift) >> bitShift.
+ start := digitShift + 1.
+ limit := fromLen - 1.
+ start to: limit do:
+ [:j |
+ digit := pFrom at: j.
+ pTo at: j - start put: ((carry bitOr: digit << leftShift) bitAnd: 16rFF).
+ carry := digit >> bitShift].
+ carry = 0 ifFalse: [pTo at: toLen - 1 put: carry].
+ ^0!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitRshiftCount:n:f:bytes:from:len:to:len: (in category 'C core') -----
+ cDigitRshiftCount: count n: n f: f bytes: b from: pFrom len: fromLen to: pTo len: toLen
+ | x digit |
+ <var: #pTo type: 'unsigned char * '>
+ <var: #pFrom type: 'unsigned char * '>
+ self sqAssert: b < fromLen.
+ n = 0 ifTrue: ["Fast version for byte-aligned shifts"
+ "C indexed!!"
+ ^self
+ cDigitReplace: pTo
+ from: 0
+ to: toLen - 1
+ with: pFrom
+ startingAt: b].
+
+ "This implementation use at most 16 bits of x"
+ x := (pFrom at: b) << f.
+ self sqAssert: count - 1 < fromLen.
+ b + 1 to: count - 1 do:
+ [:j |
+ digit := pFrom at: j.
+ x := (x >> 8) bitOr: (digit << f).
+ pTo at: j - b - 1 put: (x bitAnd: 255)].
+ count = fromLen
+ ifTrue: [digit := 0]
+ ifFalse: [digit := pFrom at: count].
+ x := (x >> 8) bitOr: (digit << f).
+ pTo at: count - b - 1 put: (x "bitAnd: 255")!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cdigitMontgomery:len:times:len:modulo:len:mInvModB:into: (in category 'C core') -----
- cdigitMontgomery: pBytesFirst
- len: firstLen
- times: pBytesSecond
- len: secondLen
- modulo: pBytesThird
- len: thirdLen
- mInvModB: mInv
- into: pBytesRes
-
- | u limit1 limit2 limit3 accum lastByte |
- <var: #pBytesFirst type: #'unsigned char *'>
- <var: #pBytesSecond type: #'unsigned char *'>
- <var: #pBytesThird type: #'unsigned char *'>
- <var: #pBytesRes type: #'unsigned char *'>
- <var: #accum type: #usqInt>
- <var: #u type: #'unsigned char'>
- <var: #lastByte type: #'unsigned char'>
- limit1 := firstLen - 1.
- limit2 := secondLen - 1.
- limit3 := thirdLen - 1.
- lastByte := 0.
- 0 to: limit1 do:
- [:i |
- accum := (pBytesRes at: 0) + ((pBytesFirst at: i)*(pBytesSecond at: 0)).
- u := accum * mInv bitAnd: 255.
- accum := accum + (u * (pBytesThird at: 0)).
- 1 to: limit2 do: [:k |
- accum := (accum >> 8) + (pBytesRes at: k) + ((pBytesFirst at: i)*(pBytesSecond at: k)) + (u * (pBytesThird at: k)).
- pBytesRes at: k-1 put: (accum bitAnd: 255)].
- secondLen to: limit3 do: [:k |
- accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
- pBytesRes at: k-1 put: (accum bitAnd: 255)].
- accum := (accum >> 8) + lastByte.
- pBytesRes at: limit3 put: (accum bitAnd: 255).
- lastByte := accum >> 8].
- firstLen to: limit3 do:
- [:i |
- accum := (pBytesRes at: 0).
- u := accum * mInv bitAnd: 255.
- accum := accum + (u * (pBytesThird at: 0)).
- 1 to: limit3 do: [:k |
- accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
- pBytesRes at: k-1 put: (accum bitAnd: 255)].
- accum := (accum >> 8) + lastByte.
- pBytesRes at: limit3 put: (accum bitAnd: 255).
- lastByte := accum >> 8].
- (lastByte = 0 and: [(self cDigitCompare: pBytesThird with: pBytesRes len: thirdLen) = 1]) ifFalse: [
- "self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes"
- accum := 0.
- 0 to: limit3 do:
- [:i |
- accum := accum + (pBytesRes at: i) - (pBytesThird at: i).
- pBytesRes at: i put: (self cCode: [accum] inSmalltalk: [accum bitAnd: 255]).
- accum := accum signedBitShift: -8]].!
Item was added:
+ ----- Method: LargeIntegersPlugin>>digit:Lshift: (in category 'oop functions') -----
+ digit: aBytesOop Lshift: shiftCount
+ "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
+ "Does not normalize."
+ | newBytes highBit newLen oldLen |
+ oldLen := self digitSizeOfLargeInt: aBytesOop.
+ (highBit := self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop)
+ len: oldLen) = 0 ifTrue: [^ 0 asOop: SmallInteger].
+ newLen := highBit + shiftCount + 7 // 8.
+ self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
+ indexableSize: newLen].
+ self
+ cDigitLshift: shiftCount
+ from: (interpreterProxy firstIndexableField: aBytesOop)
+ len: oldLen
+ to: (interpreterProxy firstIndexableField: newBytes)
+ len: newLen.
+ ^ newBytes!
Item was added:
+ ----- Method: LargeIntegersPlugin>>digit:Rshift:bytes:lookfirst: (in category 'oop functions') -----
+ digit: 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."
+ | x f digit i oldLen newLen newBytes |
+ x := 0.
+ f := 8 - anInteger.
+ i := a.
+ digit := self digitOfLargeInt: aBytesOop at: i.
+ [((digit >> anInteger)
+ bitOr: x)
+ = 0 and: [i ~= 1]]
+ whileTrue:
+ [x := digit << f.
+ "Can't exceed 8 bits"
+ i := i - 1.
+ digit := self digitOfLargeInt: aBytesOop at: i].
+ i <= b ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
+ indexableSize: 0"Integer new: 0 neg: self negative"].
+ "All bits lost"
+ oldLen := self digitSizeOfLargeInt: aBytesOop.
+ newLen := i - b.
+ self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
+ indexableSize: newLen].
+ "r := Integer new: i - b neg: self negative."
+ " count := i.
+ "
+ self
+ cDigitRshiftCount: i
+ n: anInteger
+ f: f
+ bytes: b
+ from: (interpreterProxy firstIndexableField: aBytesOop)
+ len: oldLen
+ to: (interpreterProxy firstIndexableField: newBytes)
+ len: newLen.
+ ^ newBytes!
Item was changed:
----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') -----
digitAddLarge: firstInteger with: secondInteger
"Does not need to normalize!!"
| over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass |
<var: #over type: 'unsigned char '>
+ firstLen := self digitSizeOfLargeInt: firstInteger.
+ secondLen := self digitSizeOfLargeInt: secondInteger.
- firstLen := self byteSizeOfBytes: firstInteger.
- secondLen := self byteSizeOfBytes: 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."
self remapOop: #(shortInt longInt ) in: [sum := interpreterProxy instantiateClass: resClass indexableSize: longLen].
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."
self remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1].
self
+ cDigitCopyFrom: (interpreterProxy firstIndexableField: sum)
- 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!
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 digitSizeOfLargeInt: firstLarge.
+ secondLen := self digitSizeOfLargeInt: secondLarge.
- firstLen := self byteSizeOfBytes: firstLarge.
- secondLen := self byteSizeOfBytes: 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
- cByteOp: opIx
short: (interpreterProxy firstIndexableField: shortLarge)
len: shortLen
long: (interpreterProxy firstIndexableField: longLarge)
len: longLen
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"
| firstLen secondLen |
+ firstLen := self digitSizeOfLargeInt: firstInteger.
+ secondLen := self digitSizeOfLargeInt: secondInteger.
- firstLen := self byteSizeOfBytes: firstInteger.
- secondLen := self byteSizeOfBytes: 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!
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."
| firstLen secondLen resultClass l d div rem quo result |
+ firstLen := self digitSizeOfLargeInt: firstInteger.
+ secondLen := self digitSizeOfLargeInt: secondInteger.
- firstLen := self byteSizeOfBytes: firstInteger.
- secondLen := self byteSizeOfBytes: secondInteger.
neg
ifTrue: [resultClass := interpreterProxy classLargeNegativeInteger]
ifFalse: [resultClass := interpreterProxy classLargePositiveInteger].
l := firstLen - secondLen + 1.
l <= 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 byte of div is >=128"
+ d := 8 - (self cHighBit: (self unsafeDigitOf: secondInteger at: secondLen)).
- d := 8 - (self cHighBit: (self unsafeByteOf: secondInteger at: secondLen)).
self remapOop: firstInteger
in:
+ [div := self digit: secondInteger Lshift: d.
+ div := self largeIntOrInt: div growTo: (self digitLength: div)
- [div := self bytes: secondInteger Lshift: d.
- div := self bytesOrInt: div growTo: (self digitLength: div)
+ 1].
self remapOop: div
in:
+ [rem := self digit: firstInteger Lshift: d.
- [rem := self bytes: firstInteger Lshift: d.
(self digitLength: rem)
+ = firstLen ifTrue: [rem := self largeIntOrInt: rem growTo: firstLen + 1]].
- = firstLen ifTrue: [rem := self bytesOrInt: rem growTo: firstLen + 1]].
self remapOop: #(div rem ) in: [quo := interpreterProxy instantiateClass: resultClass indexableSize: l].
self
+ cDigitDiv: (interpreterProxy firstIndexableField: div)
- cCoreDigitDivDiv: (interpreterProxy firstIndexableField: div)
len: (self digitLength: div)
rem: (interpreterProxy firstIndexableField: rem)
len: (self digitLength: rem)
quo: (interpreterProxy firstIndexableField: quo)
len: (self digitLength: quo).
self remapOop: #(quo ) in: [rem := self
+ digit: rem
- bytes: rem
Rshift: d
bytes: 0
lookfirst: (self digitLength: 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>>digitLength: (in category 'util') -----
digitLength: oop
(interpreterProxy isIntegerObject: oop)
ifTrue: [^ self cDigitLengthOfCSI: (interpreterProxy integerValueOf: oop)]
+ ifFalse: [^ self digitSizeOfLargeInt: oop]!
- ifFalse: [^ self byteSizeOfBytes: oop]!
Item was changed:
----- Method: LargeIntegersPlugin>>digitLengthOfNonImmediate: (in category 'util') -----
digitLengthOfNonImmediate: oop
<inline: true>
+ ^self digitSizeOfLargeInt: oop!
- ^self byteSizeOfBytes: oop!
Item was changed:
----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') -----
digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv
| firstLen secondLen thirdLen prod |
+ firstLen := self digitSizeOfLargeInt: firstLarge.
+ secondLen := self digitSizeOfLargeInt: secondLarge.
+ thirdLen := self digitSizeOfLargeInt: thirdLarge.
- firstLen := self byteSizeOfBytes: firstLarge.
- secondLen := self byteSizeOfBytes: secondLarge.
- thirdLen := self byteSizeOfBytes: thirdLarge.
firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
(mInv >= 0 and: [mInv <= 255]) ifFalse: [^interpreterProxy primitiveFail].
self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen].
self
+ cDigitMontgomery: (interpreterProxy firstIndexableField: firstLarge)
- 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 resultClass |
+ firstLen := self digitSizeOfLargeInt: firstInteger.
+ secondLen := self digitSizeOfLargeInt: secondInteger.
- firstLen := self byteSizeOfBytes: firstInteger.
- secondLen := self byteSizeOfBytes: secondInteger.
firstLen <= secondLen
ifTrue:
[shortInt := firstInteger.
shortLen := firstLen.
longInt := secondInteger.
longLen := secondLen]
ifFalse:
[shortInt := secondInteger.
shortLen := secondLen.
longInt := firstInteger.
longLen := firstLen].
neg
ifTrue: [resultClass := interpreterProxy classLargeNegativeInteger]
ifFalse: [resultClass := interpreterProxy classLargePositiveInteger].
self remapOop: #(shortInt longInt ) in: [prod := interpreterProxy instantiateClass: resultClass indexableSize: longLen + shortLen].
self
cDigitMultiply: (interpreterProxy firstIndexableField: shortInt)
len: shortLen
with: (interpreterProxy firstIndexableField: longInt)
len: longLen
into: (interpreterProxy firstIndexableField: prod).
^ self normalize: prod!
Item was changed:
----- Method: LargeIntegersPlugin>>digitOf:at: (in category 'util') -----
digitOf: oop at: ix
(interpreterProxy isIntegerObject: oop) ifTrue:
[ix < 1 ifTrue: [interpreterProxy primitiveFail. ^0].
ix > interpreterProxy bytesPerOop ifTrue: [^0].
^self cDigitOfCSI: (interpreterProxy integerValueOf: oop) at: ix].
+ ^self digitOfLargeInt: oop at: ix!
- ^self digitOfBytes: oop at: ix!
Item was removed:
- ----- Method: LargeIntegersPlugin>>digitOfBytes:at: (in category 'util') -----
- digitOfBytes: aBytesOop at: ix
- "Argument has to be aLargeInteger!!"
- ix > (self byteSizeOfBytes: aBytesOop)
- ifTrue: [^ 0]
- ifFalse: [^ self unsafeByteOf: aBytesOop at: ix]!
Item was added:
+ ----- Method: LargeIntegersPlugin>>digitOfLargeInt:at: (in category 'util') -----
+ digitOfLargeInt: aBytesOop at: ix
+ "Argument has to be aLargeInteger!!"
+ ix > (self digitSizeOfLargeInt: aBytesOop)
+ ifTrue: [^ 0]
+ ifFalse: [^ self unsafeDigitOf: aBytesOop at: ix]!
Item was added:
+ ----- Method: LargeIntegersPlugin>>digitSizeOfLargeInt: (in category 'util') -----
+ digitSizeOfLargeInt: bytesOop
+ "Precondition: bytesOop is not anInteger and a bytes object."
+ ^ interpreterProxy slotSizeOf: bytesOop!
Item was changed:
----- Method: LargeIntegersPlugin>>digitSubLarge:with: (in category 'oop functions') -----
digitSubLarge: firstInteger with: secondInteger
"Normalizes."
| firstLen secondLen larger largerLen smaller smallerLen neg resLen res firstNeg |
firstNeg := (interpreterProxy fetchClassOf: firstInteger)
= interpreterProxy classLargeNegativeInteger.
+ firstLen := self digitSizeOfLargeInt: firstInteger.
+ secondLen := self digitSizeOfLargeInt: secondInteger.
- firstLen := self byteSizeOfBytes: firstInteger.
- secondLen := self byteSizeOfBytes: secondInteger.
firstLen = secondLen ifTrue:
[[firstLen > 1
+ and: [(self digitOfLargeInt: firstInteger at: firstLen) = (self digitOfLargeInt: secondInteger at: firstLen)]]
- and: [(self digitOfBytes: firstInteger at: firstLen) = (self digitOfBytes: secondInteger at: firstLen)]]
whileTrue: [firstLen := firstLen - 1].
secondLen := firstLen].
(firstLen < secondLen
or: [firstLen = secondLen
+ and: [(self digitOfLargeInt: firstInteger at: firstLen) < (self digitOfLargeInt: secondInteger at: firstLen)]])
- and: [(self digitOfBytes: firstInteger at: firstLen) < (self digitOfBytes: 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.
self remapOop: #(smaller larger)
in: [res := interpreterProxy
instantiateClass: (neg
ifTrue: [interpreterProxy classLargeNegativeInteger]
ifFalse: [interpreterProxy classLargePositiveInteger])
indexableSize: resLen].
self
cDigitSub: (interpreterProxy firstIndexableField: smaller)
len: smallerLen
with: (interpreterProxy firstIndexableField: larger)
len: largerLen
into: (interpreterProxy firstIndexableField: res).
^neg
ifTrue: [self normalizeNegative: res]
ifFalse: [self normalizePositive: res]!
Item was removed:
- ----- Method: LargeIntegersPlugin>>highBitOfBytes: (in category 'util') -----
- highBitOfBytes: aBytesOop
- ^ self cBytesHighBit: (interpreterProxy firstIndexableField: aBytesOop)
- len: (self byteSizeOfBytes: aBytesOop)!
Item was added:
+ ----- Method: LargeIntegersPlugin>>highBitOfLargeInt: (in category 'util') -----
+ highBitOfLargeInt: aBytesOop
+ ^ self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop)
+ len: (self digitSizeOfLargeInt: aBytesOop)!
Item was added:
+ ----- Method: LargeIntegersPlugin>>largeInt:growTo: (in category 'oop util') -----
+ largeInt: aBytesObject growTo: newLen
+ "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
+ "Does not normalize."
+ | newBytes oldLen copyLen |
+ self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject)
+ indexableSize: newLen].
+ oldLen := self digitSizeOfLargeInt: aBytesObject.
+ oldLen < newLen
+ ifTrue: [copyLen := oldLen]
+ ifFalse: [copyLen := newLen].
+ self
+ cDigitCopyFrom: (interpreterProxy firstIndexableField: aBytesObject)
+ to: (interpreterProxy firstIndexableField: newBytes)
+ len: copyLen.
+ ^ newBytes!
Item was added:
+ ----- Method: LargeIntegersPlugin>>largeIntOrInt:growTo: (in category 'oop util') -----
+ largeIntOrInt: oop growTo: len
+ "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
+ | newBytes val class |
+ (interpreterProxy isIntegerObject: oop)
+ ifTrue:
+ [val := interpreterProxy integerValueOf: oop.
+ val < 0
+ ifTrue: [class := interpreterProxy classLargeNegativeInteger]
+ ifFalse: [class := interpreterProxy classLargePositiveInteger].
+ newBytes := interpreterProxy instantiateClass: class indexableSize: len.
+ self cCopyIntVal: val toBytes: newBytes]
+ ifFalse: [newBytes := self largeInt: oop growTo: len].
+ ^ newBytes!
Item was removed:
- ----- Method: LargeIntegersPlugin>>negative: (in category 'util') -----
- negative: aLarge
- ^ (interpreterProxy fetchClassOf: aLarge)
- = interpreterProxy classLargeNegativeInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>normalizeNegative: (in category 'oop functions') -----
normalizeNegative: aLargeNegativeInteger
"Check for leading zeroes and return shortened copy if so."
"First establish len = significant length."
| sLen val len oldLen pointer |
len := oldLen := self digitLengthOfNonImmediate: aLargeNegativeInteger.
pointer := interpreterProxy
cCoerce: (interpreterProxy firstIndexableField: aLargeNegativeInteger)
to: #'unsigned char *'.
[len > 0 and: [(pointer at: len - 1) = 0]] whileTrue:
[len := len - 1].
len = 0 ifTrue: [^ 0 asOop: SmallInteger].
"Now check if in SmallInteger range"
sLen := interpreterProxy minSmallInteger < -16r40000000
ifTrue: [8]
ifFalse: [4]. "SmallInteger digitLength"
len <= sLen ifTrue:
[(len < sLen
or: [(pointer at: sLen - 1)
< (self cDigitOfCSI: interpreterProxy minSmallInteger at: sLen)]) ifTrue: "interpreterProxy minSmallInteger lastDigit"
["If high digit less, then can be small"
val := 0 - (pointer at: (len := len - 1)).
len - 1 to: 0 by: -1 do:
[:i | val := val * 256 - (pointer at: i)].
^val asOop: SmallInteger].
1 to: sLen do:
[:i | | byte | "If all digits same, then = minSmallInteger (sr: minSmallInteger digits 1 to sLen - 1 are 0)"
byte := i > len ifTrue: [0] ifFalse: [pointer at: i - 1].
byte ~= (self cDigitOfCSI: interpreterProxy minSmallInteger at: i) ifTrue: "Not so; return self shortened"
[len < oldLen ifTrue: "^ self growto: len"
+ [^self largeInt: aLargeNegativeInteger growTo: len].
- [^self bytes: aLargeNegativeInteger growTo: len].
^aLargeNegativeInteger]].
^interpreterProxy minSmallInteger asOop: SmallInteger].
"Return self, or a shortened copy"
len < oldLen ifTrue: "^ self growto: len"
+ [^self largeInt: aLargeNegativeInteger growTo: len].
- [^self bytes: aLargeNegativeInteger growTo: len].
^aLargeNegativeInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>normalizePositive: (in category 'oop functions') -----
normalizePositive: aLargePositiveInteger
"Check for leading zeroes and return shortened copy if so."
"First establish len = significant length."
| sLen val len oldLen pointer |
<var: #pointer type: #'unsigned char *'>
len := oldLen := self digitLengthOfNonImmediate: aLargePositiveInteger.
pointer := interpreterProxy
cCoerce: (interpreterProxy firstIndexableField: aLargePositiveInteger)
to: #'unsigned char *'.
[len > 0 and: [(pointer at: len - 1) = 0]] whileTrue:
[len := len - 1].
len = 0 ifTrue: [^ 0 asOop: SmallInteger].
"Now check if in SmallInteger range"
sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF "SmallInteger maxVal digitLength."
ifTrue: [8]
ifFalse: [4].
len <= sLen ifTrue:
[(len < sLen
or: [(pointer at: sLen - 1) <= (self cDigitOfCSI: interpreterProxy maxSmallInteger at: sLen)]) ifTrue:
["If so, return its SmallInt value"
val := pointer at: (len := len - 1).
len - 1 to: 0 by: -1 do:
[:i | val := val * 256 + (pointer at: i)].
^val asOop: SmallInteger]].
"Return self, or a shortened copy"
len < oldLen ifTrue: "^ self growto: len"
+ [^self largeInt: aLargePositiveInteger growTo: len].
- [^self bytes: aLargePositiveInteger growTo: len].
^aLargePositiveInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>primAnyBitFrom:to: (in category 'Integer primitives') -----
primAnyBitFrom: from to: to
| integer large |
self debugCode: [self msg: 'primAnyBitFrom: from to: to'].
integer := self
primitive: 'primAnyBitFromTo'
parameters: #(#SmallInteger #SmallInteger )
receiver: #Integer.
(interpreterProxy isIntegerObject: integer)
ifTrue: ["convert it to a not normalized LargeInteger"
large := self createLargeFromSmallInteger: integer]
ifFalse: [large := integer].
^ (self
+ anyBitOfLargeInt: large
- anyBitOfBytes: large
from: from
to: to)
asOop: Boolean!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigit:bitShift: (in category 'development primitives') -----
primDigit: anInteger bitShift: shiftCount
| rShift aLarge |
self debugCode: [self msg: 'primDigit: anInteger bitShift: shiftCount'].
self
primitive: '_primDigitBitShift'
parameters: #(Integer SmallInteger )
receiver: #Oop.
(interpreterProxy isIntegerObject: anInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
aLarge := self createLargeFromSmallInteger: anInteger]
ifFalse: [aLarge := anInteger].
shiftCount >= 0
+ ifTrue: [^ self digit: aLarge Lshift: shiftCount]
- ifTrue: [^ self bytes: aLarge Lshift: shiftCount]
ifFalse:
[rShift := 0 - shiftCount.
^ self normalize: (self
+ digit: aLarge
- bytes: aLarge
Rshift: (rShift bitAnd: 7)
bytes: (rShift bitShift: -3)
+ lookfirst: (self digitSizeOfLargeInt: aLarge))]!
- lookfirst: (self byteSizeOfBytes: aLarge))]!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitShift: (in category 'obsolete') -----
primDigitBitShift: shiftCount
| rShift aLarge anInteger |
self debugCode: [self msg: 'primDigitBitShift: shiftCount'].
anInteger := self
primitive: 'primDigitBitShift'
parameters: #(SmallInteger )
receiver: #Integer.
(interpreterProxy isIntegerObject: anInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
aLarge := self createLargeFromSmallInteger: anInteger]
ifFalse: [aLarge := anInteger].
shiftCount >= 0
+ ifTrue: [^ self digit: aLarge Lshift: shiftCount]
- ifTrue: [^ self bytes: aLarge Lshift: shiftCount]
ifFalse:
[rShift := 0 - shiftCount.
^ self normalize: (self
+ digit: aLarge
- bytes: aLarge
Rshift: (rShift bitAnd: 7)
bytes: (rShift bitShift: -3)
+ lookfirst: (self digitSizeOfLargeInt: aLarge))]!
- lookfirst: (self byteSizeOfBytes: aLarge))]!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitShiftMagnitude: (in category 'Integer primitives') -----
primDigitBitShiftMagnitude: shiftCount
| rShift aLarge anInteger |
self debugCode: [self msg: 'primDigitBitShiftMagnitude: shiftCount'].
anInteger := self
primitive: 'primDigitBitShiftMagnitude'
parameters: #(#SmallInteger )
receiver: #Integer.
(interpreterProxy isIntegerObject: anInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
aLarge := self createLargeFromSmallInteger: anInteger]
ifFalse: [aLarge := anInteger].
shiftCount >= 0
+ ifTrue: [^ self digit: aLarge Lshift: shiftCount]
- ifTrue: [^ self bytes: aLarge Lshift: shiftCount]
ifFalse:
[rShift := 0 - shiftCount.
^ self normalize: (self
+ digit: aLarge
- bytes: aLarge
Rshift: (rShift bitAnd: 7)
bytes: (rShift bitShift: -3)
+ lookfirst: (self digitSizeOfLargeInt: aLarge))]!
- lookfirst: (self byteSizeOfBytes: aLarge))]!
Item was added:
+ ----- Method: LargeIntegersPlugin>>primMontgomeryDigitLength (in category 'Integer primitives') -----
+ primMontgomeryDigitLength
+ self debugCode: [self msg: 'primMontgomeryDigitLength'].
+ self
+ primitive: 'primMontgomeryDigitLength'
+ parameters: #()
+ receiver: #Integer.
+ ^interpreterProxy integerObjectOf: 8!
Item was removed:
- ----- Method: LargeIntegersPlugin>>think (in category 'debugging') -----
- think
- "Flag for marking methods for later thinking."
- self debugCode: [self msg: '#think should not be called'].
- ^nil!
Item was removed:
- ----- Method: LargeIntegersPlugin>>unsafeByteOf:at: (in category 'util') -----
- unsafeByteOf: bytesObj at: ix
- "Argument bytesObj must not be aSmallInteger!!"
- <inline: true>
- ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1!
Item was added:
+ ----- Method: LargeIntegersPlugin>>unsafeDigitOf:at: (in category 'util') -----
+ unsafeDigitOf: bytesObj at: ix
+ "Argument bytesObj must not be aSmallInteger!!"
+ <inline: true>
+ ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1!
More information about the Vm-dev
mailing list