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

commits at source.squeak.org commits at source.squeak.org
Tue Apr 12 21:54:11 UTC 2016


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

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

Name: VMMaker.oscog-nice.1798
Author: nice
Time: 12 April 2016, 11:49:11.283 pm
UUID: 73ccb805-35ae-4fef-a22d-12e0c069bb32
Ancestors: VMMaker.oscog-cb.1797

1) If CogMethodZone is not given a chance to initializationOptions:,  then

theCCodeGenerator shouldIncludeMethodFor: CogMethodZone selector: #followForwardedLiteralsInOpenPICList

will answer false even for a SpurObjectMemory.

Let's give this chance to any ancillaryClasses: now that this solution has been blessed by Eliot mail :)

This restores the ability to generate suprsrc & co

2) Don't let LargeIntegersPlugin be the sole sender of stAt:put: -- this let a chance to remove some not so used VMMaker code and shrink the code area if we want to.

3) Factor out the duplicated code that is generating C integer literals
  The intention is to later change the generation, because it unecessarily generate unsigned long long when signed long long would do, and because it is not correct for long long negative int (the C Compiler can cope with this but would generate warnings) and even less correct for INT_MIN and LONG_LONG_MIN (which would be transformed as unsigned by C compiler and would most rarely meet our expectations).

4) Dispatch on the translated parse nodes for infering translated C type.
  By now, provide an exact image of previous behavior.

Type inference is for assigning a type to variables, but also essential for correctly inlining translated methods.

The mid term intention is to improve this type inference and use it in TMethod>>addTypesFor:to:in: too (which does quite the same type of job).

This may later help to relax the TMethod>>isFunctional which currently drastically limits the inlining capabilities.

These future changes may have uncontrolled side effects on generated code. They will be committed when presumed harmless for code generation of head revision (asserted thru lack of regression when running Squeak trunk tests), and in all cases after the burst of Sista activity,

=============== Diff against VMMaker.oscog-cb.1797 ===============

Item was changed:
  ----- Method: CCodeGenerator>>cLiteralFor: (in category 'C code generator') -----
  cLiteralFor: anObject
  	"Return a string representing the C literal value for the given object."
  	anObject isNumber
  		ifTrue:
  			[anObject isInteger ifTrue:
+ 				[| hex |
+ 				 hex := (anObject > 0
- 				[| printString |
- 				 printString := (anObject > 0
  								and: [(anObject >> anObject lowBit + 1) isPowerOfTwo
  								and: [(anObject highBit = anObject lowBit and: [anObject > 65536])
+ 									  or: [anObject highBit - anObject lowBit >= 4]]]).
+ 				^self cLiteralForInteger: anObject hex: hex].
- 									  or: [anObject highBit - anObject lowBit >= 4]]])
- 									ifTrue: ['0x', (anObject printStringBase: 16)]
- 									ifFalse: [anObject printString].
- 				^anObject > 16rFFFFFFFF
- 						ifTrue: [printString, ObjectMemory unsignedLongLongSuffix]
- 						ifFalse: [anObject < 16r7FFFFFFF
- 							ifTrue: [printString]
- 							ifFalse: [printString, ObjectMemory unsignedIntegerSuffix]]].
  			anObject isFloat ifTrue:
  				[^anObject printString]]
  		ifFalse:
  			[anObject isSymbol ifTrue:
  				[^self cFunctionNameFor: anObject].
  			anObject isString ifTrue:
  				[^'"', (anObject copyReplaceAll: (String with: Character cr) with: '\n') , '"'].
  			anObject == nil ifTrue: [^ 'null' ].
  			anObject == true ifTrue: [^ '1' ].
  			anObject == false ifTrue: [^ '0' ].
  			anObject isCharacter ifTrue:
  				[^anObject == $'
  					ifTrue: ['''\'''''] "i.e. '\''"
  					ifFalse: [anObject asString printString]]].
  	self error: 'Warning: A Smalltalk literal could not be translated into a C constant: ', anObject printString.
  	^'"XXX UNTRANSLATABLE CONSTANT XXX"'!

Item was changed:
  ----- Method: CCodeGenerator>>cLiteralFor:name: (in category 'C code generator') -----
  cLiteralFor: anObject name: smalltalkName
  	"Return a string representing the C literal value for the given object.
  	 This version may use hex for integers that are bit masks."
  	anObject isInteger ifTrue:
+ 		[| hex dec useHexa |
- 		[| hex dec rep |
  		hex := anObject printStringBase: 16.
  		dec := anObject printStringBase: 10.
+ 		useHexa := ((smalltalkName endsWith: 'Mask')
- 		rep := ((smalltalkName endsWith: 'Mask')
  				or: [anObject digitLength > 1
  					and: [(hex asSet size * 3) <= (dec asSet size * 2)
+ 					and: [(smalltalkName endsWith: 'Size') not]]]).
+ 		^self cLiteralForInteger: anObject hex: useHexa].
- 					and: [(smalltalkName endsWith: 'Size') not]]])
- 					ifTrue: [hex first = $- ifTrue: ['-0x', hex allButFirst] ifFalse: ['0x', hex]]
- 					ifFalse: [dec].
- 		^anObject > 16rFFFFFFFF
- 			ifTrue: [rep, ObjectMemory unsignedLongLongSuffix]
- 			ifFalse: [anObject < 16r7FFFFFFF
- 				ifTrue: [rep]
- 				ifFalse: [rep, ObjectMemory unsignedIntegerSuffix]]].
  	^self cLiteralFor: anObject!

