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

commits at source.squeak.org commits at source.squeak.org
Thu Apr 3 02:17:40 UTC 2014


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

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

Name: VMMaker.oscog-eem.663
Author: eem
Time: 2 April 2014, 7:15:10.429 pm
UUID: b4c4ad18-808c-4afb-9ddc-80def5e01086
Ancestors: VMMaker.oscog-eem.662

Fix pc-mapping for NewspeakV4.  Dynamic super sends should
/not/ be annotated with IsNSSendCall, but wth the vanilla IsSendCall.
This fixes a bug converting an interpreter activation of a method
with a loop and a duynamic super send to a machine code frame.

One more fix (addition to ByteArray) to fix in-image decompilation.

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

Item was added:
+ ----- Method: ByteArray>>longAt: (in category '*VMMaker-accessing') -----
+ longAt: byteIndex
+ 	^self signedLongAt: byteIndex!

Item was changed:
  ----- Method: Cogit>>offsetAndSendTableFor:annotation:into: (in category 'in-line cacheing') -----
  offsetAndSendTableFor: entryPoint annotation: annotation into: binaryBlock
  	"Find the relevant sendTable for a linked-send to entryPoint.  Do this based on the
  	 alignment of entryPoint.  N.B.  For Newspeak sends we don't need to distinguish
  	 between ceImplicitReceiver and the other sends since ceImplicitReceiver will
  	 never appear to be linked, so only three cases here."
  	<inline: true>
  	self cppIf: NewspeakVM
  		ifTrue:
+ 			[self assert: annotation = IsSendCall.
+ 			 (entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
+ 				ifTrue: [binaryBlock value: cmEntryOffset value: sendTrampolines]
- 			[(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- 				ifTrue:
- 					[self assert: annotation = IsSendCall.
- 					 binaryBlock
- 							value: cmEntryOffset
- 							value: sendTrampolines]
  				ifFalse:
  					[(entryPoint bitAnd: entryPointMask) = dynSuperEntryAlignment
+ 						ifTrue: [binaryBlock value: cmDynSuperEntryOffset value: dynamicSuperSendTrampolines]
+ 						ifFalse: [binaryBlock value: cmNoCheckEntryOffset value: superSendTrampolines]]]
- 						ifTrue:
- 							[self assert: annotation = IsNSSendCall.
- 							 binaryBlock
- 								value: cmDynSuperEntryOffset
- 								value: dynamicSuperSendTrampolines]
- 						ifFalse:
- 							[self assert: annotation = IsSendCall.
- 							 binaryBlock
- 								value: cmNoCheckEntryOffset
- 								value: superSendTrampolines]]]
  		ifFalse:
  			[(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
  				ifTrue: [binaryBlock value: cmEntryOffset value: sendTrampolines]
  				ifFalse: [binaryBlock value: cmNoCheckEntryOffset value: superSendTrampolines]]!

Item was changed:
  ----- Method: Cogit>>targetMethodAndSendTableFor:annotation:into: (in category 'in-line cacheing') -----
  targetMethodAndSendTableFor: entryPoint annotation: annotation into: binaryBlock
  	"Evaluate binaryBlock with the targetMethod and relevant send table for a linked-send
  	 to entryPoint.  Do so based on the alignment of entryPoint.  N.B.  For Newspeak sends
  	 we don't need to distinguish between ceImplicitReceiver and the other sends since
  	 ceImplicitReceiver will never appear to be linked, so only three cases here."
  	<inline: true>
  	| targetMethod sendTable |
  	<var: #targetMethod type: #'CogMethod *'>
  	<var: #sendTable type: #'sqInt *'>
  	self cppIf: NewspeakVM
  		ifTrue:
+ 			[self assert: annotation = IsSendCall.
+ 			 (entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- 			[(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
  				ifTrue:
+ 					[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
- 					[self assert: annotation = IsSendCall.
- 					 targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
  					 sendTable := sendTrampolines]
  				ifFalse:
  					[(entryPoint bitAnd: entryPointMask) = dynSuperEntryAlignment
  						ifTrue:
+ 							[targetMethod := self cCoerceSimple: entryPoint - cmDynSuperEntryOffset to: #'CogMethod *'.
- 							[self assert: annotation = IsNSSendCall.
- 							 targetMethod := self cCoerceSimple: entryPoint - cmDynSuperEntryOffset to: #'CogMethod *'.
  							 sendTable := dynamicSuperSendTrampolines]
  						ifFalse:
+ 							[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- 							[self assert: annotation = IsSendCall.
- 							 targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  							 sendTable := superSendTrampolines]]]
  		ifFalse:
  			[(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
  				ifTrue:
  					[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
  					 sendTable := sendTrampolines]
  				ifFalse:
  					[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  					 sendTable := superSendTrampolines]].
  	binaryBlock
  		value: targetMethod
  		value: sendTable!

Item was changed:
  ----- Method: Cogit>>testMcToBcPcMappingForMethod: (in category 'tests-method map') -----
  testMcToBcPcMappingForMethod: cogMethod
  	<doNotGenerate>
  	| bcMethod subMethods prevMcpc isAltInstSet |
  	"self disassembleMethod: cogMethod"
  	"coInterpreter symbolicMethod: cogMethod methodObject"
  	"coInterpreter printOop: cogMethod methodObject"
  	"self printPCMapPairsFor: cogMethod on: Transcript"
  	cogMethod stackCheckOffset = 0 ifTrue: "frameless"
  		[^self].
  	bcMethod := coInterpreter isCurrentImageFacade
  					ifTrue: [coInterpreter objectForOop: cogMethod methodObject]
  					ifFalse: [VMCompiledMethodProxy new
  								for: cogMethod methodObject
  								coInterpreter: coInterpreter
  								objectMemory: objectMemory].
  	subMethods := self subMethodsAsRangesFor: cogMethod.
  	isAltInstSet := coInterpreter headerIndicatesAlternateBytecodeSet: cogMethod methodHeader.
  	self mapFor: cogMethod do:
  		[:annotation :mcpc| | subMethod bcpc mappedpc |
  		(self isPCMappedAnnotation: annotation alternateInstructionSet: isAltInstSet) ifTrue:
  			[subMethod := subMethods
  								detect: [:range| range includes: mcpc]
  								ifNone: ["a trailing call ceNonLocalReturnTrampoline's following
  										 pc is the start of a following block or the end of the map"
  										subMethods detect: [:range| range includes: mcpc - 1]].
  			mcpc > subMethod first ifTrue:
  				[bcpc := self
  							bytecodePCFor: mcpc
  							startBcpc: subMethod startpc
  							in: subMethod cogMethod.
  				self assert: bcpc ~= 0.
  				mappedpc := self mcPCFor: bcpc startBcpc: subMethod startpc in: subMethod cogMethod.
  				self assert: mappedpc ~= 0.
  				mappedpc := mappedpc + subMethod cogMethod address.
  				"mcpc = mappedpc is obviously what we want and expect.  PrevMcpc = mappedpc hacks
  				 around frame building accessors where the frst bytecode is mapped twice, once for the
  				 stack check and once for the context inst var access.  The bytecode pc can only map
  				 back to a single mcpc, the first, so the second map entry will fail without this hack."
  				self assert: (mcpc = mappedpc or: [prevMcpc = mappedpc]).
+ 				"IsNSSendCall is used only for pushImplicitReceiver:.  This isn't a send bytecode.
+ 				 So filter-out these annotations."
+ 				((self isSendAnnotation: annotation) and: [annotation ~= IsNSSendCall]) ifTrue:
- 				(self isSendAnnotation: annotation) ifTrue:
  					[| mcSelector bcSelector |
  					mcSelector := self selectorForSendAt: mcpc annotation: annotation.
  					"sends map to the following pc.  need to find the selector for the previous pc"
  					bcSelector := self selectorForSendBefore: bcpc in: bcMethod.
  					self assert: mcSelector = bcSelector]].
  			 prevMcpc := mcpc].
  		 false "keep scanning"]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genSendDynamicSuper:numArgs: (in category 'bytecode generators') -----
  genSendDynamicSuper: selector numArgs: numArgs
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
  	self MoveMw: numArgs * BytesPerWord r: SPReg R: ReceiverResultReg.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
+ 	self CallSend: (dynamicSuperSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
- 	self CallNewspeakSend: (dynamicSuperSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
  	usesMethodClass := true.
  	self flag: 'currently caller pushes result'.
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genMarshalledSendDynamicSuper:numArgs: (in category 'bytecode generators') -----
  genMarshalledSendDynamicSuper: selector numArgs: numArgs
  	<inline: false>
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
+ 	self CallSend: (dynamicSuperSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
- 	self CallNewspeakSend: (dynamicSuperSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
  	usesMethodClass := true.
  	optStatus isReceiverResultRegLive: false.
  	^self ssPushRegister: ReceiverResultReg!



More information about the Vm-dev mailing list