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

commits at source.squeak.org commits at source.squeak.org
Sat Dec 12 22:28:04 UTC 2015


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

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

Name: VMMaker.oscog-rmacnak.1586
Author: rmacnak
Time: 12 December 2015, 2:26:39.384 pm
UUID: 8e44b2a7-68ee-4fc9-8513-a04520267053
Ancestors: VMMaker.oscog-eem.1585

MIPS: Get simulation through part of the Newspeak test suite. Fail at a bad cPIC value flowing into ceCPICMiss:receiver:.

(Noting that the access control tests fail in the simulator, even with IA32, which is worrying as they pass in the compiled VM.)

Add access to a Newspeak send cache from the send site's return address.

Adjust MNU/interpret cPIC entries (i.e., jumps within the cPIC) during relocation when zone calls are absolute.

Fix literalBeforeFollowingAddress: decoding PushCw.

Fix MNU in cPICHasForwardedClass:.

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

Item was removed:
- ----- Method: CogAbstractInstruction>>implicitReceiveCacheAt: (in category 'inline cacheing') -----
- implicitReceiveCacheAt: callSiteReturnAddress
- 	"Answer the implicit receiver cache for the return address
- 	 of a call to the ceImplicitReceiverTrampoline."
- 	<option: #NewspeakVM>
- 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogAbstractInstruction>>nsSendCacheAt: (in category 'inline cacheing') -----
+ nsSendCacheAt: callSiteReturnAddress
+ 	"Answer the NSSendCache for the return address of a Newspeak
+ 	 self, super, outer, or implicit receiver send."
+ 	<option: #NewspeakVM>
+ 	^self subclassResponsibility!

Item was removed:
- ----- Method: CogIA32Compiler>>implicitReceiveCacheAt: (in category 'inline cacheing') -----
- implicitReceiveCacheAt: callSiteReturnAddress
- 	"Answer the implicit receiver cache for the return address
- 	 of a call to the ceImplicitReceiverTrampoline."
- 	<option: #NewspeakVM>
- 	<var: #callSiteReturnAddress type: #'char *'>
- 	<inline: false>
- 	^self literalBeforeFollowingAddress: callSiteReturnAddress asUnsignedInteger - 5 "sizeofcall"!

Item was added:
+ ----- Method: CogIA32Compiler>>nsSendCacheAt: (in category 'inline cacheing') -----
+ nsSendCacheAt: callSiteReturnAddress
+ 	"Answer the NSSendCache for the return address of a Newspeak
+ 	 self, super, outer, or implicit receiver send."
+ 	<option: #NewspeakVM>
+ 	<var: #callSiteReturnAddress type: #'char *'>
+ 	<inline: false>
+ 	^self literalBeforeFollowingAddress: callSiteReturnAddress asUnsignedInteger - 5 "sizeofcall"!

Item was removed:
- ----- Method: CogInLineLiteralsARMCompiler>>implicitReceiveCacheAt: (in category 'inline cacheing') -----
- implicitReceiveCacheAt: callSiteReturnAddress
- 	"Answer the implicit receiver cache for the return address
- 	 of a call to one of the ceImplicitReceiver... trampolines."
- 	self assert: (self instructionIsBL: (self instructionBeforeAddress: callSiteReturnAddress)).
- 	^self extract32BitOperandFrom4InstructionsPreceding: callSiteReturnAddress - 4!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>nsSendCacheAt: (in category 'inline cacheing') -----
+ nsSendCacheAt: callSiteReturnAddress
+ 	"Answer the NSSendCache for the return address of a Newspeak
+ 	 self, super, outer, or implicit receiver send."
+ 	self assert: (self instructionIsBL: (self instructionBeforeAddress: callSiteReturnAddress)).
+ 	^self extract32BitOperandFrom4InstructionsPreceding: callSiteReturnAddress - 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
  literalBeforeFollowingAddress: followingAddress
  	"Answer the literal embedded in the instruction immediately preceding followingAddress.
+ 	 This is used in the MoveCwR, PushCw and CmpCwR cases."
- 	 This is used in the MoveCwR, PushCwR and CmpCwR cases."
  	
+ 	"Cmp/MoveCwR
+ 	 pc-8	lui rx, uper
+ 	 pc-4	ori rx, rx, lower"
+ 	(self opcodeAtAddress: followingAddress - 4) = ORI ifTrue:
+ 		[^self literalAtAddress: followingAddress - 4].
- 	"lui/ori, lui/ori/sw/addi, lui/ori/subu/slt/slt/sltu/sltu"
  	
+ 	"PushCw
+ 	 pc-16	lui at, upper
+ 	 pc-12	ori at, at, lower
+ 	 pc-8	addiu sp, sp, -4
+ 	 pc-4	sw at, 0(sp)"
+ 	((self opcodeAtAddress: followingAddress - 4) = SW and:
+ 		[(self opcodeAtAddress: followingAddress - 8) = ADDIU]) ifTrue:
+ 			[^self literalAtAddress: followingAddress - 12].
+ 	
+ 	self unreachable.
+ 	^0!
- 	| lastOpcode lastFunction oriAddress |
- 	lastOpcode := self opcodeAtAddress: followingAddress - 4.
- 	lastFunction := self functionAtAddress: followingAddress - 4.
- 	oriAddress := 0.
- 	lastOpcode = ORI ifTrue: [oriAddress := followingAddress - 4].
- 	lastOpcode = ADDIU ifTrue: [oriAddress := followingAddress - 16].
- 	(lastOpcode = SPECIAL and: [lastFunction = SUBU]) ifTrue: [oriAddress := followingAddress - 8].
- 	self assert: oriAddress ~= 0.
- 	^self literalAtAddress: oriAddress
- !

