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

commits at source.squeak.org commits at source.squeak.org
Fri Apr 15 17:23:55 UTC 2016


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

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

Name: VMMaker.oscog-eem.1805
Author: eem
Time: 15 April 2016, 10:22:05.002185 am
UUID: 61d3f13e-a9e7-4be6-98ed-6cbc4d2d9794
Ancestors: VMMaker.oscog-cb.1804

Abstract away the first mapped pc in a method as this is dfferent in a full block.
Fix some debug printing for full blocks.

=============== Diff against VMMaker.oscog-cb.1804 ===============

Item was changed:
  ----- Method: CogBlockMethod>>cmIsFullBlock (in category 'accessing') -----
  cmIsFullBlock
  	"Answer the value of cpicHasMNUCaseOrCMIsFullBlock"
+ 	<inline: true>
- 
  	^SistaV1BytecodeSet
  		ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock]
  		ifFalse: [false]!

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'].
- 	(mapEntries := Dictionary new)
- 		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']].
- 		[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)
  				 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>>findMapLocationForMcpc:inMethod: (in category 'method map') -----
  findMapLocationForMcpc: targetMcpc inMethod: cogMethod
  	<var: #cogMethod type: #'CogMethod *'>
  	| mcpc map mapByte annotation |
+ 	mcpc := self firstMappedPCFor: cogMethod.
- 	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
  	map := self mapStartFor: cogMethod.
  	mcpc = targetMcpc ifTrue: [^map].
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
  		[annotation := mapByte >> AnnotationShift.
  		 annotation ~= IsAnnotationExtension ifTrue:
  			[mcpc := mcpc + (backEnd codeGranularity
  								* (annotation = IsDisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte bitAnd: DisplacementMask]))].
  		 mcpc >= targetMcpc ifTrue:
  			[self assert: mcpc = targetMcpc.
  			 annotation = IsDisplacementX2N ifTrue:
  				[map := map - 1.
  				 mapByte := objectMemory byteAt: map.
  				 annotation := mapByte >> AnnotationShift.
  				 self assert: annotation > IsAnnotationExtension].
  			 ^map].
  		 map := map - 1].
  	^0!

Item was added:
+ ----- Method: Cogit>>firstMappedPCFor: (in category 'method map') -----
+ firstMappedPCFor: cogMethod
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	<inline: true>
+ 	^cogMethod cmIsFullBlock
+ 		ifTrue: [cogMethod asUnsignedInteger + cbNoSwitchEntryOffset]
+ 		ifFalse: [cogMethod asUnsignedInteger + cmNoCheckEntryOffset]!

Item was changed:
  ----- Method: Cogit>>mapEndFor: (in category 'method map') -----
  mapEndFor: cogMethod
  	"Answer the address of the null byte at the end of the method map."
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: true>
  	| end |
  	end := self mapStartFor: cogMethod.
  	[(objectMemory byteAt: end) ~= MapEnd] whileTrue:
  		[end := end - 1.
+ 		 self assert: end > (self firstMappedPCFor: cogMethod)].
- 		 self assert: end > (cogMethod asInteger + cmNoCheckEntryOffset)].
  	^end!

Item was changed:
  ----- Method: Cogit>>mapFor:performAllMapEntriesUntil:arg: (in category 'method map') -----
  mapFor: cogMethod performAllMapEntriesUntil: functionSymbol arg: arg
  	"Analysis support"
  	<doNotGenerate>
  	| mcpc map mapByte result |
+ 	mcpc := self firstMappedPCFor: cogMethod.
- 	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
  	map := self mapStartFor: cogMethod.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[mcpc := mcpc + ((mapByte bitAnd: DisplacementMask) * backEnd codeGranularity)]
  			ifFalse:
  				[mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
  					[mcpc := mcpc + ((mapByte - DisplacementX2N << AnnotationShift) * backEnd codeGranularity)]].
  		 result := self perform: functionSymbol
  					   with: mapByte >> AnnotationShift
  					   with: (self cCoerceSimple: mcpc to: #'char *')
  					   with: arg.
  		 result ~= 0 ifTrue:
  			[^result].
  		 map := map - 1].
  	^0!

Item was changed:
  ----- Method: Cogit>>mapFor:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod performUntil: functionSymbol arg: arg
  	"Unlinking/GC/Disassembly support"
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(sqInt annotation, char *mcpc, sqInt arg)'>
  	<inline: true>
  	| mcpc map mapByte annotation result |
+ 	mcpc := self firstMappedPCFor: cogMethod.
- 	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
  	map := self mapStartFor: cogMethod.
  	self inlineCacheTagsAreIndexes ifTrue:
  		[enumeratingCogMethod := cogMethod].
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[mcpc := mcpc + ((mapByte bitAnd: DisplacementMask) * backEnd codeGranularity).
  				 "If this is an IsSendCall annotation, peek ahead for an IsAnnotationExtension, and consume it."
  				 ((annotation := mapByte >> AnnotationShift) = IsSendCall
  				  and: [(mapByte := objectMemory byteAt: map - 1) >> AnnotationShift = IsAnnotationExtension]) ifTrue:
  					[annotation := annotation + (mapByte bitAnd: DisplacementMask).
  					 map := map - 1].
  				 result := self perform: functionSymbol
  							   with: annotation
  							   with: (self cCoerceSimple: mcpc to: #'char *')
  							   with: arg.
  				 result ~= 0 ifTrue:
  					[^result]]
  			ifFalse:
  				[mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
  					[mcpc := mcpc + ((mapByte - DisplacementX2N << AnnotationShift) * backEnd codeGranularity)]].
  		 map := map - 1].
  	^0!

