[Vm-dev] Status of LargeIntergersPlugin

David T. Lewis lewis at mail.msen.com
Sun Jul 20 23:25:34 UTC 2014


On Sun, Jul 20, 2014 at 09:26:18PM +0200, Nicolas Cellier wrote:
>  
> 2014-07-20 20:17 GMT+02:00 David T. Lewis <lewis at mail.msen.com>:
> >
> > I'm not sure where we stand on this, so let me just ask:
> >
> > Nicolas: Is the LargeIntegersPlugin that you provided in recent email to
> > vm-dev suitable for inclusion in the VMs? In other words, are you happy
> > that this is a final version and ready for inclusion?
> >
> Yes it's ready for inclusion.

Good, thank you.

> > Eliot: Is there any reason that we should not adopt the changes from
> > Nicolas? If you are comfortable using that version, can we adopt it in
> > trunk and oscog branches?

I am attaching the changes for reference.

If no objections I will add this to VMM trunk tomorrow.

Dave
-------------- next part --------------
'From Squeak4.3 of 2 July 2014 [latest update: #13811] on 3 July 2014 at 12:36:08 am'!

!LargeIntegersPlugin methodsFor: 'oop util' stamp: 'nice 7/2/2014 22:37'!
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
		cDigitCopyFrom: (interpreterProxy firstIndexableField: aBytesObject)
		to: (interpreterProxy firstIndexableField: newBytes)
		len: copyLen.
	^ newBytes! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 22:04'!
cDigitAdd: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes 
	"pByteRes len = longLen; returns over.."
	| accum limit |
	<returnTypeC: 'unsigned char'>
	<var: #pByteShort type: 'unsigned char * '>
	<var: #pByteLong type: 'unsigned char * '>
	<var: #pByteRes type: 'unsigned char * '>
	<var: #accum type: 'unsigned int'>
	accum := 0.
	limit := shortLen - 1.
	0 to: limit do: 
		[:i | 
		accum := (accum >> 8)
					+ (pByteShort at: i) + (pByteLong at: i).
		pByteRes at: i put: (accum bitAnd: 255)].
	limit := longLen - 1.
	shortLen to: limit do: 
		[:i | 
		accum := (accum >> 8)
					+ (pByteLong at: i).
		pByteRes at: i put: (accum bitAnd: 255)].
	^ accum >> 8! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 21:52'!
cDigitCompare: pFirst with: pSecond len: len 
	"Precondition: pFirst len = pSecond len."
	| secondDigit ix firstDigit |
	<var: #pFirst type: 'unsigned char * '>
	<var: #pSecond type: 'unsigned char * '>
	<var: #firstDigit type: 'unsigned int'>
	<var: #secondDigit type: 'unsigned int'>
	ix := len - 1.
	[ix >= 0]
		whileTrue: 
			[(secondDigit := pSecond at: ix) ~= (firstDigit := pFirst at: ix)
				ifTrue: [secondDigit < firstDigit
						ifTrue: [^ 1]
						ifFalse: [^ -1]].
			ix := ix - 1].
	^ 0! !

