[Vm-dev] VM Maker: VMMaker.oscog-eem.2252.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Jul 8 00:07:07 UTC 2017


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2252.mcz

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

Name: VMMaker.oscog-eem.2252
Author: eem
Time: 7 July 2017, 5:06:09.422305 pm
UUID: 2f3e9b0e-ecd3-4adf-b092-cce2e2587a5c
Ancestors: VMMaker.oscog-eem.2251

SpurImageSegments
Fix some signed comparisons in mapOopsAndValidateClassRefsFrom:to:outPointers:.

Add class side analysis a la SpurPlanningCompactor.

Slang:
Propagate types from "ible" to "var" in "var := ible := expr" when inferring types from assignments.

=============== Diff against VMMaker.oscog-eem.2251 ===============

Item was added:
+ ----- Method: SpurMemoryManager class>>identify32BitSignedComparisonsInSegmentIO (in category 'analysis') -----
+ identify32BitSignedComparisonsInSegmentIO
+ 	"self identify32BitSignedComparisonsInSegmentIO"
+ 	self identifySignedComparisonsFor: #(ObjectMemory Spur32BitMemoryManager)
+ 		in:	(self organization listAtCategoryNamed: #'image segment in/out')
+ 		noise: #(	'classIndex* >= numOutPointers'
+ 					'count > ptr - start / self bytesPerOop'
+ 					'endSeg - segAddr < self baseHeaderSize + self bytesPerOop'
+ 					'errorCode* > 0'
+ 					'GCModeImageSegment > 0'
+ 					'hash - TopHashBit <= outIndex'
+ 					'limit - ptr <= 8'
+ 					'num* >= self numSlotsMask'
+ 					'num* <= 1'
+ 					'outIndex >= (self numSlotsOf: outPointerArray)'
+ 					'outIndex := self mapOopsFrom: * < 0'
+ 					'segAddr - segStart / 8 + self lastClassIndexPun >= TopHashBit'
+ 					'there > 0'
+ 					'* > self identityHashHalfWordMask'
+ 					'*segmentLimit >= self numSlotsMask*'
+ 					'* > self isForwardedObjectClassIndexPun'
+ 					'* > self lastClassIndexPun')!

Item was added:
+ ----- Method: SpurMemoryManager class>>identify64BitSignedComparisonsInSegmentIO (in category 'analysis') -----
+ identify64BitSignedComparisonsInSegmentIO
+ 	"self identify64BitSignedComparisonsInSegmentIO"
+ 	self identifySignedComparisonsFor: #(ObjectMemory Spur64BitMemoryManager)
+ 		in:	(self organization listAtCategoryNamed: #'image segment in/out')
+ 		noise: #(	'classIndex* >= numOutPointers'
+ 					'count > ptr - start / self bytesPerOop'
+ 					'endSeg - segAddr < self baseHeaderSize + self bytesPerOop'
+ 					'errorCode* > 0'
+ 					'GCModeImageSegment > 0'
+ 					'hash - TopHashBit <= outIndex'
+ 					'limit - ptr <= 8'
+ 					'num* >= self numSlotsMask'
+ 					'num* <= 1'
+ 					'num* > 0'
+ 					'num* < 1'
+ 					'outIndex >= (self numSlotsOf: outPointerArray)'
+ 					'outIndex := self mapOopsFrom: * < 0'
+ 					'segAddr - segStart / 8 + self lastClassIndexPun >= TopHashBit'
+ 					'there > 0'
+ 					'* > self identityHashHalfWordMask'
+ 					'*segmentLimit >= self numSlotsMask*'
+ 					'* > self isForwardedObjectClassIndexPun'
+ 					'* > self lastClassIndexPun')!

