[Vm-dev] VM Maker: VMMaker.oscog-nice.1743.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Mar 26 00:41:09 UTC 2016


Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1743.mcz

==================== Summary ====================

Name: VMMaker.oscog-nice.1743
Author: nice
Time: 26 March 2016, 1:38:58.425 am
UUID: c4607394-3c0a-4984-87b6-06e1e25e744e
Ancestors: VMMaker.oscog-nice.1742

Finish 1st round of LargeIntegers refactoring

- simplify the left and right shift
- use as much unsigned arithmetic as possible
- homogenize type declaration within the plugin
- remove unused digitOf:at:

=============== Diff against VMMaker.oscog-nice.1742 ===============

Item was changed:
  ----- Method: LargeIntegersPlugin>>cCopyIntVal:toBytes: (in category 'C core util') -----
  cCopyIntVal: val toBytes: bytes 
  	| pByte |
+ 	<var: #pByte type: #'unsigned char *'>
- 	<var: #pByte type: 'unsigned char *  '>
  	pByte := interpreterProxy firstIndexableField: bytes.
  	1 to: (self cDigitLengthOfCSI: val)
  		do: [:ix | pByte at: ix - 1 put: (self cDigitOfCSI: val at: ix)]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>cDigitAdd:len:with:len:into: (in category 'C core') -----
  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'>
- 	<returnTypeC: 'unsigned char'>
- 	<var: #pByteShort type: 'unsigned char * '>
- 	<var: #pByteLong type: 'unsigned char * '>
- 	<var: #pByteRes type: 'unsigned char * '>
  	accum := 0.
  	limit := shortLen - 1.
  	0 to: limit do: 
  		[:i | 
+ 		accum := (accum >> 8)
- 		accum := (accum bitShift: -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)
- 		accum := (accum bitShift: -8)
  					+ (pByteLong at: i).
  		pByteRes at: i put: (accum bitAnd: 255)].
+ 	^ accum >> 8!
- 	^ accum bitShift: -8!

Item was changed:
  ----- Method: LargeIntegersPlugin>>cDigitCompare:with:len: (in category 'C core') -----
  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'>
- 	<var: #pFirst type: 'unsigned char * '>
- 	<var: #pSecond type: 'unsigned char * '>
  	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!

Item was changed:
  ----- 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 *'>
- 	<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 changed:
  ----- 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 b |
- 	| 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 *'>
+ 	<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].
- 	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 digits of rem by dh."
+ 		"The estimate is q = qhi*16r100+qlo, where qhi and qlo are unsigned char."
- 		"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 := 16rFF]
- 		(pRem at: j - 1) = dh
- 			ifTrue: [q := 255]
  			ifFalse: 
+ 				["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh."
- 				["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.
+ 				r1r2 := (r1r2 << 8) + (pRem at: 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 >> 8.
+ 				lo := mul bitAnd: 16rFF.
- 				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 < dnh
- 						lo := lo - dnh.
- 						lo < 0
  							ifTrue: 
  								[hi := hi - 1.
+ 								lo := lo + 16r100 - dnh]
+ 							ifFalse:
+ 								[lo := lo - dnh].
- 								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 >> 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.
- 			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 >> 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!
- 		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 changed:
  ----- 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 *'>
+ 	<var: #lastDigit type: #'unsigned int'>
- 	<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 changed:
  ----- Method: LargeIntegersPlugin>>cDigitLshift:from:len:to:len: (in category 'C core') -----
  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.
- 	| byteShift bitShift carry limit digit lastIx |
- 	<returnTypeC: 'int'>
- 	<var: #pTo type: 'unsigned char * '>
- 	<var: #pFrom type: 'unsigned char * '>
- 	byteShift := 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"
- 	bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts"
  		"C indexed!!"
  		^ self
  			cDigitReplace: pTo
+ 			from: digitShift
- 			from: byteShift
  			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.
- 	bitAnd: 255 is only for simulator, useless in C"
  	carry := 0.
+ 	limit := lenFrom - 1.
- 	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.
+ 		pTo at: i + digitShift put: ((carry bitOr: digit << bitShift) bitAnd: 16rFF).
+ 		carry := digit >> rshift].
+ 	carry = 0 ifFalse: [pTo at: lenTo - 1 put: carry].
+ 	^0
+ !
- 		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 changed:
  ----- 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: #'unsigned int'>
- 	<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 changed:
  ----- Method: LargeIntegersPlugin>>cDigitMultiply:len:with:len:into: (in category 'C core') -----
  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'>
- 	<returnTypeC: 'unsigned char'>
- 	<var: #pByteShort type: 'unsigned char * '>
- 	<var: #pByteLong type: 'unsigned char * '>
- 	<var: #pByteRes type: 'unsigned char * '>
  	(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) (?)"
- 				limitLong := longLen - 1.
  				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).
- 					ab := (pByteLong at: j)
- 								* digit + carry + (pByteRes at: k).
- 					carry := ab bitShift: -8.
- 					pByteRes at: k put: (ab bitAnd: 255).
  					k := k + 1].
  				pByteRes at: k put: carry]].
  	^ 0!