!LargeIntegersPlugin methodsFor: 'C core util' stamp: 'nice 7/2/2014 22:52'!
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
! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 23:43'!
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 b |
	<var: #pDiv type: 'unsigned char * '>
	<var: #pRem type: 'unsigned char * '>
	<var: #pQuo type: 'unsigned char * '>
	<var: #dh type: 'unsigned int'>
	<var: #dnh type: 'unsigned int'>
	<var: #r3 type: 'unsigned int'>
	<var: #q type: 'unsigned int'>
	<var: #a type: 'unsigned int'>
	<var: #b type: 'unsigned int'>
	<var: #t type: 'unsigned int'>
	<var: #mul type: 'unsigned int'>
	<var: #hi type: 'unsigned int'>
	<var: #lo type: 'unsigned int'>
	<var: #r1r2 type: 'unsigned int'>
	dl := divLen - 1.
	"Last actual byte of data (ST ix)"
	ql := quoLen.
	dh := pDiv at: dl - 1.
	dl = 1
		ifTrue: [dnh := 0]
		ifFalse: [dnh := pDiv at: dl - 2].
	1 to: ql do: 
		[:k | 
		"maintain quo*arg+rem=self"
		"Estimate rem/div by dividing the leading two digits of rem by dh."
		"The estimate is q = qhi*16r100+qlo, where qhi and qlo are unsigned char."
		j := remLen + 1 - k.
		"r1 := rem digitAt: j."
		(pRem at: j - 1)
			= dh
			ifTrue: [q := 16rFF]
			ifFalse: 
				["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh."
				"r2 := (rem digitAt: j - 2)."
				r1r2 := pRem at: j - 1.
				r1r2 := (r1r2 << 8) + (pRem at: j - 2).
				t := r1r2 \\ dh.
				q := r1r2 // dh.
				"Next compute (hi,lo) := q*dnh"
				mul := q * dnh.
				hi := mul >> 8.
				lo := mul bitAnd: 16rFF.
				"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 < dnh
							ifTrue: 
								[hi := hi - 1.
								lo := lo + 16r100 - dnh]
							ifFalse:
								[lo := lo - dnh].
						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 >> 8).
			lo := (pDiv at: i - 1) * (q bitAnd: 16rFF).
			b := (pRem at: l - 1) - a - (lo bitAnd: 16rFF).
			pRem at: l - 1 put: (b bitAnd: 16rFF).
			"BEWARE: signed shift is implementation defined in C..."
			b := b signedBitShift: -8.
				"This is a possible replacement to simulate arithmetic shift (preserving sign of b)"
				"b := b >> 8 bitOr: (0 - (b >> ((interpreterProxy sizeof: b)*8""CHAR_BIT""-1)) << 8)."
			a := hi + (lo >> 8) - b.
			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 >> 8)
								+ (pRem at: l - 1) + (pDiv at: i - 1).
					pRem at: l - 1 put: (a bitAnd: 16rFF).
					l := l + 1]].
		pQuo at: quoLen - k put: q].
	^0! !

!LargeIntegersPlugin methodsFor: 'C core util' stamp: 'nice 7/2/2014 22:37'!
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 *  '>
	<var: #lastDigit type: 'unsigned int'>
	realLength := len.
	[(lastDigit := pByte at: realLength - 1) = 0]
		whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]].
	^  (self cHighBit: lastDigit) + (8 * (realLength - 1))! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 22:50'!
cDigitLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo 
	"C indexed!!"
	| digitShift bitShift carry limit digit rshift |
	<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.
	
	limit := digitShift - 1.
	0 to: limit do: [:i | pTo at: i put: 0].
	
	bitShift = 0 ifTrue: ["Fast version for digit-aligned shifts"
		"C indexed!!"
		^ self
			cDigitReplace: pTo
			from: digitShift
			to: lenTo - 1
			with: pFrom
			startingAt: 0].
		
	"This implementation use at most 15 bits of carry.
	bitAnd: 16rFF is only for simulator, useless in C"
	rshift := 8 - bitShift.
	carry := 0.
	limit := lenFrom - 1.
	0 to: limit do: 
		[:i | 
		digit := pFrom at: i.
		pTo at: i + digitShift put: ((carry bitOr: digit << bitShift) bitAnd: 16rFF).
		carry := digit >> rshift].
	carry = 0 ifFalse: [pTo at: lenTo - 1 put: carry].
	^0
! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 23:48'!
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: (accum bitAnd: 255).
			accum := accum signedBitShift: -8]].! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 21:52'!