Item was added:
+ ----- Method: CogMIPSELCompiler>>nsSendCacheAt: (in category 'inline cacheing') -----
+ nsSendCacheAt: callSiteReturnAddress
+ 	"Answer the NSSendCache for the return address of a Newspeak
+ 	 self, super, outer, or implicit receiver send."
+ 	<option: #NewspeakVM>
+ 	
+ 	"ra - 24 lui s4, cacheHigh
+ 	 ra - 20 ori s4, s4, cacheLow
+ 	 ra - 16 lui t9, stubHigh
+ 	 ra - 12 ori t9, t9, stubLow
+ 	 ra - 8 jalr t9
+ 	 ra - 4 nop (delay slot)"
+ 	self assert: (self opcodeAtAddress: callSiteReturnAddress - 24) = LUI.
+ 	self assert: (self opcodeAtAddress: callSiteReturnAddress - 20) = ORI.
+ 	self assert: (self opcodeAtAddress: callSiteReturnAddress - 16) = LUI.
+ 	self assert: (self opcodeAtAddress: callSiteReturnAddress - 12) = ORI.
+ 	self assert: (self opcodeAtAddress: callSiteReturnAddress - 8) = SPECIAL.
+ 	self assert: (self functionAtAddress: callSiteReturnAddress - 8) = JALR.
+ 	self assert: (objectMemory longAt: callSiteReturnAddress - 4) = self nop.
+ 	"cogit disassembleFrom: callSiteReturnAddress - 16 to: callSiteReturnAddress."
+ 	^self literalAtAddress: callSiteReturnAddress - 20!

Item was removed:
- ----- Method: CogOutOfLineLiteralsARMCompiler>>implicitReceiveCacheAt: (in category 'inline cacheing') -----
- implicitReceiveCacheAt: callSiteReturnAddress
- 	"Answer the implicit receiver cache for the return address
- 	 of a call to one of the ceImplicitReceiver... trampolines."
- 	<inline: true>
- 	^objectMemory longAt: (self pcRelativeAddressAt: (callSiteReturnAddress - 8) asUnsignedInteger)!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>nsSendCacheAt: (in category 'inline cacheing') -----
+ nsSendCacheAt: callSiteReturnAddress
+ 	"Answer the NSSendCache for the return address of a Newspeak
+ 	 self, super, outer, or implicit receiver send."
+ 	<inline: true>
+ 	^objectMemory longAt: (self pcRelativeAddressAt: (callSiteReturnAddress - 8) asUnsignedInteger)!

Item was changed:
  ----- Method: Cogit>>cPICHasForwardedClass: (in category 'in-line cacheing') -----
  cPICHasForwardedClass: cPIC 
  	"The first case in a CPIC doesn't have a class reference so we need only step over actually usd subsequent cases."
  	| pc |
  	<var: #cPIC type: #'CogMethod *'>
  	"start by finding the address of the topmost case, the cPICNumCases'th one"
  	pc := (self addressOfEndOfCase: cPIC cPICNumCases inCPIC: cPIC)
  				- backEnd jumpLongConditionalByteSize.
  	2 to: cPIC cPICNumCases do: 
  			[:i |  | classIndex |
+ 			classIndex := backEnd literal32BeforeFollowingAddress: pc.
- 			classIndex := literalsManager backEnd literal32BeforeFollowingAddress: pc.
  			(objectMemory isForwardedClassIndex: classIndex)
  				ifTrue: [^ true].
  			"since we started at the top, we can just add the case size each time to move on to the next case"
  			pc := pc + cPICCaseSize].
  	^ false!

Item was changed:
  ----- Method: Cogit>>nsSendCacheFromReturnAddress: (in category 'newspeak support') -----
  nsSendCacheFromReturnAddress: mcpc
  	"Caller looks like
  			mov LcacheAddress, SendNumArgsReg
  			call ceImplicitReceiver"
  	<option: #NewspeakVM>
  	<var: #mcpc type: #'char *'>
  	<inline: true>
  	| entryPoint cacheAddress |
  	entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  	self assert: entryPoint < methodZoneBase.
+ 	cacheAddress := (backEnd nsSendCacheAt: mcpc) asUnsignedInteger.
- 	cacheAddress := (backEnd implicitReceiveCacheAt: mcpc) asUnsignedInteger.
  	self assert: (objectMemory isInOldSpace: cacheAddress).
  	^self cCoerceSimple: cacheAddress to: #'NSSendCache *'
  !

Item was changed:
  ----- Method: Cogit>>relocateCallsInClosedPIC: (in category 'compaction') -----
  relocateCallsInClosedPIC: cPIC
  	<var: #cPIC type: #'CogMethod *'>
  	| refDelta callDelta pc entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
  	refDelta := cPIC objectHeader.
  	callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
  	
  	self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger + missOffset)
  					= (self picAbortTrampolineFor: cPIC cmNumArgs).
  	backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: callDelta 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].
+ 		(cPIC containsAddress: entryPoint) 
+ 			ifTrue: 
+ 			["Interpret/MNU"
+ 			backEnd zoneCallsAreRelative ifFalse: [
+ 				i = 1 ifTrue:
+ 					[backEnd
+ 						relocateJumpLongBeforeFollowingAddress: pc
+ 						by: refDelta]
+ 					ifFalse:
+ 					[backEnd
+ 						relocateJumpLongConditionalBeforeFollowingAddress: pc
+ 						by: refDelta]]]
+ 			ifFalse:
- 		"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]
  				ifFalse:
  				[backEnd
  					relocateJumpLongConditionalBeforeFollowingAddress: pc
  					by: (callDelta - 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!



More information about the Vm-dev mailing list