[Vm-dev] VM Maker: VMMaker.oscog-rmacnak.1572.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Dec 10 07:30:18 UTC 2015


Ryan Macnak uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-rmacnak.1572.mcz

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

Name: VMMaker.oscog-rmacnak.1572
Author: rmacnak
Time: 9 December 2015, 11:28:54.749 pm
UUID: afb2ce9f-ad99-49c5-9ce1-935b47c0251a
Ancestors: VMMaker.oscog-eem.1571

MIPS: Get simulation up to the second compaction, stopping at unimplemented access of a Newspeak send cache.

Teach the Cogit how to do compaction when intra-zone calls have absolute targets.

Fix stupid bug in relocating long jumps wherein the jump was retargeted to (nearby) its own (precompaction) address.

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

Item was added:
+ ----- Method: CogARMCompiler>>zoneCallsAreRelative (in category 'inline cacheing') -----
+ zoneCallsAreRelative
+ 	"Answer if Call and JumpLong are relative and hence need to take the caller's
+ 	 relocation delta into account during code compaction, rather than just the
+ 	 callee's delta."
+ 	^true!

Item was added:
+ ----- Method: CogAbstractInstruction>>zoneCallsAreRelative (in category 'inline cacheing') -----
+ zoneCallsAreRelative
+ 	"Answer if Call and JumpLong are relative and hence need to take the caller's
+ 	 relocation delta into account during code compaction, rather than just the
+ 	 callee's delta."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogIA32Compiler>>zoneCallsAreRelative (in category 'inline cacheing') -----
+ zoneCallsAreRelative
+ 	"Answer if Call and JumpLong are relative and hence need to take the caller's
+ 	 relocation delta into account during code compaction, rather than just the
+ 	 callee's delta."
+ 	^true!

Item was changed:
  ----- Method: CogMIPSELCompiler>>relocateJumpLongBeforeFollowingAddress:by: (in category 'inline cacheing') -----
  relocateJumpLongBeforeFollowingAddress: pc by: delta	
  	"lui t9, stub/targetHigh
  	 ori t9, t9, stub/targetLow
  	 jr t9
  	 nop (delay slot)
  	 ...  <-- pc"
  
+ 	| oldTarget newTarget |
- 	| target |
  	self assert: delta \\ 4 = 0.
  	delta = 0 ifTrue: [^self].
  	
  	self assert: (self opcodeAtAddress: pc - 16) = LUI.
  	self assert: (self opcodeAtAddress: pc - 12) = ORI.
  	self assert: (self opcodeAtAddress: pc - 8) = SPECIAL.
  	self assert: (self functionAtAddress: pc - 8) = JR.
  	self assert: (objectMemory longAt: pc - 4) = self nop.
  	"cogit disassembleFrom: pc - 16 to: pc."
  
+ 	oldTarget := self literalAtAddress: pc - 12.
+ 	newTarget := oldTarget + delta.
+ 	self literalAtAddress: pc - 12 put: newTarget.
- 	target := self literalAtAddress: pc - 12.
- 	target := target + delta.
- 	self literalAtAddress: pc - 12 put: pc.
  
  	self assert: (self opcodeAtAddress: pc - 16) = LUI.
  	self assert: (self opcodeAtAddress: pc - 12) = ORI.
  	self assert: (self opcodeAtAddress: pc - 8) = SPECIAL.
  	self assert: (self functionAtAddress: pc - 8) = JR.
  	self assert: (objectMemory longAt: pc - 4) = self nop.
  	"cogit disassembleFrom: pc - 16 to: pc."!

Item was changed:
  ----- Method: CogMIPSELCompiler>>rewriteJTypeAtAddress:delta: (in category 'inline cacheing') -----
  rewriteJTypeAtAddress: mcpc delta: delta
+ 	| oldTarget newTarget |
+ 	oldTarget := self targetFromJTypeAtAddress: mcpc.
+ 	newTarget := oldTarget + delta.
+ 	self rewriteJTypeAtAddress: mcpc target: newTarget.!
- 	| target |
- 	target := self targetFromJTypeAtAddress: mcpc.
- 	target := target + delta.
- 	self rewriteJTypeAtAddress: mcpc target: target.!

Item was added:
+ ----- Method: CogMIPSELCompiler>>zoneCallsAreRelative (in category 'inline cacheing') -----
+ zoneCallsAreRelative
+ 	"Answer if Call and JumpLong are relative and hence need to take the caller's
+ 	 relocation delta into account during code compaction, rather than just the
+ 	 callee's delta."
+ 	^false!

Item was added:
+ ----- Method: CogX64Compiler>>zoneCallsAreRelative (in category 'inline cacheing') -----
+ zoneCallsAreRelative
+ 	"Answer if Call and JumpLong are relative and hence need to take the caller's
+ 	 relocation delta into account during code compaction, rather than just the
+ 	 callee's delta."
+ 	^true!

Item was changed:
  ----- Method: Cogit>>relocateCallsAndSelfReferencesInMethod: (in category 'compaction') -----
  relocateCallsAndSelfReferencesInMethod: cogMethod
  	<var: #cogMethod type: #'CogMethod *'>
+ 	| refDelta callDelta |
+ 	refDelta := cogMethod objectHeader.
+ 	callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
+ 	
- 	| delta |
- 	delta := cogMethod objectHeader.
  	self assert: (cogMethod cmType = CMMethod or: [cogMethod cmType = CMOpenPIC]).
  	self assert: (backEnd callTargetFromReturnAddress: cogMethod asInteger + missOffset)
  				= (cogMethod cmType = CMMethod
  					ifTrue: [self methodAbortTrampolineFor: cogMethod cmNumArgs]
  					ifFalse: [self picAbortTrampolineFor: cogMethod cmNumArgs]).
