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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 6 10:19:39 UTC 2016


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

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

Name: VMMaker.oscog-eem.1942
Author: eem
Time: 6 September 2016, 12:17:18.340784 pm
UUID: 85b22cc1-24ba-43e0-9f93-2ba18fe8554e
Ancestors: VMMaker.oscog-eem.1941

Fix disassembly of non-local returns, including the map entries.  These are associated with the address following a non-local return call and so may actually be associated with the address of the following block method (rare cuz embedded block method headers are aligned on an 8 byte boundary).

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

Item was changed:
  ----- Method: Cogit class>>initializeAnnotationConstants (in category 'class initialization') -----
  initializeAnnotationConstants
  	"These form the method map for a cog method.  The map defines which addresses
  	 in a machine code method are ones with important functions, such as being a send
  	 site or being a reference to a heap object.  Each annotated instruction has a byte
  	 in the map, and each byte in the map has two parts.  In the least signficant bits are
  	 a distance in codeGranularity units from the start of the method or the previous
  	 map entry, except for the IsAnnotationExtension type.  In the most signficant bits
  	 are the type of annotation at the point reached.  A null byte ends the map.  The
  	 first mapped location is a distance from the cmNoCheckEntryOffset.
  
  	 The map occurs at the end of a method (*), in reverse, so that its start is found
  	 by adding the method's block size.  If the distance between two mapped
  	 instructions will not fit in the displacement field then one or more displacement
  	 entries are placed in the map to bridge the gap.  There is a * 32 displacement
  	 units type for spanning large gaps.  The displacements are in codeGranularity
  	 units so that processors like e.g. ARM, with 4-byte instructions, do not have overly
  	 large maps.  In [practice maps are very compact, but they should be as quick to
  	 navigate as possible, and hence be as compact as possible.
  
  	 There is only one kind of call annotation that serves for all calls from machine
  	 code. There are several kinds of call, sends, super sends, calls of the generated
  	 run-time, and direct calls of primitive functions in the interpreter.  These need
  	 different treatment at different times.  For example, when the send cache is
  	 flushed or the method zone is shrunk some sends must be unlinked and some
  	 sends must be relocated.  But to be able to parse bytecoded methods and match
  	 their pcs with corresponding machine code pcs the map needs to differentiate
  	 between sends and run-time calls. 
  
  	 Sends can be distinguished from run-time or direct primitive calls based on address;
  	 only sends have their target between methodZoneBase and methodZone freeStart.
  	 We used to distinguish normal sends from super sends based on alignment of
  	 entry-point, because normal sends link to the checked entry-point, whereas super sends
  	 link to the unchecked entry-point, and both entry points have different alignments.
  	 But now we use the IsAnnotationExtension to label sends other than normal sends.
  	 For these ``exotic'' sends there is both an IsAnnotationExtension annotation and an
  	 IsSendCall annotation.
  
  	 While run-time calls can be distinguished from direct primitive calls on the basis
  	 of address there is no need to do so.  They are merely calls to locations that
  	 don't move during method zone compaction.
  
  	 Absolute PC references are used for method references and counter references.
  	 These are references from within a particular method to absolute pcs in that same
  	 method that must be relocated when the method moves."
  	"self initializeAnnotationConstants"
  
  	AnnotationShift := 5.
  	IsDisplacementX2N := 0.	"N.B. A 0 byte ends the map"
  	IsAnnotationExtension := 1.	"Used to extend IsSendCall with different codes for exotic send types."
  	IsObjectReference := 2.
  	IsAbsPCReference := 3.
  	IsRelativeCall := 4.
  	HasBytecodePC := 5.
  	IsNSSendCall := NewspeakVM ifTrue: [6].
  	IsSendCall := 7.
  	"These are formed by combining IsSendCall and IsAnnotationExtension annotations."
  	IsSuperSend := 8.
  	IsDirectedSuperSend := 9.
  	IsNSSelfSend := NewspeakVM ifTrue: [10].
  	IsNSDynamicSuperSend := NewspeakVM ifTrue: [11].
  	IsNSImplicitReceiverSend := NewspeakVM ifTrue: [12].
  
  	DisplacementMask := (1 << AnnotationShift) - 1.
  	DisplacementX2N := IsDisplacementX2N << AnnotationShift.
  	FirstAnnotation := IsObjectReference << AnnotationShift.
  	MaxX2NDisplacement := DisplacementMask << AnnotationShift.
  
  	MapEnd := 0.
  
  	AnnotationConstantNames := #(	IsDisplacementX2N
  										IsAnnotationExtension
  										IsObjectReference
  										IsAbsPCReference
  										IsRelativeCall
  										HasBytecodePC
  										IsNSSendCall
  										IsSendCall
  										IsSuperSend
  										IsDirectedSuperSend
  										IsNSSelfSend
  										IsNSDynamicSuperSend
  										IsNSImplicitReceiverSend).
  	AnnotationsWithBytecodePCs := #(HasBytecodePC
  										IsNSSendCall
  										IsSendCall
  										IsSuperSend
  										IsDirectedSuperSend
  										IsNSSelfSend
  										IsNSDynamicSuperSend
