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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 4 06:35:43 UTC 2015


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

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

Name: VMMaker.oscog-eem.1548
Author: eem
Time: 3 December 2015, 10:34:24.663 pm
UUID: 40c57289-8839-4966-afa7-14ba4e813a46
Ancestors: VMMaker.oscog-eem.1547

x64 Cogit:
Fix sizing of CmpC32R so that the jump to the next CPIC case is always short, and so reuse the x86's rewriteCPICJumpAt:target: for x64.

Avoid using isCallPrecedingReturnPC: for testing if compileInterpreterPrimitive used a CallFull or a JumpFull to invoke the prim, hence allowing isCallPrecedingReturnPC:to only have to apply to calls used for sends, and hence reuse x86's isCallPrecedingReturnPC: for x64..

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

Item was changed:
  ----- Method: CogARMCompiler>>isCallPrecedingReturnPC: (in category 'testing') -----
  isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a send return pc answer if the instruction before it is a call (not a CallFull)."
- 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
  	"There are two types of calls: BL and/BLX encoding"
  	| call |
  	call := self instructionBeforeAddress: mcpc.
  	^(self instructionIsBL: call) or:[self instructionIsBLX: call]!

Item was changed:
  ----- Method: CogAbstractInstruction>>isCallPrecedingReturnPC: (in category 'testing') -----
  isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a send return pc answer if the instruction before it is a call (not a CallFull)."
- 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
  	^self subclassResponsibility!

Item was changed:
  ----- Method: CogIA32Compiler>>isCallPrecedingReturnPC: (in category 'testing') -----
  isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a send return pc answer if the instruction before it is a call (not a CallFull)."
- 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
  	^(objectMemory byteAt: mcpc - 5) = 16rE8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>isCallPrecedingReturnPC: (in category 'testing') -----
  isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a send return pc answer if the instruction before it is a call (not a CallFull)."
  	"cogit disassembleFrom: mcpc - 8 to: mcpc."
  
  	(self opcodeAtAddress: mcpc - 8) = JAL ifTrue: [^true].
  	
  	((self opcodeAtAddress: mcpc - 8) = SPECIAL
  		and: [(self opcodeAtAddress: mcpc - 8) = JALR]) ifTrue: [^true].
  	
  	^false!

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
(excessive size, no diff calculated)

Item was added:
+ ----- Method: CogX64Compiler>>isCallPrecedingReturnPC: (in category 'testing') -----
+ isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a send return pc answer if the instruction before it is a call (not a CallFull)."
+ 	^(objectMemory byteAt: mcpc - 5) = 16rE8!

Item was added:
+ ----- Method: CogX64Compiler>>loadPICLiteralByteSize (in category 'accessing') -----
+ loadPICLiteralByteSize
+ 	"Answer the byte size of a MoveCwR opcode's corresponding machine code
+ 	 when the argument is a PIC.  This is for the self-reference at the end of a
+ 	 closed PIC: leaq 0xffffffffffffff2b(%rip), %rcx : 48 8D 0D 2B FF FF FF"
+ 	<inline: true>
+ 	^7!

Item was added:
+ ----- Method: CogX64Compiler>>rewriteCPICJumpAt:target: (in category 'inline cacheing') -----
+ rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddress
+ 	"Rewrite the short jump instruction to jump to a new cpic case target. "
+ 	<var: #addressFollowingJump type: #usqInt>
+ 	<var: #jumpTargetAddress type: #usqInt>
+ 	| callDistance |
+ 	callDistance := jumpTargetAddress - addressFollowingJump.
+ 	self assert: callDistance abs < 128.
+ 	objectMemory
+ 		byteAt: addressFollowingJump - 1
+ 		put:  (callDistance bitAnd: 16rFF).
+ 	"self cCode: ''
+ 		inSmalltalk: [cogit disassembleFrom: addressFollowingJump - 10 to: addressFollowingJump - 1]."
+ 	^2!

Item was changed:
  Cogit subclass: #SimpleStackBasedCogit