Item was changed:
  ----- 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 *'>
- 	<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 changed:
  ----- 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 *'>
- 	<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 changed:
  ----- 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'>
- 	<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 removed:
- ----- 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 changed:
  ----- Method: LargeIntegersPlugin>>cHighBit: (in category 'C core util') -----
  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'>
- 
- 	<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!

Item was changed:
  ----- Method: LargeIntegersPlugin>>createLargeFromSmallInteger: (in category 'oop util') -----
  createLargeFromSmallInteger: anOop 
  	"anOop has to be a SmallInteger!!"
  	| val class size res pByte byte |
+ 	<var: #pByte type: #'unsigned char *'>
- 	<var: #pByte type: 'unsigned char *  '>
  	val := interpreterProxy integerValueOf: anOop.
  	val < 0
  		ifTrue: [class := interpreterProxy classLargeNegativeInteger]
  		ifFalse: [class := interpreterProxy classLargePositiveInteger].
  	size := self cDigitLengthOfCSI: val.
  	res := interpreterProxy instantiateClass: class indexableSize: size.
  	pByte := interpreterProxy firstIndexableField: res.
  	1 to: size do: [:ix |
  		byte := self cDigitOfCSI: val at: ix.
  		pByte at: ix - 1 put: byte].
  	^res!

Item was removed:
- ----- 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 added:
+ ----- Method: LargeIntegersPlugin>>digit:Rshift:lookfirst: (in category 'oop functions') -----
+ 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!

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'>
- 	<var: #over type: 'unsigned char  '>
  	firstLen := self digitSizeOfLargeInt: firstInteger.
  	secondLen := self digitSizeOfLargeInt: 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!

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.
  	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)).
  	self remapOop: firstInteger
  		in: 
  			[div := self digit: secondInteger Lshift: d.
  			div := self largeIntOrInt: div growTo: (self digitLength: div)
  							+ 1].
  	self remapOop: div
  		in: 
  			[rem := self digit: firstInteger Lshift: d.
  			(self digitLength: rem)
  				= firstLen ifTrue: [rem := self largeIntOrInt: 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
- 					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 removed:
- ----- 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!

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]
  		ifFalse: 
  			[rShift := 0 - shiftCount.
  			^ self normalize: (self
  					digit: aLarge
+ 					Rshift: rShift
- 					Rshift: (rShift bitAnd: 7)
- 					bytes: (rShift bitShift: -3)
  					lookfirst: (self digitSizeOfLargeInt: 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]
  		ifFalse: 
  			[rShift := 0 - shiftCount.
  			^ self normalize: (self
  					digit: aLarge
+ 					Rshift: rShift
- 					Rshift: (rShift bitAnd: 7)
- 					bytes: (rShift bitShift: -3)
  					lookfirst: (self digitSizeOfLargeInt: 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]
  		ifFalse: 
  			[rShift := 0 - shiftCount.
  			^ self normalize: (self
  					digit: aLarge
+ 					Rshift: rShift
- 					Rshift: (rShift bitAnd: 7)
- 					bytes: (rShift bitShift: -3)
  					lookfirst: (self digitSizeOfLargeInt: aLarge))]!



More information about the Vm-dev mailing list