Item was added:
+ ----- Method: SpurMemoryManager class>>identifySignedComparisonsFor:in:noise: (in category 'analysis') -----
+ identifySignedComparisonsFor: options in: selectors noise: noise
+ 	"self identify32BitSignedComparisonsInSegmentIO"
+ 	"self identify64BitSignedComparisonsInSegmentIO"
+ 	| vmm cg halt |
+ 	halt := false.
+ 	vmm := (VMMaker forPlatform: 'Cross')
+ 				interpreterClass: StackInterpreter;
+ 				options: options.
+ 	cg := [vmm buildCodeGeneratorForInterpreter]
+ 			on: Notification
+ 			do: [:ex|
+ 				ex tag == #getVMMaker
+ 					ifTrue: [ex resume: vmm]
+ 					ifFalse: [ex pass]].
+ 	cg vmClass preGenerationHook: cg.
+ 	cg inferTypesForImplicitlyTypedVariablesAndMethods.
+ 	cg retainMethods: self selectors.
+ 	cg prepareMethods.
+ 	cg doInlining: true.
+ 	selectors sort do:
+ 		[:sel|
+ 		(cg methodNamed: sel) ifNotNil:
+ 			[:m|
+ 			m parseTree nodesDo:
+ 				[:node|
+ 				(node isSend
+ 				 and: [(#(< > <= >=) includes: node selector)
+ 				 and: [({node receiver. node args first } anySatisfy:
+ 						[:o| (cg typeFor: o in: m)
+ 								ifNil: [true]
+ 								ifNotNil: [:t| (cg isIntegralCType: t) and: [t first ~= $u]]])
+ 				 and: [noise noneSatisfy: [:n| n match: node printString]]]]) ifTrue:
+ 					[halt ifTrue: [self halt: node printString].
+ 					 Transcript ensureCr; nextPutAll: sel; space; print: node; flush]]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>mapOopsAndValidateClassRefsFrom:to:outPointers: (in category 'image segment in/out') -----
  mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray
  	"This is part of loadImageSegmentFrom:outPointers:.
  	 Scan through mapping oops and validating class references.  Defer
  	 entering any class objects into the class table and/or pinning objects
  	 until the second pass in assignClassIndicesAndPinFrom:to:outPointers:."
+ 	<var: 'segmentLimit' type: #usqInt>
  	| numOutPointers numSegObjs objOop |
+ 	<var: #oop type: #usqInt>
  	numOutPointers := self numSlotsOf: outPointerArray.
  	numSegObjs := 0.
  	objOop := self objectStartingAt: segmentStart.
  	[self oop: objOop isLessThan: segmentLimit] whileTrue:
  		[| classIndex hash oop mappedOop |
  		 numSegObjs := numSegObjs + 1.
  		 "No object in the segment should be marked.  If is is something is wrong."
  		 (self isMarked: objOop) ifTrue:
  			[^PrimErrInappropriate].
  		 classIndex := self classIndexOf: objOop.
  		 "validate the class ref, but don't update it until any internal classes have been added to the class table."
  		 (classIndex anyMask: TopHashBit)
  			ifTrue:
  				[classIndex := classIndex - TopHashBit.
  				 classIndex >= numOutPointers ifTrue:
  					[^PrimErrBadIndex halt].
  				 mappedOop := self fetchPointer: classIndex ofObject: outPointerArray.
  				 hash := self rawHashBitsOf: mappedOop.
  				 (hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = mappedOop]) ifFalse:
  					[^PrimErrInappropriate halt]]
  			ifFalse: "The class is contained within the segment."
  				[(oop := classIndex - self firstClassIndexPun * self allocationUnit + segmentStart) >= segmentLimit ifTrue:
  					[^PrimErrBadIndex halt].
  				 (self rawHashBitsOf: oop) ~= 0 ifTrue:
  					[^PrimErrInappropriate halt]].
  		 0 to: (self numPointerSlotsOf: objOop) - 1 do:
  			[:i|
  			 oop := self fetchPointer: i ofObject: objOop.
  			 (self isNonImmediate: oop) ifTrue:
  				[(oop anyMask: TopOopBit)
  					ifTrue:
  						[(oop := oop - TopOopBit / self bytesPerOop) >= numOutPointers ifTrue:
  							[^PrimErrBadIndex halt].
  						 mappedOop := self fetchPointer: oop ofObject: outPointerArray]
  					ifFalse:
  						[(oop bitAnd: self allocationUnit - 1) ~= 0 ifTrue:
  							[^PrimErrInappropriate halt].
  						 (mappedOop := oop + segmentStart) >= segmentLimit ifTrue:
  							[^PrimErrBadIndex halt]].
  				 self storePointerUnchecked: i ofObject: objOop withValue: mappedOop]].
  		 objOop := self objectAfter: objOop limit: segmentLimit].
  	^numSegObjs negated!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
  	"infer types for untyped variables from assignments and arithmetic uses.
  	 For debugging answer a Dictionary from var to the nodes that determined types
  	 This for debugging:
  		(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  	| alreadyExplicitlyTypedOrNotToBeTyped asYetUntyped mustBeSigned newDeclarations effectiveNodes |
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	alreadyExplicitlyTypedOrNotToBeTyped := declarations keys asSet.
  	asYetUntyped := locals copyWithoutAll: alreadyExplicitlyTypedOrNotToBeTyped.
  	mustBeSigned := Set new.
  	newDeclarations := Dictionary new.
  	effectiveNodes := Dictionary new. "this for debugging"
  	parseTree nodesDo:
  		[:node| | type var |
  		"If there is something of the form i >= 0, then i should be signed, not unsigned."
  		(node isSend
  		 and: [(locals includes: (var := node receiver variableNameOrNil))
  		 and: [(#(<= < >= >) includes: node selector)
  		 and: [node args first isConstant
  		 and: [node args first value = 0]]]]) ifTrue:
  			[mustBeSigned add: var.
  			 effectiveNodes at: var put: { #signed. node }, (effectiveNodes at: var ifAbsent: [#()])].
  		"if an assignment to an untyped local of a known type, set the local's type to that type.
  		 Only observe known sends (methods in the current set) and typed local variables."
  		(node isAssignment
  		 and: [(locals includes: (var := node variable name))
  		 and: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not]]) ifTrue: "don't be fooled by previously inferred types"
  		 	[type := node expression isSend
  						ifTrue: [aCodeGen returnTypeForSend: node expression in: self ifNil: nil]
+ 						ifFalse: [self typeFor: (node expression isAssignment
+ 													ifTrue: [node expression variable]
+ 													ifFalse: [node expression]) in: aCodeGen].
- 						ifFalse: [self typeFor: node expression in: aCodeGen].
  			 type "If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being"
  				ifNil: "Further, if the type derives from an as-yet-untyped method, we must defer."
  					[alreadyExplicitlyTypedOrNotToBeTyped add: var.
  					 (node expression isSend
  					 and: [(aCodeGen methodNamed: node expression selector) notNil]) ifTrue:
  						[newDeclarations removeKey: var ifAbsent: nil]]
  				ifNotNil: "Merge simple types (but *don't* merge untyped vars); complex types must be defined by the programmer."
  					[(aCodeGen isSimpleType: type) ifTrue:
  						[(asYetUntyped includes: var)
  							ifTrue: [newDeclarations at: var put: type, ' ', var. asYetUntyped remove: var]
  							ifFalse:
  								[aCodeGen mergeTypeOf: var in: newDeclarations with: type method: self].
  						 effectiveNodes at: var put: { newDeclarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]]]].
  	mustBeSigned do:
  		[:var|
  		 (newDeclarations at: var ifAbsent: nil) ifNotNil:
  			[:decl| | type |
  			 type := aCodeGen extractTypeFor: var fromDeclaration: decl.
  			 type first == $u ifTrue:
  				[newDeclarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var]]].
  	newDeclarations keysAndValuesDo:
  		[:var :decl| declarations at: var put: decl].
  	^effectiveNodes!



More information about the Vm-dev mailing list