Item was changed:
  ----- Method: Cogit>>printPCMapPairsFor: (in category 'method map') -----
  printPCMapPairsFor: cogMethod
  	<api>
  	<var: 'cogMethod' type: #'CogMethod *'>
  	<var: 'mapByte' type: #'unsigned char'>
  	| mcpc map mapByte annotation value |
+ 	mcpc := self firstMappedPCFor: cogMethod.
- 	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
  	map := self mapStartFor: cogMethod.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
  		[annotation := mapByte >> AnnotationShift.
  		 annotation = IsAnnotationExtension
  			ifTrue:
  				[value := (mapByte bitAnd: DisplacementMask) + IsSendCall]
  			ifFalse:
  				[value := annotation.
  				 mcpc := mcpc + (backEnd codeGranularity
  									* (annotation = IsDisplacementX2N
  										ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  										ifFalse: [mapByte bitAnd: DisplacementMask]))].
  		 coInterpreter
  			printHexnp: map;
  		 	print: ': '.
  		 self
  			cCode: [self print: '%02x' f: mapByte]
  			inSmalltalk:
  				[mapByte < 16 ifTrue:
  					[coInterpreter putchar: $0].
  				 coInterpreter printHexnp: mapByte].
  		 coInterpreter
  		 	printChar: $ ;
  			printNum: annotation;
  			print: ' ('.
  		 self cppIf: NewspeakVM
  			ifTrue:
  				[value
  					caseOf: {
  						[IsDisplacementX2N]		->	[coInterpreter print: 'IsDisplacementX2N'].
  						[IsAnnotationExtension]		->	[coInterpreter print: 'IsAnnotationExtension'].
  						[IsObjectReference]		->	[coInterpreter print: 'IsObjectReference'].
  						[IsAbsPCReference]		->	[coInterpreter print: 'IsAbsPCReference'].
  						[HasBytecodePC]			->	[coInterpreter print: 'HasBytecodePC'].
  						[IsRelativeCall]				->	[coInterpreter print: 'IsRelativeCall'].
  						[IsNSSendCall]				->	[coInterpreter print: 'IsNSSendCall'].
  						[IsSendCall]					->	[coInterpreter print: 'IsSendCall'].
  						[IsSuperSend]				->	[coInterpreter print: 'IsSuperSend'].
  						[IsDirectedSuperSend]		->	[coInterpreter print: 'IsDirectedSuperSend'].
  						[IsNSSelfSend]				->	[coInterpreter print: 'IsNSSelfSend'].
  						[IsNSDynamicSuperSend]	->	[coInterpreter print: 'IsNSDynamicSuperSend'].
  						[IsNSImplicitReceiverSend]	->	[coInterpreter print: 'IsNSImplicitReceiverSend'] }
  					otherwise: [coInterpreter print: '??? '; printHexnp: value]]
  			ifFalse:
  				[value
  					caseOf: {
  						[IsDisplacementX2N]		->	[coInterpreter print: 'IsDisplacementX2N'].
  						[IsAnnotationExtension]		->	[coInterpreter print: 'IsAnnotationExtension'].
  						[IsObjectReference]		->	[coInterpreter print: 'IsObjectReference'].
  						[IsAbsPCReference]		->	[coInterpreter print: 'IsAbsPCReference'].
  						[HasBytecodePC]			->	[coInterpreter print: 'HasBytecodePC'].
  						[IsRelativeCall]				->	[coInterpreter print: 'IsRelativeCall'].
  						[IsSendCall]					->	[coInterpreter print: 'IsSendCall'].
  						[IsSuperSend]				->	[coInterpreter print: 'IsSuperSend'].
  						[IsDirectedSuperSend]		->	[coInterpreter print: 'IsDirectedSuperSend'] }
  					otherwise: [coInterpreter print: '??? '; printHexnp: value]].
  		 coInterpreter
  			print: ') ';
  			printHexnp: (mapByte bitAnd: DisplacementMask);
  			printChar: $ ;
  			putchar: $@;
  		 printHex: mcpc;
  		 cr;
  		 flush.
  		 map := map - 1]!

Item was changed:
  ----- Method: Cogit>>printPCMapPairsFor:on: (in category 'method map') -----
  printPCMapPairsFor: cogMethod on: aStream
  	<doNotGenerate>
  	<inline: true>
  	| mcpc map mapByte annotation |
+ 	mcpc := self firstMappedPCFor: cogMethod.
- 	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
  	map := self mapStartFor: cogMethod.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
  		[annotation := mapByte >> AnnotationShift.
  		 annotation ~= IsAnnotationExtension ifTrue:
  			[mcpc := mcpc + (backEnd codeGranularity
  								* (annotation = IsDisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte bitAnd: DisplacementMask]))].
  		 aStream ensureCr.
  		 map printOn: aStream base: 16.
  		 aStream nextPutAll: ': '.
  		 mapByte printOn: aStream base: 16 length: 2 padded: true.
  		 aStream space.
  		 annotation printOn: aStream base: 16.
  		 aStream nextPutAll: ' ('; print: (AnnotationConstantNames at: annotation + 1); nextPutAll: ') '.
  		 (mapByte bitAnd: DisplacementMask) printOn: aStream base: 16.
  		 aStream space.
  		 aStream nextPut: $@.
  		 mcpc printOn: aStream base: 16.
  		 aStream flush.
  		 map := map - 1]!



More information about the Vm-dev mailing list