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

commits at source.squeak.org commits at source.squeak.org
Sat Apr 9 02:24:59 UTC 2016 

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

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

Name: VMMaker.oscog-nice.1791
Author: nice
Time: 9 April 2016, 4:22:36.058 am
UUID: 25a942c2-9c18-4bcf-a1da-585c313c89a3
Ancestors: VMMaker.oscog-nice.1790

Fix CCode generation of LargeIntegers

Indeed, this method cannot be generated:

InterpreterPlugin>>
firstIndexableField: obj as: cType
       <inline: true>
       ^interpreterProxy cCoerce: (interpreterProxy firstIndexableField: obj) to: cType!

Only the inlined version can work when cType is replaced by a constant String as actual parameter.

Retract it for now since I found no way to avoid generation without eliminating inlining.
Replace it with a specific #pointerToFirstDigitOfLargeInt:

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

Item was removed:
- ----- Method: InterpreterPlugin>>firstIndexableField:as: (in category 'casting support') -----
- firstIndexableField: obj as: cType
- 	<inline: true>
- 	^interpreterProxy cCoerce: (interpreterProxy firstIndexableField: obj) to: cType!

Item was changed:
  ----- Method: LargeIntegersPlugin>>createLargeFromSmallInteger: (in category 'oop util') -----
  createLargeFromSmallInteger: anOop 
  	"anOop has to be a SmallInteger!!"
  	| val res pDigit byteSize digitSize |
  	<var: #pDigit type: #'unsigned int *'>
  	val := interpreterProxy integerValueOf: anOop.
  	byteSize := self byteSizeOfCSI: val.
  	res := self createLargeIntegerNeg: val < 0 byteLength: byteSize.
+ 	pDigit := self pointerToFirstDigitOfLargeInt: res.
- 	pDigit := self firstIndexableField: res as: #'unsigned int *'.
  	digitSize := byteSize + 3 // 4.
  	1 to: digitSize do: [:ix | self cDigitOf: pDigit at: ix - 1 put: (self digitOfCSI: val at: ix)].
  	^ res!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digit:Lshift: (in category 'oop functions') -----
  digit: anOop Lshift: shiftCount 
  	"Attention: this method invalidates all oop's!! Only newOop is valid at return."
  	"Does not normalize."
  	| newOop highBit newDigitLen newByteLen oldDigitLen |
  	oldDigitLen := self digitSizeOfLargeInt: anOop.
+ 	(highBit := self cDigitHighBit: (self pointerToFirstDigitOfLargeInt: anOop)
- 	(highBit := self cDigitHighBit: (self firstIndexableField: anOop as: #'unsigned int *')
  				len: oldDigitLen) = 0 ifTrue: [^  interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop) indexableSize: 1].
  	newByteLen := highBit + shiftCount + 7 // 8.
  	self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop)
  					indexableSize: newByteLen].
  	newDigitLen := newByteLen + 3 // 4.
  	self
  		cDigitLshift: shiftCount