Item was added:
+ ----- Method: CCodeGenerator>>cLiteralForInteger:hex: (in category 'C code generator') -----
+ cLiteralForInteger: anInteger hex: aBoolean
+ 	| printString |
+ 	printString := aBoolean
+ 		ifTrue: [anInteger positive
+ 			ifTrue: ['0x' , anInteger printStringBase: 16]
+ 			ifFalse: ['-0x' , anInteger negated printStringBase: 16]]
+ 		ifFalse: [anInteger printString].
+ 	^anInteger > 16rFFFFFFFF
+ 			ifTrue: [printString, ObjectMemory unsignedLongLongSuffix]
+ 			ifFalse: [anInteger < 16r7FFFFFFF
+ 					ifTrue: [printString]
+ 					ifFalse: [printString, ObjectMemory unsignedIntegerSuffix]]!

Item was changed:
  ----- Method: CCodeGenerator>>typeFor:in: (in category 'type inference') -----
  typeFor: aNode in: aTMethod
+ 	^aNode typeFrom: self in: aTMethod!
- 	aNode isVariable ifTrue:
- 		[^(aTMethod typeFor: aNode in: self) ifNil: [#sqInt]].
- 	aNode isSend ifTrue:
- 		[^self returnTypeForSend: aNode in: aTMethod].
- 	^#sqInt!

Item was changed:
  ----- Method: Cogit class>>initializeWithOptions: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionary
+ 	{ self. CogMethodSurrogate. } , (self ancilliaryClasses: optionsDictionary) do:
- 	{ self. CogMethod. CogMethodSurrogate. CogObjectRepresentation } do:
  		[:aSuperclass|
  		 aSuperclass withAllSubclasses do:
  			[:class| class initializationOptions: optionsDictionary]].
  	super initializeWithOptions: optionsDictionary.
  	self initializeMiscConstants. "must precede other initialization."
  	self initializeErrorCodes.
  	self initializeCogMethodConstants.
  	self initializeAnnotationConstants.
  	self initializeBytecodeTable.
  	self initializeNumTrampolines.
  	self initializePrimitiveTable!

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].
+ 			interpreterProxy stObject: result at: 1 put: (0 asOop: SmallInteger).
+ 			interpreterProxy stObject: result at: 2 put: firstInteger.
- 			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)
  		len: (self digitSizeOfLargeInt: div)
  		rem: (self pointerToFirstDigitOfLargeInt: rem)
  		len: (self digitSizeOfLargeInt: rem)
  		quo: (self pointerToFirstDigitOfLargeInt: quo)
  		len: (self digitSizeOfLargeInt: quo).
  	self remapOop: #(quo ) in: [rem := self
  					digit: rem
  					Rshift: d
  					lookfirst: (self digitSizeOfLargeInt: div)
  							- 1].
  	"^ Array with: quo with: rem"
  	self remapOop: #(quo rem ) in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
+ 	interpreterProxy stObject: result at: 1 put: quo.
+ 	interpreterProxy stObject: result at: 2 put: rem.
- 	result stAt: 1 put: quo.
- 	result stAt: 2 put: rem.
  	^ result!

Item was added:
+ ----- Method: TConstantNode>>typeOrNilFrom:in: (in category 'type inference') -----
+ typeOrNilFrom: aCodeGenerator in: aTMethod
+ 	"For integers, answer int unless the value does not fit into a 32bits signed int.
+ 	In that case, answer the shortest integer type that could hold the constant in order to match C behavior."
+ 	| hb |
+ 	value isInteger
+ 		ifTrue:
+ 			[value positive
+ 				ifTrue:
+ 					[hb := value highBit.
+ 					hb < 32 ifTrue: [^#int].
+ 					hb = 32 ifTrue: [^#'unsigned int'].
+ 					hb = 64 ifTrue: [^#'unsigned long long'].
+ 					^#'long long']
+ 				ifFalse:
+ 					[hb := value bitInvert highBit.
+ 					hb < 32 ifTrue: [^#int].
+ 					^#'long long']].
+ 	value isFloat ifTrue: [^#double].
+ 	(#(nil true false) includes: value) ifTrue: [^#int].
+ 	^nil!

Item was added:
+ ----- Method: TParseNode>>typeFrom:in: (in category 'type inference') -----
+ typeFrom: aCodeGenerator in: aTMethod
+ 	"This is the default type in case of doubt"
+ 	^(self typeOrNilFrom: aCodeGenerator in: aTMethod) ifNil: [#sqInt]!

Item was added:
+ ----- Method: TParseNode>>typeOrNilFrom:in: (in category 'type inference') -----
+ typeOrNilFrom: aCodeGenerator in: aTMethod
+ 	"When we don't know, it's nil"
+ 	^nil!

Item was added:
+ ----- Method: TSendNode>>typeOrNilFrom:in: (in category 'type inference') -----
+ typeOrNilFrom: aCodeGenerator in: aTMethod
+ 	^aCodeGenerator returnTypeForSend: self in: aTMethod!

Item was added:
+ ----- Method: TVariableNode>>typeOrNilFrom:in: (in category 'type inference') -----
+ typeOrNilFrom: aCodeGenerator in: aTMethod
+ 	^aTMethod typeFor: self in: aCodeGenerator!



More information about the Vm-dev mailing list