+ 	instanceVariableNames: 'primSetFunctionLabel primInvokeInstruction externalPrimCallOffsets externalPrimJumpOffsets externalSetPrimOffsets'
- 	instanceVariableNames: 'primSetFunctionLabel primInvokeLabel externalPrimCallOffsets externalPrimJumpOffsets externalSetPrimOffsets'
  	classVariableNames: ''
  	poolDictionaries: 'VMMethodCacheConstants VMObjectIndices'
  	category: 'VMMaker-JIT'!
  
  !SimpleStackBasedCogit commentStamp: '<historical>' prior: 0!
  I am the stage one JIT for Cog that does not attempt to eliminate the stack via deferred code generation.!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	aCCodeGenerator
  		var: #externalPrimCallOffsets
  			declareC: 'sqInt externalPrimCallOffsets[MaxNumArgs + 1]';
  		var: #externalPrimJumpOffsets
  			declareC: 'sqInt externalPrimJumpOffsets[MaxNumArgs + 1]';
  		var: #externalSetPrimOffsets
  			declareC: 'sqInt externalSetPrimOffsets[MaxNumArgs + 1]';
  		var: #primSetFunctionLabel type: #'AbstractInstruction *';
+ 		var: #primInvokeInstruction type: #'AbstractInstruction *'!
- 		var: #primInvokeLabel type: #'AbstractInstruction *'!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive: (in category 'primitive generators') -----
  compileInterpreterPrimitive: primitiveRoutine
  	"Compile a call to an interpreter primitive.  Call the C routine with the
  	 usual stack-switching dance, test the primFailCode and then either
  	 return on success or continue to the method body."
  	<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
  	| flags jmp jmpSamplePrim retry continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
  	<var: #jmp type: #'AbstractInstruction *'>
  	<var: #retry type: #'AbstractInstruction *'>
  	<var: #jmpSamplePrim type: #'AbstractInstruction *'>
  	<var: #continuePostSamplePrim type: #'AbstractInstruction *'>
  	<var: #jmpSampleNonPrim type: #'AbstractInstruction *'>
  	<var: #continuePostSampleNonPrim type: #'AbstractInstruction *'>
  
  	"Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers"
  	self genExternalizePointersForPrimitiveCall.
  	"Switch to the C stack."
  	self genLoadCStackPointersForPrimCall.
  
  	flags := coInterpreter primitivePropertyFlags: primitiveIndex.
  	(flags anyMask: PrimCallDoNotJIT) ifTrue:
  		[^ShouldNotJIT].
  
  	(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  		["Test nextProfileTick for being non-zero and call checkProfileTick if so"
  		objectMemory wordSize = 4
  			ifTrue:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  				 self OrR: TempReg R: ClassReg]
  			ifFalse:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self CmpCq: 0 R: TempReg].
  		"If set, jump to record sample call."
  		jmpSampleNonPrim := self JumpNonZero: 0.
  		continuePostSampleNonPrim := self Label].
  
  	"Old full prim trace is in VMMaker-eem.550 and prior"
  	self recordPrimTrace ifTrue:
  		[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
  
  	"Clear the primFailCode and set argumentCount"
  	retry := self MoveCq: 0 R: TempReg.
  	self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
  	methodOrBlockNumArgs ~= 0 ifTrue:
  		[self MoveCq: methodOrBlockNumArgs R: TempReg].
  	self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
  
  	"If required, set primitiveFunctionPointer and newMethod"
  	(flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
  		[self MoveCw: primitiveRoutine asInteger R: TempReg.
  		 primSetFunctionLabel :=
  		 self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
  	(flags anyMask: PrimCallNeedsNewMethod+PrimCallMayCallBack) ifTrue:
  		["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
  		 (flags anyMask: PrimCallMayCallBack) ifTrue:
  			[needsFrame := true].
  		 methodLabel addDependent:
  			(self annotateAbsolutePCRef:
  				(self MoveCw: methodLabel asInteger R: ClassReg)).
  		 self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
  		 self MoveR: TempReg Aw: coInterpreter newMethodAddress].
  
  	"Invoke the primitive"
  	self PrefetchAw: coInterpreter primFailCodeAddress.
  	(flags anyMask: PrimCallMayCallBack)
  		ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
  			["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders
  			  are found. So insist on PrimCallNeedsPrimitiveFunction being set too."
  			 self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction).
  			 backEnd genSubstituteReturnAddress:
  				((flags anyMask: PrimCallCollectsProfileSamples)
  					ifTrue: [cePrimReturnEnterCogCodeProfiling]
  					ifFalse: [cePrimReturnEnterCogCode]).
+ 			 primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger.
- 			 self JumpFullRT: primitiveRoutine asInteger.
- 			 primInvokeLabel := self Label.
  			 jmp := jmpSamplePrim := continuePostSamplePrim := nil]
  		ifFalse:
  			["Call the C primitive routine."
+ 			primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger.
- 			self CallFullRT: primitiveRoutine asInteger.
- 			primInvokeLabel := self Label.
  			(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  				[self assert: (flags anyMask: PrimCallNeedsNewMethod).
  				"Test nextProfileTick for being non-zero and call checkProfileTick if so"
  				objectMemory wordSize = 4
  					ifTrue:
  						[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  						 self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  						 self OrR: TempReg R: ClassReg]
  					ifFalse:
  						[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  						 self CmpCq: 0 R: TempReg].
  				"If set, jump to record sample call."
  				jmpSamplePrim := self JumpNonZero: 0.
  				continuePostSamplePrim := self Label].
  			objectRepresentation maybeCompileRetry: retry onPrimitiveFail: primitiveIndex.
  			self maybeCompileAllocFillerCheck.
  			"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  				success:	stackPointer ->	result (was receiver)
  											arg1
  											...
  											argN
  											return pc
  				failure:						receiver
  											arg1
  											...
  							stackPointer ->	argN
  											return pc
  			In either case we can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  			self MoveAw: coInterpreter instructionPointerAddress
  				R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  			backEnd genLoadStackPointers.
  			"Test primitive failure"
  			self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  			backEnd hasLinkRegister ifFalse: [self PushR: ClassReg]. "Restore return pc on CISCs"
  			self flag: 'ask concrete code gen if move sets condition codes?'.
  			self CmpCq: 0 R: TempReg.
  			jmp := self JumpNonZero: 0.
  			"Fetch result from stack"
  			self MoveMw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize])
  				r: SPReg
  				R: ReceiverResultReg.
  			self RetN: objectMemory wordSize].	"return to caller, popping receiver"
  
  	(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  		["The sample is collected by cePrimReturnEnterCogCode for external calls"
  		jmpSamplePrim notNil ifTrue:
  			["Call ceCheckProfileTick: to record sample and then continue."
  			jmpSamplePrim jmpTarget: self Label.
  			self assert: (flags anyMask: PrimCallNeedsNewMethod).
  			self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedLong]
  							   inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  			"reenter the post-primitive call flow"
  			self Jump: continuePostSamplePrim].
  		"Null newMethod and call ceCheckProfileTick: to record sample and then continue.
  		 ceCheckProfileTick will map null/0 to coInterpreter nilObject"
  		jmpSampleNonPrim jmpTarget: self Label.
  		self MoveCq: 0 R: TempReg.
  		self MoveR: TempReg Aw: coInterpreter newMethodAddress.
  		self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedLong]
  						   inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  		"reenter the post-primitive call flow"
  		self Jump: continuePostSampleNonPrim].
  
  	jmp notNil ifTrue:
  		["Jump to restore of receiver reg and proceed to frame build for failure."
  		 jmp jmpTarget: self Label.
  		 "Restore receiver reg from stack.  If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack."
  		 self MoveMw: objectMemory wordSize * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]))
  			r: SPReg
  			R: ReceiverResultReg].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>recordCallOffsetIn: (in category 'external primitive support') -----
  recordCallOffsetIn: cogMethod
  	<api>
  	<var: #cogMethod type: #'CogMethod *'>
  	| offset offsetTable |
  	<var: #offsetTable type: #'sqInt *'>
  	offset := primSetFunctionLabel address - cogMethod asInteger.
  	(externalSetPrimOffsets at: cogMethod cmNumArgs) isNil
  		ifTrue: [externalSetPrimOffsets at: cogMethod cmNumArgs put: offset]
  		ifFalse: [self assert: (externalSetPrimOffsets at: cogMethod cmNumArgs) = offset].
+ 	offsetTable := primInvokeInstruction isJump
+ 						ifTrue: [externalPrimJumpOffsets]
+ 						ifFalse: [externalPrimCallOffsets].
+ 	offset := primInvokeInstruction address + primInvokeInstruction machineCodeSize - cogMethod asInteger.
- 	offsetTable := (backEnd isCallPrecedingReturnPC: primInvokeLabel address asUnsignedInteger)
- 						ifTrue: [externalPrimCallOffsets]
- 						ifFalse: [externalPrimJumpOffsets].
- 	offset := primInvokeLabel address - cogMethod asInteger.
  	(offsetTable at: cogMethod cmNumArgs) isNil
  		ifTrue: [offsetTable at: cogMethod cmNumArgs put: offset]
  		ifFalse: [self assert: (offsetTable at: cogMethod cmNumArgs) = offset]!



More information about the Vm-dev mailing list