cDigitMultiply: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes 
	| limitLong digit k carry limitShort ab |
	<returnTypeC: 'unsigned char'>
	<var: #pByteShort type: 'unsigned char * '>
	<var: #pByteLong type: 'unsigned char * '>
	<var: #pByteRes type: 'unsigned char * '>
	<var: #digit type: 'unsigned int'>
	<var: #carry type: 'unsigned int'>
	<var: #ab type: 'unsigned int'>
	(shortLen = 1 and: [(pByteShort at: 0)
			= 0])
		ifTrue: [^ 0].
	(longLen = 1 and: [(pByteLong at: 0)
			= 0])
		ifTrue: [^ 0].
	"prod starts out all zero"
	limitShort := shortLen - 1.
	limitLong := longLen - 1.
	0 to: limitShort do: [:i | (digit := pByteShort at: i) ~= 0
			ifTrue: 
				[k := i.
				carry := 0.
				"Loop invariant: 0<=carry<=0377, k=i+j-1 (ST)"
				"-> Loop invariant: 0<=carry<=0377, k=i+j (C) (?)"
				0 to: limitLong do: 
					[:j | 
					ab := (pByteLong at: j).
					ab := ab * digit + carry + (pByteRes at: k).
					carry := ab >> 8.
					pByteRes at: k put: (ab bitAnd: 16rFF).
					k := k + 1].
				pByteRes at: k put: carry]].
	^ 0! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 22:36'!
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! !

!LargeIntegersPlugin methodsFor: 'C core util' stamp: 'nice 7/2/2014 22:38'!
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! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 22:37'!
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! !

!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 7/2/2014 21:49'!
cDigitSub: pByteSmall len: smallLen with: pByteLarge len: largeLen into: pByteRes
	| z |
	<var: #pByteSmall type: 'unsigned char * '>
	<var: #pByteLarge type: 'unsigned char * '>
	<var: #pByteRes type: 'unsigned char * '>
	<var: #z type: 'unsigned int'>

	z := 0. "Loop invariant is -1<=z<=0"
	0 to: smallLen - 1 do: 
		[:i | 
		z := z + (pByteLarge at: i) - (pByteSmall at: i).
		pByteRes at: i put: (z bitAnd: 16rFF).
		z := z signedBitShift: -8].
	smallLen to: largeLen - 1 do: 
		[:i | 
		z := z + (pByteLarge at: i) .
		pByteRes at: i put: (z bitAnd: 16rFF).
		z := z signedBitShift: -8].
! !

!LargeIntegersPlugin methodsFor: 'C core util' stamp: 'nice 7/2/2014 22:07'!
cHighBit: uint 
	"Answer the index of the high order bit of the argument, or zero if the  
	argument is zero."
	"For 64 bit uints there could be added a 32-shift."
	| shifted bitNo |
	<var: #uint type: 'unsigned int'>
	<var: #shifted type: 'unsigned int  '>
	shifted := uint.
	bitNo := 0.
	shifted < (1 << 16)
		ifFalse: [shifted := shifted bitShift: -16.
			bitNo := bitNo + 16].
	shifted < (1 << 8)
		ifFalse: [shifted := shifted bitShift: -8.
			bitNo := bitNo + 8].
	shifted < (1 << 4)
		ifFalse: [shifted := shifted bitShift: -4.
			bitNo := bitNo + 4].
	shifted < (1 << 2)
		ifFalse: [shifted := shifted bitShift: -2.
			bitNo := bitNo + 2].
	shifted < (1 << 1)
		ifFalse: [shifted := shifted bitShift: -1.
			bitNo := bitNo + 1].
	"shifted 0 or 1 now"
	^ bitNo + shifted! !

!LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'nice 7/2/2014 23:44'!
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 byteSizeOfBytes: 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! !

!LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'nice 7/2/2014 23:44'!
digit: aBytesOop Rshift: shiftCount lookfirst: a 
	"Attention: this method invalidates all oop's!! Only newBytes is valid at return."
	"Shift right shiftCount bits, 0<=shiftCount.         
	Discard all digits beyond a, and all zeroes at or below a."
	"Does not normalize."
	| newByteLen newOop oldBitLen newBitLen oldDigitLen |
	oldBitLen := self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop) len: a.
	oldDigitLen := oldBitLen + 7 // 8.
	newBitLen := oldBitLen - shiftCount.
	newBitLen <= 0 ifTrue: ["All bits lost"
		^ interpreterProxy
			instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
			indexableSize: 0].
	newByteLen := newBitLen + 7 // 8.
	self remapOop: aBytesOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
					indexableSize: newByteLen].
	self
		cDigitRshift: shiftCount
		from: (interpreterProxy firstIndexableField: aBytesOop)
		len: oldDigitLen
		to: (interpreterProxy firstIndexableField: newOop)
		len: newByteLen.
	^ newOop! !

!LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'nice 7/2/2014 22:38'!
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 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)
				to: (interpreterProxy firstIndexableField: newSum)
				len: longLen.
			sum := newSum.
			"C index!!"
			(self cCoerce: (interpreterProxy firstIndexableField: sum)
				to: 'unsigned char *')
				at: longLen put: over].
	^ sum! !

!LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'nice 7/2/2014 22:36'!
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 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
		short: (interpreterProxy firstIndexableField: shortLarge)
		len: shortLen
		long: (interpreterProxy firstIndexableField: longLarge)
		len: longLen
		into: (interpreterProxy firstIndexableField: result).
	interpreterProxy failed ifTrue: [^ 0].
	^ self normalizePositive: result! !

!LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'nice 7/2/2014 23:45'!
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 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 unsafeByteOf: secondInteger at: secondLen)).
	self remapOop: firstInteger
		in: 
			[div := self digit: secondInteger Lshift: d.
			div := self bytesOrInt: div growTo: (self digitLength: div)
							+ 1].
	self remapOop: div
		in: 
			[rem := self digit: firstInteger Lshift: d.
			(self digitLength: rem)
				= 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)
		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
					Rshift: d
					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! !

!LargeIntegersPlugin methodsFor: 'oop functions' stamp: 'nice 7/2/2014 22:35'!
digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv

	| firstLen secondLen thirdLen prod |
	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)
				len: firstLen
				times: (interpreterProxy firstIndexableField: secondLarge)
				len: secondLen
				modulo: (interpreterProxy firstIndexableField: thirdLarge)
				len: thirdLen
				mInvModB: mInv
				into: (interpreterProxy firstIndexableField: prod).
	^self normalizePositive: prod! !

!LargeIntegersPlugin methodsFor: 'util' stamp: 'nice 7/2/2014 22:37'!
highBitOfBytes: aBytesOop 
	^ self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop)
		len: (self byteSizeOfBytes: aBytesOop)! !

!LargeIntegersPlugin methodsFor: 'development primitives' stamp: 'nice 7/2/2014 23:45'!
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]
		ifFalse: 
			[rShift := 0 - shiftCount.
			^ self normalize: (self
					digit: aLarge
					Rshift: rShift
					lookfirst: (self byteSizeOfBytes: aLarge))]! !

!LargeIntegersPlugin methodsFor: 'obsolete' stamp: 'nice 7/2/2014 23:45'!
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]
		ifFalse: 
			[rShift := 0 - shiftCount.
			^ self normalize: (self
					digit: aLarge
					Rshift: rShift
					lookfirst: (self byteSizeOfBytes: aLarge))]! !

!LargeIntegersPlugin methodsFor: 'Integer primitives' stamp: 'nice 7/2/2014 23:45'!
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]
		ifFalse: 
			[rShift := 0 - shiftCount.
			^ self normalize: (self
					digit: aLarge
					Rshift: rShift
					lookfirst: (self byteSizeOfBytes: aLarge))]! !
LargeIntegersPlugin removeSelector: #bytes:Lshift:!
LargeIntegersPlugin removeSelector: #bytes:Rshift:bytes:lookfirst:!
LargeIntegersPlugin removeSelector: #cByteOp:short:len:long:len:into:!
LargeIntegersPlugin removeSelector: #cBytesCopyFrom:to:len:!
LargeIntegersPlugin removeSelector: #cBytesHighBit:len:!
LargeIntegersPlugin removeSelector: #cBytesLshift:from:len:to:len:!
LargeIntegersPlugin removeSelector: #cBytesReplace:from:to:with:startingAt:!
LargeIntegersPlugin removeSelector: #cCoreBytesRshiftCount:n:f:bytes:from:len:to:len:!
LargeIntegersPlugin removeSelector: #cCoreDigitDivDiv:len:rem:len:quo:len:!
LargeIntegersPlugin removeSelector: #cdigitMontgomery:len:times:len:modulo:len:mInvModB:into:!
LargeIntegersPlugin removeSelector: #digitOf:at:!
LargeIntegersPlugin removeSelector: #negative:!


More information about the Vm-dev mailing list