+ 		from: (self pointerToFirstDigitOfLargeInt: anOop)
- 		from: (self firstIndexableField: anOop as: #'unsigned int *')
  		len: oldDigitLen
+ 		to: (self pointerToFirstDigitOfLargeInt: newOop)
- 		to: (self firstIndexableField: newOop as: #'unsigned int *')
  		len: newDigitLen.
  	^ newOop!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digit:Rshift:lookfirst: (in category 'oop functions') -----
  digit: anOop Rshift: shiftCount lookfirst: a 
  	"Attention: this method invalidates all oop's!! Only newBytes is valid at return."
  	"Shift right 32*digitShift+bitShift bits, 0<=bitShift<32.         
  	Discard all digits beyond a, and all zeroes at or below a."
  	"Does not normalize."
  	| newByteLen newOop oldBitLen newBitLen oldDigitLen newDigitLen |
+ 	oldBitLen := self cDigitHighBit: (self pointerToFirstDigitOfLargeInt: anOop) len: a.
- 	oldBitLen := self cDigitHighBit: (self firstIndexableField: anOop as: #'unsigned int *') len: a.
  	oldDigitLen := oldBitLen + 31 // 32.
  	newBitLen := oldBitLen - shiftCount.
  	newBitLen <= 0 ifTrue: ["All bits lost"
  		^ interpreterProxy
  			instantiateClass: (interpreterProxy fetchClassOf: anOop)
  			indexableSize: 0].
  	newByteLen := newBitLen + 7 // 8.
  	newDigitLen := newByteLen + 3 // 4.
  	self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop)
  					indexableSize: newByteLen].
  	self
  		cDigitRshift: shiftCount
+ 		from: (self pointerToFirstDigitOfLargeInt: anOop)
- 		from: (self firstIndexableField: anOop as: #'unsigned int *')
  		len: oldDigitLen
+ 		to: (self pointerToFirstDigitOfLargeInt: newOop)
- 		to: (self firstIndexableField: newOop as: #'unsigned int *')
  		len: newDigitLen.
  	^ newOop!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') -----
  digitAddLarge: firstInteger with: secondInteger 
  	"Does not need to normalize!!"
  	| over firstDigitLen secondDigitLen shortInt shortDigitLen longInt longDigitLen sum newSum neg |
  	<var: #over type: #'unsigned int'>
  	firstDigitLen := self digitSizeOfLargeInt: firstInteger.
  	secondDigitLen := self digitSizeOfLargeInt: secondInteger.
  	neg := (interpreterProxy fetchClassOf: firstInteger)
  		= interpreterProxy classLargeNegativeInteger.
  	firstDigitLen <= secondDigitLen
  		ifTrue: 
  			[shortInt := firstInteger.
  			shortDigitLen := firstDigitLen.
  			longInt := secondInteger.
  			longDigitLen := secondDigitLen]
  		ifFalse: 
  			[shortInt := secondInteger.
  			shortDigitLen := secondDigitLen.
  			longInt := firstInteger.
  			longDigitLen := firstDigitLen].
  	"	sum := Integer new: len neg: firstInteger negative."
  	self remapOop: #(shortInt longInt ) in: [sum := self createLargeIntegerNeg: neg digitLength: longDigitLen].
  	over := self
+ 				cDigitAdd: (self pointerToFirstDigitOfLargeInt: shortInt)
- 				cDigitAdd: (self firstIndexableField: shortInt as: #'unsigned int *')
  				len: shortDigitLen
+ 				with: (self pointerToFirstDigitOfLargeInt: longInt)
- 				with: (self firstIndexableField: longInt as: #'unsigned int *')
  				len: longDigitLen
+ 				into: (self pointerToFirstDigitOfLargeInt: sum).
- 				into: (self firstIndexableField: sum as: #'unsigned int *').
  	over > 0
  		ifTrue: 
  			["sum := sum growby: 1."
  			self remapOop: sum in: [newSum := self createLargeIntegerNeg: neg byteLength: longDigitLen * 4 + 1].
  			self
+ 				cDigitCopyFrom: (self pointerToFirstDigitOfLargeInt: sum)
+ 				to: (self pointerToFirstDigitOfLargeInt: newSum)
- 				cDigitCopyFrom: (self firstIndexableField: sum as: #'unsigned int *')
- 				to: (self firstIndexableField: newSum as: #'unsigned int *')
  				len: longDigitLen.
  			sum := newSum.
  			"C index!!"
+ 			self cDigitOf: (self pointerToFirstDigitOfLargeInt: sum)
- 			self cDigitOf: (self firstIndexableField: sum as: #'unsigned int *')
  				at: longDigitLen put: over]
  		ifFalse:
  			[sum := neg 
  				ifTrue: [self normalizeNegative: sum]
  				ifFalse: [self normalizePositive: sum]].
  	^ sum!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitBitLogic:with:opIndex: (in category 'oop functions') -----
  digitBitLogic: firstInteger with: secondInteger opIndex: opIx 
  	"Bit logic here is only implemented for positive integers or Zero;
  	if rec or arg is negative, it fails."
  	| firstLarge secondLarge firstLen secondLen shortLen shortLarge longLen longLarge result |
  	(interpreterProxy isIntegerObject: firstInteger)
  		ifTrue: 
  			[(interpreterProxy integerValueOf: firstInteger)
  				< 0 ifTrue: [^ interpreterProxy primitiveFail].
  			"convert it to a not normalized LargeInteger"
  			self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
  		ifFalse: 
  			[(interpreterProxy fetchClassOf: firstInteger)
  				= interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail].
  			firstLarge := firstInteger].
  	(interpreterProxy isIntegerObject: secondInteger)
  		ifTrue: 
  			[(interpreterProxy integerValueOf: secondInteger)
  				< 0 ifTrue: [^ interpreterProxy primitiveFail].
  			"convert it to a not normalized LargeInteger"
  			self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
  		ifFalse: 
  			[(interpreterProxy fetchClassOf: secondInteger)
  				= interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail].
  			secondLarge := secondInteger].
  	firstLen := self byteSizeOfLargeInt: firstLarge.
  	secondLen := self byteSizeOfLargeInt: secondLarge.
  	firstLen < secondLen
  		ifTrue: 
  			[shortLen := firstLen.
  			shortLarge := firstLarge.
  			longLen := secondLen.
  			longLarge := secondLarge]
  		ifFalse: 
  			[shortLen := secondLen.
  			shortLarge := secondLarge.
  			longLen := firstLen.
  			longLarge := firstLarge].
  	self remapOop: #(shortLarge longLarge ) in: [result := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: longLen].
  	self
  		cDigitOp: opIx
+ 		short: (self pointerToFirstDigitOfLargeInt: shortLarge)
- 		short: (self firstIndexableField: shortLarge as: #'unsigned int *')
  		len: shortLen + 3 // 4
+ 		long: (self pointerToFirstDigitOfLargeInt: longLarge)
- 		long: (self firstIndexableField: longLarge as: #'unsigned int *')
  		len: longLen + 3 // 4
+ 		into: (self pointerToFirstDigitOfLargeInt: result).
- 		into: (self firstIndexableField: result as: #'unsigned int *').
  	interpreterProxy failed ifTrue: [^ 0].
  	^ self normalizePositive: result!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitCompareLarge:with: (in category 'oop functions') -----
  digitCompareLarge: firstInteger with: secondInteger 
  	"Compare the magnitude of firstInteger with that of secondInteger.      
  	Return a code of 1, 0, -1 for firstInteger >, = , < secondInteger"
  	| firstDigitLen secondDigitLen |
  	firstDigitLen := self digitSizeOfLargeInt: firstInteger.
  	secondDigitLen := self digitSizeOfLargeInt: secondInteger.
  	secondDigitLen ~= firstDigitLen
  		ifTrue: [secondDigitLen > firstDigitLen
  				ifTrue: [^ -1 asOop: SmallInteger]
  				ifFalse: [^ 1 asOop: SmallInteger]].
  	^ (self
+ 		cDigitCompare: (self pointerToFirstDigitOfLargeInt: firstInteger)
+ 		with: (self pointerToFirstDigitOfLargeInt: secondInteger)
- 		cDigitCompare: (self firstIndexableField: firstInteger as: #'unsigned int *')
- 		with: (self firstIndexableField: secondInteger as: #'unsigned int *')
  		len: firstDigitLen)
  		asOop: SmallInteger!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitDivLarge:with:negative: (in category 'oop functions') -----
  digitDivLarge: firstInteger with: secondInteger negative: neg 
  	"Does not normalize."
  	"Division by zero has to be checked in caller."
  	| firstDigitLen secondDigitLen quoDigitLen d div rem quo result |
  	firstDigitLen := self digitSizeOfLargeInt: firstInteger.
  	secondDigitLen := self digitSizeOfLargeInt: secondInteger.
  	quoDigitLen := firstDigitLen - secondDigitLen + 1.
  	quoDigitLen <= 0
  		ifTrue: 
  			[self remapOop: firstInteger in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
  			result stAt: 1 put: (0 asOop: SmallInteger).
  			result stAt: 2 put: firstInteger.
  			^ result].
  	"set rem and div to copies of firstInteger and secondInteger, respectively. 
  	  However,  
  	 to facilitate use of Knuth's algorithm, multiply rem and div by 2 (that 
  	 is, shift)   
  	 until the high word of div is >=16r80000000"
  	d := 32 - (self cHighBit32: (self unsafeDigitOfLargeInt: secondInteger at: secondDigitLen)).
  	self remapOop: firstInteger
  		in: 
  			[div := self digit: secondInteger Lshift: d.
  			div := self largeInt: div growTo: (self digitSizeOfLargeInt: div) + 1 * 4].
  	self remapOop: div
  		in: 
  			[rem := self digit: firstInteger Lshift: d.
  			(self digitSizeOfLargeInt: rem) = firstDigitLen
  				ifTrue: [rem := self largeInt: rem growTo: firstDigitLen + 1 * 4]].
  	self remapOop: #(div rem ) in: [quo := self createLargeIntegerNeg: neg digitLength: quoDigitLen].
  	self
+ 		cDigitDiv: (self pointerToFirstDigitOfLargeInt: div)
- 		cDigitDiv: (self firstIndexableField: div as: #'unsigned int *')
  		len: (self digitSizeOfLargeInt: div)
+ 		rem: (self pointerToFirstDigitOfLargeInt: rem)
- 		rem: (self firstIndexableField: rem as: #'unsigned int *')
  		len: (self digitSizeOfLargeInt: rem)
+ 		quo: (self pointerToFirstDigitOfLargeInt: quo)
- 		quo: (self firstIndexableField: quo as: #'unsigned int *')
  		len: (self digitSizeOfLargeInt: quo).
  	self remapOop: #(quo ) in: [rem := self
  					digit: rem
  					Rshift: d
  					lookfirst: (self digitSizeOfLargeInt: div)
  							- 1].
  	"^ Array with: quo with: rem"
  	self remapOop: #(quo rem ) in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
  	result stAt: 1 put: quo.
  	result stAt: 2 put: rem.
  	^ result!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') -----
  digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv
  	<var: #mInv type: #'unsigned int'>
  	| firstLen secondLen thirdLen prod |
  	firstLen := self digitSizeOfLargeInt: firstLarge.
  	secondLen := self digitSizeOfLargeInt: secondLarge.
  	thirdLen := self digitSizeOfLargeInt: thirdLarge.
  	(firstLen <= thirdLen and: [secondLen <= thirdLen]) ifFalse: [^interpreterProxy primitiveFail].
  
  	self remapOop: #(firstLarge secondLarge thirdLarge)
  		in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen * 4].
  	self
+ 		cDigitMontgomery: (self pointerToFirstDigitOfLargeInt: firstLarge)
- 		cDigitMontgomery: (self firstIndexableField: firstLarge as: #'unsigned int *')
  		len: firstLen
+ 		times: (self pointerToFirstDigitOfLargeInt: secondLarge)
- 		times: (self firstIndexableField: secondLarge as: #'unsigned int *')
  		len: secondLen
+ 		modulo: (self pointerToFirstDigitOfLargeInt: thirdLarge)
- 		modulo: (self firstIndexableField: thirdLarge as: #'unsigned int *')
  		len: thirdLen
  		mInvModB: mInv
+ 		into: (self pointerToFirstDigitOfLargeInt: prod).
- 		into: (self firstIndexableField: prod as: #'unsigned int *').
  	^self normalizePositive: prod!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitMultiplyLarge:with:negative: (in category 'oop functions') -----
  digitMultiplyLarge: firstInteger with: secondInteger negative: neg 
  	"Normalizes."
  	| firstLen secondLen shortInt shortLen longInt longLen prod |
  	firstLen := self byteSizeOfLargeInt: firstInteger.
  	secondLen := self byteSizeOfLargeInt: secondInteger.
  	firstLen <= secondLen
  		ifTrue: 
  			[shortInt := firstInteger.
  			shortLen := firstLen.
  			longInt := secondInteger.
  			longLen := secondLen]
  		ifFalse: 
  			[shortInt := secondInteger.
  			shortLen := secondLen.
  			longInt := firstInteger.
  			longLen := firstLen].
  	self remapOop: #(shortInt longInt) in: [prod := self createLargeIntegerNeg: neg byteLength: longLen + shortLen].
  	self
+ 		cDigitMultiply: (self pointerToFirstDigitOfLargeInt: shortInt)
- 		cDigitMultiply: (self firstIndexableField: shortInt as: #'unsigned int *')
  		len: shortLen + 3 // 4
+ 		with: (self pointerToFirstDigitOfLargeInt: longInt)
- 		with: (self firstIndexableField: longInt as: #'unsigned int *')
  		len: longLen + 3 // 4
+ 		into: (self pointerToFirstDigitOfLargeInt: prod)
- 		into: (self firstIndexableField: prod as: #'unsigned int *')
  		len: longLen + shortLen + 3 // 4.
  	^neg 
  		ifTrue: [self normalizeNegative: prod]
  		ifFalse: [self normalizePositive: prod]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitSubLarge:with: (in category 'oop functions') -----
  digitSubLarge: firstInteger with: secondInteger 
  	"Normalizes."
  	| firstDigitLen secondDigitLen larger largeDigitLen smaller smallerDigitLen neg resDigitLen res firstNeg |
  	firstNeg := (interpreterProxy fetchClassOf: firstInteger)
  				= interpreterProxy classLargeNegativeInteger.
  	firstDigitLen := self digitSizeOfLargeInt: firstInteger.
  	secondDigitLen := self digitSizeOfLargeInt: secondInteger.
  	firstDigitLen = secondDigitLen ifTrue: 
  		[[firstDigitLen > 1
  		  and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) = (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]]
  			whileTrue: [firstDigitLen := firstDigitLen - 1].
  		secondDigitLen := firstDigitLen].
  	(firstDigitLen < secondDigitLen
  	 or: [firstDigitLen = secondDigitLen
  		 and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) < (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]])
  		ifTrue: 
  			[larger := secondInteger.
  			largeDigitLen := secondDigitLen.
  			smaller := firstInteger.
  			smallerDigitLen := firstDigitLen.
  			neg := firstNeg == false]
  		ifFalse: 
  			[larger := firstInteger.
  			largeDigitLen := firstDigitLen.
  			smaller := secondInteger.
  			smallerDigitLen := secondDigitLen.
  			neg := firstNeg].
  	resDigitLen := largeDigitLen.
  	self remapOop: #(smaller larger)
  		in: [res := self createLargeIntegerNeg: neg digitLength: resDigitLen].
  	self
+ 		cDigitSub: (self pointerToFirstDigitOfLargeInt: smaller)
- 		cDigitSub: (self firstIndexableField: smaller as: #'unsigned int *')
  		len: smallerDigitLen
+ 		with: (self pointerToFirstDigitOfLargeInt: larger)
- 		with: (self firstIndexableField: larger as: #'unsigned int *')
  		len: largeDigitLen
+ 		into: (self pointerToFirstDigitOfLargeInt: res).
- 		into: (self firstIndexableField: res as: #'unsigned int *').
  	^neg 
  		ifTrue: [self normalizeNegative: res]
  		ifFalse: [self normalizePositive: res]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>highBitOfLargeInt: (in category 'util') -----
  highBitOfLargeInt: anOop 
  	<inline: true>
  	^ self
+ 		cDigitHighBit: (self pointerToFirstDigitOfLargeInt: anOop)
- 		cDigitHighBit: (self firstIndexableField: anOop as: #'unsigned int *')
  		len: (self digitSizeOfLargeInt: anOop)!

Item was changed:
  ----- Method: LargeIntegersPlugin>>largeInt:growTo: (in category 'oop util') -----
  largeInt: aBytesObject growTo: newByteLen 
  	"Attention: this method invalidates all oop's!! Only newBytes is valid at return."
  	"Does not normalize."
  	| newBytes oldDigitLen newDigitLen copyLen |
  	self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject)
  					indexableSize: newByteLen].
  	newDigitLen := newByteLen + 3 // 4.
  	oldDigitLen := self digitSizeOfLargeInt: aBytesObject.
  	copyLen := oldDigitLen < newDigitLen
  					ifTrue: [oldDigitLen]
  					ifFalse: [newDigitLen].
  	self
+ 		cDigitCopyFrom: (self pointerToFirstDigitOfLargeInt: aBytesObject)
+ 		to: (self pointerToFirstDigitOfLargeInt: newBytes)
- 		cDigitCopyFrom: (self firstIndexableField: aBytesObject as: #'unsigned int *')
- 		to: (self firstIndexableField: newBytes as: #'unsigned int *')
  		len: copyLen.
  	^newBytes!

Item was added:
+ ----- Method: LargeIntegersPlugin>>pointerToFirstDigitOfLargeInt: (in category 'util') -----
+ pointerToFirstDigitOfLargeInt: bytesObject
+ 	<inline: true>
+ 	<returnTypeC: #'unsigned int'>
+ 	^interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObject) to: #'unsigned int *'!

Item was changed:
  ----- Method: LargeIntegersPlugin>>unsafeByteOfLargeInt:at: (in category 'util') -----
  unsafeByteOfLargeInt: bytesObj at: ix
  	"Argument bytesObj must not be aSmallInteger!!"
  	<inline: true>
  	<returnTypeC: #'unsigned char'>
+ 	^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1!
- 	^(self firstIndexableField: bytesObj as: #'unsigned char *') at: ix - 1!

Item was changed:
  ----- Method: LargeIntegersPlugin>>unsafeDigitOfLargeInt:at: (in category 'util') -----
  unsafeDigitOfLargeInt: anOop at: ix
  	"Argument must not be aSmallInteger!!"
  	<inline: true>
  	<returnTypeC: #'unsigned int'>
+ 	^self cDigitOf: (self pointerToFirstDigitOfLargeInt: anOop) at: ix - 1!
- 	^self cDigitOf: (self firstIndexableField: anOop as: #'unsigned int *') at: ix - 1!

More information about the Vm-dev mailing list