+ 	backEnd relocateCallBeforeReturnPC: cogMethod asInteger + missOffset by: callDelta negated.
- 	backEnd relocateCallBeforeReturnPC: cogMethod asInteger + missOffset by: delta negated.
  	self mapFor: cogMethod
  		performUntil: #relocateIfCallOrMethodReference:mcpc:delta:
+ 		arg: refDelta!
- 		arg: delta!

Item was changed:
  ----- Method: Cogit>>relocateCallsInClosedPIC: (in category 'compaction') -----
  relocateCallsInClosedPIC: cPIC
  	<var: #cPIC type: #'CogMethod *'>
+ 	| refDelta callDelta pc entryPoint targetMethod |
- 	| delta pc entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
+ 	refDelta := cPIC objectHeader.
+ 	callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
+ 	
- 	delta := cPIC objectHeader.
  	self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger + missOffset)
  					= (self picAbortTrampolineFor: cPIC cmNumArgs).
+ 	backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: callDelta negated.
- 	backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: delta negated.
  
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	1 to: cPIC cPICNumCases do:
  		[:i|
  		pc := self addressOfEndOfCase: i inCPIC: cPIC.
  		entryPoint := i = 1
  						ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
  						ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(cPIC containsAddress: entryPoint) ifFalse:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: targetMethod cmType = CMMethod.
  			 i = 1 ifTrue:
  				[backEnd
  					relocateJumpLongBeforeFollowingAddress: pc
+ 					by: (callDelta - targetMethod objectHeader) negated]
- 					by: (delta - targetMethod objectHeader) negated]
  				ifFalse:
  				[backEnd
  					relocateJumpLongConditionalBeforeFollowingAddress: pc
+ 					by: (callDelta - targetMethod objectHeader) negated]]].
- 					by: (delta - targetMethod objectHeader) negated]]].
  	self assert: cPIC cPICNumCases > 0.
  
  	"Finally relocate the load of the PIC and the jump to the overflow routine ceCPICMiss:receiver:"
+ 	backEnd relocateMethodReferenceBeforeAddress: (self addressOfEndOfCase: 2 inCPIC: cPIC)+ backEnd loadPICLiteralByteSize by: refDelta.
+ 	backEnd relocateJumpLongBeforeFollowingAddress: cPIC asInteger + cPICEndOfCodeOffset by: callDelta negated!
- 	backEnd relocateMethodReferenceBeforeAddress: (self addressOfEndOfCase: 2 inCPIC: cPIC)+ backEnd loadPICLiteralByteSize by: delta.
- 	backEnd relocateJumpLongBeforeFollowingAddress: cPIC asInteger + cPICEndOfCodeOffset by: delta negated!

Item was changed:
  ----- Method: Cogit>>relocateIfCallOrMethodReference:mcpc:delta: (in category 'compaction') -----
+ relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: refDelta
- relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: delta
  	<var: #mcpc type: #'char *'>
+ 	| callDelta entryPoint targetMethod unlinkedRoutine |
- 	| entryPoint targetMethod unlinkedRoutine |
  	<var: #targetMethod type: #'CogMethod *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  
+ 	callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
+ 	
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache |
  		 annotation = IsNSSendCall ifTrue:
  			["Retrieve the send cache before relocating the stub call. Fetching the send
  			  cache asserts the stub call points below all the cogged methods, but
  			  until this method is actually moved, the adjusted stub call may appear to
  			  point to somewhere in the method zone."
  			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  
  			"Fix call to trampoline. This method is moving [delta] bytes, and calls are
  			 relative, so adjust the call by -[delta] bytes"
+ 			backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
- 			backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  
  			nsSendCache target ~= 0 ifTrue: "Send is linked"
  				[entryPoint := nsSendCache target.
  				targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  				targetMethod cmType = CMMethod
  					ifTrue: "send target not freed; just relocate. The cache has an absolute
  							target, so only adjust by the target method's displacement."
  						[nsSendCache target: entryPoint + targetMethod objectHeader]
  					ifFalse: "send target was freed, unlink"
  						[self voidNSSendCache: nsSendCache]].
  			^0]].
  
  	(self isPureSendAnnotation: annotation) ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		entryPoint <= methodZoneBase ifTrue: "send is not linked; just relocate"
+ 			[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
- 			[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  			 ^0].
  		"It's a linked send; find which kind."
  		self
  			offsetAndSendTableFor: entryPoint
  			annotation: annotation
  			into: [:offset :sendTable|
  				 targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
  				 targetMethod cmType ~= CMFree ifTrue: "send target not freed; just relocate."
  					[backEnd
  						relocateCallBeforeReturnPC: mcpc asInteger
+ 						by: (callDelta - targetMethod objectHeader) negated.
- 						by: (delta - targetMethod objectHeader) negated.
  					 SistaVM ifTrue: "See comment in planCompaction"
  						[methodZone restorePICUsageCount: targetMethod].
  					 ^0].
  				 "Target was freed; map back to an unlinked send; but include this method's reocation"
  				 unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
+ 				 unlinkedRoutine := unlinkedRoutine - callDelta.
- 				 unlinkedRoutine := unlinkedRoutine - delta.
  				 backEnd
  					rewriteInlineCacheAt: mcpc asInteger
  					tag: targetMethod selector
  					target: unlinkedRoutine.
  				 ^0]].
  
  	annotation = IsRelativeCall ifTrue:
+ 		[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
- 		[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  		 ^0].
  
  	annotation = IsAbsPCReference ifTrue:
+ 		[backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: refDelta].
- 		[backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: delta].
  
  	^0 "keep scanning"!



More information about the Vm-dev mailing list