+ 										IsNSImplicitReceiverSend),
+ 										{'IsRelativeCall:\HasBytecodePC' withCRs}!
- 										IsNSImplicitReceiverSend)!

Item was changed:
  ----- Method: Cogit>>disassembleMethod:on: (in category 'disassembly') -----
  disassembleMethod: surrogateOrAddress on: aStream
  	<doNotGenerate>
  	| cogMethod mapEntries codeRanges |
  	cogMethod := surrogateOrAddress isInteger
  								ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress]
  								ifFalse: [surrogateOrAddress].
  	cogMethod cmType = CMBlock ifTrue:
  		[^self disassembleMethod: cogMethod cmHomeMethod on: aStream].
  	(disassemblingMethod isNil
  	 and: [self class initializationOptions at: #relativeAddressDisassembly ifAbsent: [false]]) ifTrue:
  		[^[disassemblingMethod := cogMethod.
  		    self disassembleMethod: surrogateOrAddress on: aStream] ensure:
  			[disassemblingMethod := nil]].
  	self printMethodHeader: cogMethod on: aStream.
  
  	mapEntries := Dictionary new.
  	(cogMethod cmType = CMMethod and: [cogMethod cmIsFullBlock]) ifFalse:
  		[mapEntries at: cogMethod asInteger + cmEntryOffset put: 'entry'].
  	
  	cogMethod cmType = CMMethod ifTrue:
  		[cogMethod cmIsFullBlock
  			ifTrue: [mapEntries at: cogMethod asInteger + cbNoSwitchEntryOffset put: 'noSwitchEntry']
  			ifFalse: [mapEntries at: cogMethod asInteger + cmNoCheckEntryOffset put: 'noCheckEntry']].
  
  	cogMethod cmType = CMClosedPIC
  		ifTrue:
  			[mapEntries at: cogMethod asInteger + firstCPICCaseOffset put: 'ClosedPICCase0'.
  			 1 to: MaxCPICCases - 1 do:
  				[:i|
  				mapEntries
  					at: cogMethod asInteger + firstCPICCaseOffset + (i * cPICCaseSize)
  					put: 'ClosedPICCase', i printString]]
  		ifFalse:
  			[self mapFor: cogMethod
  				performUntil: #collectMapEntry:address:into:
  				arg: mapEntries].
  
  	NewspeakVM ifTrue:
  		[objectRepresentation canPinObjects ifFalse:
  			[mapEntries keys do:
  				[:a|
  				(mapEntries at: a) = #IsNSSendCall ifTrue:
  					[mapEntries
  						at: a + backEnd jumpShortByteSize
  							put: {'Class'. #disassembleCachedOop:. (objectMemory wordSize)};
  						at: a + backEnd jumpShortByteSize + objectMemory bytesPerOop
  							put: {'ImplicitReceiver'. #disassembleCachedOop:. (objectMemory wordSize)}]]]].
  
  	"This would all be far more elegant and simple if we used blocks.
  	 But there are no blocks in C and the basic enumerators here need
  	 to be used in the real VM.  Apologies."
  	(codeRanges := self codeRangesFor: cogMethod) do:
  		[:range|
  		(cogMethod cmType = CMMethod) ifTrue:
  			[mapEntries keysAndValuesDo:
  				[:mcpc :label| | bcpc selectorOrNone |
+ 				(((range includes: mcpc) or: [range last + 1 = mcpc])
- 				((range includes: mcpc)
  				 and: [(AnnotationsWithBytecodePCs includes: label)
  				 and: [range cogMethod stackCheckOffset > 0]]) ifTrue:
  					[bcpc := self bytecodePCFor: mcpc startBcpc: range startpc in: range cogMethod.
  					 bcpc ~= 0 ifTrue:
  						[label = #IsSendCall
  							ifTrue:
  								[selectorOrNone := (self selectorForSendAt: mcpc annotation: IsSendCall in: cogMethod methodObject).
  								 (selectorOrNone isInteger and: [objectMemory addressCouldBeOop: selectorOrNone]) ifTrue:
  									[selectorOrNone := objectMemory stringOf: selectorOrNone].
  								selectorOrNone := ' ', selectorOrNone]
  							ifFalse: [selectorOrNone := ''].
  						 mapEntries
  							at: mcpc
  							put: label, selectorOrNone, ' bc ', bcpc printString, '/', (bcpc + 1) printString]]]].
  		(cogMethod blockEntryOffset ~= 0
  		 and: [range first = (cogMethod blockEntryOffset + cogMethod asInteger)])
  			ifTrue:
  				[aStream nextPutAll: 'blockEntry:'; cr.
  				 self blockDispatchFor: cogMethod
  					perform: #disassemble:from:to:arg:
  					arg: aStream]
  			ifFalse:
  				[range first > (cogMethod address + cmNoCheckEntryOffset) ifTrue:
  					[self printMethodHeader: range cogMethod
  						on: aStream].
  				self disassembleFrom: range first to: range last labels: mapEntries on: aStream]].
  	aStream nextPutAll: 'startpc: '; print: codeRanges first startpc; cr.
  	(cogMethod cmType = CMMethod
  	 or: [cogMethod cmType = CMOpenPIC]) ifTrue:
  		[[self mapFor: cogMethod
  			performUntil: #printMapEntry:mcpc:args:
  			arg: { aStream. codeRanges. cogMethod }]
  			on: AssertionFailure
  			do: [:ex|
  				ex primitiveChangeClassTo: ResumableVMError basicNew. ":) :) :)"
  				ex resume: nil]].
  	^cogMethod!

Item was changed:
  ----- Method: Cogit>>printMapEntry:mcpc:args: (in category 'disassembly') -----
  printMapEntry: annotation mcpc: mcpc args: tupleOfStreamCodeRangesAndMethod
  	"Print the Map entry's mcpc, its annotation and the corresponding bytecode pc, if any."
  	<doNotGenerate>
  	| printHex |
  	printHex := disassemblingMethod
  					ifNil: [[:pc| pc hex]]
  					ifNotNil: [[:pc| '.+', (pc - disassemblingMethod asInteger printStringBase: 16 length: 4 padded: true)]].
  	[:aStream :codeRanges :cogMethod|
  	self startMcpcAndCogMethodForMcpc: mcpc in: cogMethod do:
  		[:startmcpc :subMethod| | name codeRange |
  		"Find the start of the block by searching the code ranges."
+ 		codeRange := codeRanges detect: [:range| range includes: mcpc] ifNone: [codeRanges detect: [:range| range last + 1 = mcpc]].
- 		codeRange := codeRanges detect: [:range| range includes: mcpc].
  		codeRange first = mcpc ifTrue:
  			[aStream nextPutAll: 'startpc: '; print: codeRange startpc; cr].
  		aStream
  			next: 2 put: Character space;
  			nextPutAll: (printHex value: mcpc);  space;
  			nextPutAll: (name := self class annotationConstantNames at: annotation + 1);
  			next: 20 - name size put: Character space;
  			nextPut: $(;
  			nextPutAll: (printHex value: (self findMapLocationForMcpc: mcpc inMethod: cogMethod)).
  		(self isPCMappedAnnotation: annotation) ifTrue:
  			[aStream
  				nextPutAll: ', bc: ';
  				print: (self bytecodePCFor: mcpc startBcpc: codeRange startpc in: subMethod)].
  		(self isSendAnnotation: annotation) ifTrue:
  			[| sel |
  			sel := self selectorForSendAt: mcpc annotation: annotation in: cogMethod methodObject.
  			sel isInteger ifTrue:
  				[sel := self lookupAddress: sel].
  			sel isString ifTrue:
  				[aStream space; nextPutAll: sel]].
  		aStream
  			nextPut: $);
  			cr; flush]]
  		valueWithArguments: tupleOfStreamCodeRangesAndMethod.
  	^0!

Item was changed:
  ----- Method: Cogit>>startMcpcAndCogMethodForMcpc:in:do: (in category 'disassembly') -----
  startMcpcAndCogMethodForMcpc: mcpc in: cogMethod do: aBinaryBlock
  	"Evaluate aBinaryBlock with the startmcpc and method containing mcpc in cogMethod."
  	<doNotGenerate>
  	| startMcpc |
  	startMcpc := ((self codeRangesFor: cogMethod)
  					detect: [:range| range includes: mcpc]
+ 					ifNone:
+ 						[(self codeRangesFor: cogMethod)
+ 							detect: [:range| range last + 1 = mcpc]
+ 							ifNone: [^nil]]) first.
- 					ifNone: [^nil]) first.
  	^aBinaryBlock
  		value: startMcpc
  		value: (startMcpc = (cogMethod asInteger + (self sizeof: CogMethod))
  					ifTrue: [cogMethod]
  					ifFalse: [self cCoerceSimple: startMcpc - (self sizeof: CogBlockMethod)
  								to: #'CogBlockMethod *'])!



More information about the Vm-dev mailing list