[Vm-dev] VM Maker: VMMaker.oscog-cb.1752.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Mar 31 15:25:30 UTC 2016


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

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

Name: VMMaker.oscog-cb.1752
Author: cb
Time: 31 March 2016, 5:23:26.805 pm
UUID: f33aacb8-6e6e-4aae-a6dc-18f006b76afd
Ancestors: VMMaker.oscog-eem.1751

Attempt to make multiple trampolines instead of 1 for the store trampolines. By changing in 1 place the code (numStoreTrampolines), choose how many trampolines you want.

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

Item was changed:
  CogObjectRepresentation subclass: #CogObjectRepresentationForSpur
+ 	instanceVariableNames: 'ceScheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline ceStoreCheckContextReceiverTrampoline ceStoreTrampolines'
- 	instanceVariableNames: 'ceScheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline ceStoreCheckContextReceiverTrampoline ceStoreTrampoline'
  	classVariableNames: ''
  	poolDictionaries: 'VMBytecodeConstants VMSqueakClassIndices'
  	category: 'VMMaker-JIT'!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur class>>numTrampolines (in category 'accessing') -----
  numTrampolines
  	(initializationOptions at: #IMMUTABILITY ifAbsent: [false])
+ 		ifTrue: [ ^ super numTrampolines + self new numStoreTrampolines + 7 ]
- 		ifTrue: [ ^ super numTrampolines + 7 ]
  		ifFalse: [ ^ super numTrampolines + 6 ]!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genStoreTrampolineCall: (in category 'compile abstract instructions') -----
+ genStoreTrampolineCall: instVarIndex
+ 	<inline: true>
+ 	instVarIndex < self numStoreTrampolines
+ 		ifFalse: 
+ 			[ cogit MoveCq: instVarIndex R: TempReg.
+ 			  cogit CallRT: (ceStoreTrampolines at: self numStoreTrampolines) ]
+ 		ifTrue: 
+ 			[ cogit CallRT: (ceStoreTrampolines at: instVarIndex) ].
+ 	 cogit annotateBytecode: cogit Label!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>genStoreTrampolineCalled: (in category 'initialization') -----
- genStoreTrampolineCalled: trampolineName
- 	"This can be entered in one of two states, depending on TempReg. 
- 	TempReg = 0 => store check
- 	TempReg > 0 => immutability failure
- 	TempReg holds index + 1 in this case as the value 0 is reserved for store checks.
- 	In addition the 0 value is convenient to save one instruction for store checks."
- 	| jumpSC |
- 	<option: #IMMUTABILITY>
- 	<var: #trampolineName type: #'char *'>
- 	<var: #jumpSC type: #'AbstractInstruction *'>
- 	<inline: false>
- 	cogit zeroOpcodeIndex.
- 	cogit PushR: SendNumArgsReg.
- 	jumpSC := self genJumpMutable: ReceiverResultReg scratchReg: SendNumArgsReg.
- 	cogit PopR: SendNumArgsReg.
- 	cogit
- 		compileTrampolineFor: #ceCannotAssignTo:withIndex:valueToAssign:
- 		numArgs: 3
- 		arg: ReceiverResultReg
- 		arg: TempReg
- 		arg: ClassReg
- 		arg: nil
- 		regsToSave: cogit emptyRegisterMask
- 		pushLinkReg: true
- 		resultReg: NoReg.
- 		
- 	"Store check"
- 	jumpSC jmpTarget: (cogit PopR: SendNumArgsReg).
- 	^ cogit genTrampolineFor: #remember:
- 		called: trampolineName
- 		numArgs: 1
- 		arg: ReceiverResultReg
- 		arg: nil
- 		arg: nil
- 		arg: nil
- 		regsToSave: cogit emptyRegisterMask
- 		pushLinkReg: true
- 		resultReg: NoReg
- 		appendOpcodes: true!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genStoreTrampolineCalled:instVarIndex: (in category 'initialization') -----
+ genStoreTrampolineCalled: trampolineName instVarIndex: instVarIndex
+ 	"Convention:
+ 	- RcvrResultReg holds the object mutated.
+ 	If immutability failure:
+ 	- TempReg holds the instance variable index mutated 
+ 		if instVarIndex > numDedicatedStoreTrampoline
+ 	- ClassReg holds the value to store
+ 	Registers are not lived across this trampoline as the 
+ 	immutability failure may need new stack frames."
+ 	
+ 	| jumpSC |
+ 	<option: #IMMUTABILITY>
+ 	<var: #trampolineName type: #'char *'>
+ 	<var: #jumpSC type: #'AbstractInstruction *'>
+ 	<inline: false>
+ 	cogit zeroOpcodeIndex.
+ 	jumpSC := self genJumpMutable: ReceiverResultReg scratchReg: SendNumArgsReg. "SendNumArgsReg is mutated but we don't care as register are not live across the trampoline"
+ 	instVarIndex = self numStoreTrampolines
+ 		ifFalse: [ cogit MoveCq: instVarIndex R: TempReg ]. 
+ 	cogit
+ 		compileTrampolineFor: #ceCannotAssignTo:withIndex:valueToAssign:
+ 		numArgs: 3
+ 		arg: ReceiverResultReg
+ 		arg: TempReg
+ 		arg: ClassReg
+ 		arg: nil
+ 		regsToSave: cogit emptyRegisterMask
+ 		pushLinkReg: true
+ 		resultReg: NoReg.
+ 		
+ 	"Store check"
+ 	jumpSC jmpTarget: cogit Label.
+ 	^ cogit genTrampolineFor: #remember:
+ 		called: trampolineName
+ 		numArgs: 1
+ 		arg: ReceiverResultReg
+ 		arg: nil
+ 		arg: nil
+ 		arg: nil
+ 		regsToSave: cogit emptyRegisterMask
+ 		pushLinkReg: true
+ 		resultReg: NoReg
+ 		appendOpcodes: true!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genStoreWithImmutabilityAndStoreCheckSourceReg:slotIndex:destReg:scratchReg:needRestoreRcvr: (in category 'compile abstract instructions') -----
  genStoreWithImmutabilityAndStoreCheckSourceReg: sourceReg slotIndex: index destReg: destReg scratchReg: scratchReg needRestoreRcvr: needRestoreRcvr 
  	"Store check code is duplicated to use a single trampoline"
  	| immutableJump jmpImmediate jmpDestYoung jmpSourceOld rememberedBitByteOffset jmpAlreadyRemembered mask |
  	<var: #immutableJump type: #'AbstractInstruction *'>
  	<var: #jmpImmediate type: #'AbstractInstruction *'>
  	<var: #jmpDestYoung type: #'AbstractInstruction *'>
  	<var: #jmpSourceOld type: #'AbstractInstruction *'>
  	<var: #jmpAlreadyRemembered type: #'AbstractInstruction *'>
  
  	immutableJump := self genJumpImmutable: destReg scratchReg: scratchReg.
  	
  	cogit genTraceStores.
  	
  	"do the store"
  	cogit MoveR: sourceReg
  		   Mw: index * objectMemory wordSize + objectMemory baseHeaderSize
  		   r: destReg.
  	
  	"store check"
  	jmpImmediate := self genJumpImmediate: sourceReg.
  	"Get the old/new boundary in scratchReg"
  	cogit MoveCw: objectMemory storeCheckBoundary R: scratchReg.
  	"Is target young?  If so we're done"
  	cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg - scratchReg"
  	jmpDestYoung := cogit JumpBelow: 0.
  	"Is value stored old?  If so we're done."
  	cogit CmpR: scratchReg R: sourceReg. "N.B. FLAGS := valueReg - scratchReg"
  	jmpSourceOld := cogit JumpAboveOrEqual: 0.
  	"value is young and target is old.
  	 Need to remember this only if the remembered bit is not already set.
  	 Test the remembered bit.  Only need to fetch the byte containing it,
  	 which reduces the size of the mask constant."
  	rememberedBitByteOffset := jmpSourceOld isBigEndian
  									ifTrue: [objectMemory baseHeaderSize - 1 - (objectMemory rememberedBitShift // 8)]
  									ifFalse:[objectMemory rememberedBitShift // 8].
  	mask := 1 << (objectMemory rememberedBitShift \\ 8).
  	cogit MoveMb: rememberedBitByteOffset r: destReg R: scratchReg.
  	cogit AndCq: mask R: scratchReg.
  	jmpAlreadyRemembered := cogit JumpNonZero: 0.
  	"Set the inst var index for the benefit of the immutability check. The trampoline will
  	 repeat the check to choose between the immutbality violation and the store check."
+ 	immutableJump jmpTarget: cogit Label.
+ 	self genStoreTrampolineCall: index.
- 	immutableJump jmpTarget: (cogit MoveCq: index R: scratchReg).
- 	cogit CallRT: ceStoreTrampoline.
- 	cogit annotateBytecode: cogit Label.
  	needRestoreRcvr ifTrue: [ cogit putSelfInReceiverResultReg ].
  
  	jmpImmediate jmpTarget:
  	(jmpDestYoung jmpTarget:
  	(jmpSourceOld jmpTarget:
  	(jmpAlreadyRemembered jmpTarget:
  		cogit Label))).
  	
  	^ 0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genStoreWithImmutabilityButNoStoreCheckSourceReg:slotIndex:destReg:scratchReg:needRestoreRcvr: (in category 'compile abstract instructions') -----
  genStoreWithImmutabilityButNoStoreCheckSourceReg: sourceReg slotIndex: index destReg: destReg scratchReg: scratchReg needRestoreRcvr: needRestoreRcvr
  
  	<var: #mutableJump type: #'AbstractInstruction *'>
  	<var: #immutabilityFailure type: #'AbstractInstruction *'>
  	| immutabilityFailure mutableJump |
  	
  	"imm check has its own trampoline"
  	mutableJump := self genJumpMutable: destReg scratchReg: scratchReg.
+ 	self genStoreTrampolineCall: index.
- 	cogit MoveCq: index R: TempReg.
- 	cogit CallRT: ceStoreTrampoline.
- 	cogit annotateBytecode: cogit Label.
  	needRestoreRcvr ifTrue: [ cogit putSelfInReceiverResultReg ].
  	immutabilityFailure := cogit Jump: 0.
  	mutableJump jmpTarget: cogit Label.
  
  	cogit genTraceStores.
  	
  	"do the store"
  	cogit MoveR: sourceReg
  		   Mw: index * objectMemory wordSize + objectMemory baseHeaderSize
  		   r: destReg.
  		
  	immutabilityFailure jmpTarget: cogit Label.
  
  	^ 0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  	"Do the store check.  Answer the argument for the benefit of the code generator;
  	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  	 it allows the code generator to reload ReceiverResultReg cheaply.
  	 In Spur the only thing we leave to the run-time is adding the receiver to the
  	 remembered set and setting its isRemembered bit."
  	self 
  		cppIf: IMMUTABILITY
+ 		ifTrue: 
+ 			[ 0 to: self numStoreTrampolines do:
+ 				[ :instVarIndex |
+ 					ceStoreTrampolines
+ 						at: instVarIndex
+ 						put: (self 
+ 							genStoreTrampolineCalled: (cogit 
+ 								trampolineName: 'ceStoreTrampoline' 
+ 								numArgs: instVarIndex 
+ 								limit: self numStoreTrampolines - 1) 
+ 							instVarIndex: instVarIndex ) ] ].
- 		ifTrue: [ceStoreTrampoline := self genStoreTrampolineCalled: 'ceStoreTrampoline'].
  	ceStoreCheckTrampoline := cogit
  									genTrampolineFor: #remember:
  									called: 'ceStoreCheckTrampoline'
  									arg: ReceiverResultReg
  									regsToSave: (cogit callerSavedRegMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  									result: cogit returnRegForStoreCheck.
  	ceStoreCheckContextReceiverTrampoline := self genStoreCheckContextReceiverTrampoline.
  	ceScheduleScavengeTrampoline := cogit
  											genTrampolineFor: #ceScheduleScavenge
  											called: 'ceScheduleScavengeTrampoline'
  											regsToSave: cogit callerSavedRegMask.
  	ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: false called: 'ceSmallMethodContext'.
  	ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: true called: 'ceSmallBlockContext'.
  	ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: false called: 'ceLargeMethodContext'.
  	ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: true called: 'ceLargeBlockContext'!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>numStoreTrampolines (in category 'initialization') -----
+ numStoreTrampolines
+ 	"Number of trampolines for instance variable store. Trampolines from 0 to 
+ 	numStoreTrampoline - 1 are dedicated to an inst var index, the last one is generic.
+ 	
+ 	WARNING: Check the C declaration of ceStoreTrampolines if this number is increased."
+ 	^ 3!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>setCogit:methodZone: (in category 'in-line cacheing') -----
+ setCogit: aCogit methodZone: aMethodZone
+ 	<doNotGenerate>
+ 	super setCogit: aCogit methodZone: aMethodZone.
+ 	ceStoreTrampolines := CArrayAccessor on: (Array new: self numStoreTrampolines + 1).!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCodeGen
  	aCodeGen
+ 		var: #ceStoreTrampolines
+ 			declareC: 'sqint ceStoreTrampolines[4]';
  		var: #methodAbortTrampolines
  			declareC: 'sqInt methodAbortTrampolines[4]';
  		var: #picAbortTrampolines
  			declareC: 'sqInt picAbortTrampolines[4]';
  		var: #picMissTrampolines
  			declareC: 'sqInt picMissTrampolines[4]';
  		var: 'ceCall0ArgsPIC'
  			declareC: 'void (*ceCall0ArgsPIC)(void)';
  		var: 'ceCall1ArgsPIC'
  			declareC: 'void (*ceCall1ArgsPIC)(void)';
  		var: 'ceCall2ArgsPIC'
  			declareC: 'void (*ceCall2ArgsPIC)(void)';
  		var: #ceCallCogCodePopReceiverArg0Regs
  			declareC: 'void (*ceCallCogCodePopReceiverArg0Regs)(void)';
  		var: #realCECallCogCodePopReceiverArg0Regs
  			declareC: 'void (*realCECallCogCodePopReceiverArg0Regs)(void)';
  		var: #ceCallCogCodePopReceiverArg1Arg0Regs
  			declareC: 'void (*ceCallCogCodePopReceiverArg1Arg0Regs)(void)';
  		var: #realCECallCogCodePopReceiverArg1Arg0Regs
  			declareC: 'void (*realCECallCogCodePopReceiverArg1Arg0Regs)(void)';
  		var: 'simStack'
  			declareC: 'CogSimStackEntry simStack[', ((CoInterpreter bindingOf: #LargeContextSlots) value * 5 // 4) asString, ']';
  		var: 'simSelf'
  			type: #CogSimStackEntry;
  		var: #optStatus
  			type: #CogSSOptStatus;
  		var: 'prevBCDescriptor'
  			type: #'BytecodeDescriptor *'.
  
  	self numPushNilsFunction ifNotNil:
  		[aCodeGen
  			var: 'numPushNilsFunction'
  				declareC: 'sqInt (* const numPushNilsFunction)(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self numPushNilsFunction);
  			var: 'pushNilSizeFunction'
  				declareC: 'sqInt (* const pushNilSizeFunction)(sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self pushNilSizeFunction)].
  
  	aCodeGen
  		addSelectorTranslation: #register to: (aCodeGen cFunctionNameFor: 'registerr');
  		addSelectorTranslation: #register: to: (aCodeGen cFunctionNameFor: 'registerr:')!



More information about the Vm-dev mailing list