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

commits at source.squeak.org commits at source.squeak.org
Wed Apr 27 00:08:34 UTC 2016


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

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

Name: VMMaker.oscog-eem.1848
Author: eem
Time: 26 April 2016, 5:06:28.431902 pm
UUID: d9bc9a1b-451c-48b8-ba81-4c932fc83ca0
Ancestors: VMMaker.oscog-eem.1847

In 1848 Giuseppe Verdi wishes to replace soprano Eugenia Tadolini as Lady Macbeth for the first Naples performance of his opera Macbeth on the grounds that her voice and appearance are too beautiful.

Add printActivationsOf: and have it and printContextReferencesTo: print the pcs of the contexts they find.

Eliminate duplication in [directed]SuperclassSend.

Fix the order of the annotation names to fix disassembly in the simulator given VMMaker.oscog-eem.1847.  Print the homeOffset as well as the homeMethod in embedded block methods.

A few minor changes to eliminate C compiler warnings.

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

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
- 										HasBytecodePC
  										IsRelativeCall
+ 										HasBytecodePC
  										IsNSSendCall
  										IsSendCall
  										IsSuperSend
  										IsDirectedSuperSend
  										IsNSSelfSend
  										IsNSDynamicSuperSend
  										IsNSImplicitReceiverSend).
  	AnnotationsWithBytecodePCs := #(HasBytecodePC
  										IsNSSendCall
  										IsSendCall
  										IsSuperSend
  										IsDirectedSuperSend
  										IsNSSelfSend
  										IsNSDynamicSuperSend
  										IsNSImplicitReceiverSend)!

Item was changed:
  ----- Method: Cogit>>printMethodHeader:on: (in category 'disassembly') -----
  printMethodHeader: cogMethod on: aStream
  	<doNotGenerate>
  	self cCode: ''
  		inSmalltalk:
  			[cogMethod isInteger ifTrue:
  				[^self printMethodHeader: (self cogMethodOrBlockSurrogateAt: cogMethod) on: aStream]].
  	aStream ensureCr.
  	cogMethod asInteger printOn: aStream base: 16.
  	cogMethod cmType = CMMethod ifTrue:
  		[aStream crtab; nextPutAll: 'objhdr: '.
  		cogMethod objectHeader printOn: aStream base: 16].
  	cogMethod cmType = CMBlock ifTrue:
  		[aStream crtab; nextPutAll: 'homemth: '.
  		cogMethod cmHomeMethod asUnsignedInteger printOn: aStream base: 16.
+ 		aStream
+ 			nextPutAll: ' (offset '; print: cogMethod homeOffset; nextPut: $);
+ 			crtab; nextPutAll: 'startpc: '; print: cogMethod startpc].
- 		aStream crtab; nextPutAll: 'startpc: '; print: cogMethod startpc].
  	aStream
  		crtab; nextPutAll: 'nArgs: ';	print: cogMethod cmNumArgs;
  		tab;    nextPutAll: 'type: ';	print: cogMethod cmType.
  	(cogMethod cmType ~= 0 and: [cogMethod cmType ~= CMBlock]) ifTrue:
  		[aStream crtab; nextPutAll: 'blksiz: '.
  		cogMethod blockSize printOn: aStream base: 16.
  		cogMethod cmType = CMMethod ifTrue:
  			[aStream crtab; nextPutAll: 'method: '.
  			 cogMethod methodObject printOn: aStream base: 16.
  			 aStream crtab; nextPutAll: 'mthhdr: '.
  			 cogMethod methodHeader printOn: aStream base: 16].
  		aStream crtab; nextPutAll: 'selctr: '.
  		cogMethod selector printOn: aStream base: 16.
  		(coInterpreter lookupAddress: cogMethod selector) ifNotNil:
  			[:string| aStream nextPut: $=; nextPutAll: string].
  		cogMethod cmType = CMMethod ifTrue:
  			[aStream crtab; nextPutAll: 'blkentry: '.
  			 cogMethod blockEntryOffset printOn: aStream base: 16.
  			 cogMethod blockEntryOffset ~= 0 ifTrue:
  				[aStream nextPutAll: ' => '.
  				 cogMethod asInteger + cogMethod blockEntryOffset printOn: aStream base: 16]]].
  	cogMethod cmType = CMClosedPIC
  		ifTrue:
  			[aStream crtab; nextPutAll: 'cPICNumCases: '.
  			 cogMethod cPICNumCases printOn: aStream base: 16;
  			 tab; nextPutAll: 'cpicHasMNUCase: ';
  			 nextPutAll: (cogMethod cpicHasMNUCase ifTrue: ['yes'] ifFalse: ['no'])]
  		ifFalse:
  			[aStream crtab; nextPutAll: 'stackCheckOffset: '.
  			 cogMethod stackCheckOffset printOn: aStream base: 16.
  			 cogMethod stackCheckOffset > 0 ifTrue:
  				[aStream nextPut: $/.
  				 cogMethod asInteger + cogMethod stackCheckOffset printOn: aStream base: 16].
  			cogMethod cmType = CMBlock
  				ifTrue:
  					[aStream
  						crtab;
  						nextPutAll: 'cbUsesInstVars ';
  						nextPutAll: (cogMethod cbUsesInstVars ifTrue: ['yes'] ifFalse: ['no'])]
  				ifFalse:
  					[aStream
  						crtab;
  						nextPutAll: 'cmRefersToYoung: ';
  						nextPutAll: (cogMethod cmRefersToYoung ifTrue: ['yes'] ifFalse: ['no']);
  						tab;
  						nextPutAll: 'cmIsFullBlock: ';
  						nextPutAll: (cogMethod cmIsFullBlock ifTrue: ['yes'] ifFalse: ['no'])].
  			cogMethod cmType = CMMethod ifTrue:
  				[([cogMethod nextMethodOrIRCs] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
  					[:nmoircs| aStream crtab; nextPutAll: 'nextMethodOrIRCs: '.
  						nmoircs = 0 ifTrue: [aStream print: nmoircs] ifFalse: [coInterpreter printHex: nmoircs]].
  				 ([cogMethod counters] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
  					[:cntrs| aStream crtab; nextPutAll: 'counters: '.
  						cntrs = 0 ifTrue: [aStream print: cntrs] ifFalse: [coInterpreter printHex: cntrs]]]].
  	aStream cr; flush!

Item was changed:
  ----- Method: Cogit>>warnMultiple:selectors: (in category 'debug printing') -----
  warnMultiple: cogMethod selectors: aSelectorOop
  	<inline: true>
+ 	self cCode: 'extern void *firstIndexableField(sqInt)'.
  	self cCode:
  			[self fp: #stderr
  				r: 'Warning, attempt to use method with selector %.*s and selector %.*s\n'
  				i: (self cCoerceSimple: (objectMemory numBytesOf: cogMethod selector) to: #int)
  				n: (self cCoerceSimple: (objectMemory firstIndexableField: cogMethod selector) to: #'char *')
  				t: (objectMemory numBytesOf: aSelectorOop)
  				f: (self cCoerceSimple: (objectMemory firstIndexableField: aSelectorOop) to: #'char *')]
  		inSmalltalk:
  			[self warn: 'Warning, attempt to use method with selector ',
  						(coInterpreter stringOf: cogMethod selector),
  						' and selector ',
  						(coInterpreter stringOf: aSelectorOop)]!

Item was added:
+ ----- Method: NewObjectMemory>>printActivationsOf: (in category 'debug printing') -----
+ printActivationsOf: aMethodObj
+ 	"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ 	| oop |
+ 	<api>
+ 	oop := self firstAccessibleObject.
+ 	[oop = nil] whileFalse:
+ 		[((self isContextNonImm: oop)
+ 		  and: [aMethodObj = (self fetchPointer: MethodIndex ofObject: oop)]) ifTrue:
+ 			[coInterpreter
+ 				printHex: oop; printOopShort: oop; print: ' pc ';
+ 				printHex: (self fetchPointer: InstructionPointerIndex ofObject: oop); cr].
+ 		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: NewObjectMemory>>printContextReferencesTo: (in category 'debug printing') -----
  printContextReferencesTo: anOop
  	"Scan the heap printing the oops of any and all contexts that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[(self isContextNonImm: oop) ifTrue:
  			[i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)].
  			 [(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
+ 					[coInterpreter
+ 						printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop;
+ 						print: ' pc '; printHex: (self fetchPointer: InstructionPointerIndex ofObject: oop); cr.
- 					[coInterpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
  					 i := 0]].
  		 oop := self accessibleObjectAfter: oop]!

Item was added:
+ ----- Method: ObjectMemory>>printActivationsOf: (in category 'debug printing') -----
+ printActivationsOf: aMethodObj
+ 	"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ 	| oop |
+ 	<api>
+ 	oop := self firstAccessibleObject.
+ 	[oop = nil] whileFalse:
+ 		[((self isContextNonImm: oop)
+ 		  and: [aMethodObj = (self fetchPointer: MethodIndex ofObject: oop)]) ifTrue:
+ 			[self interpreter
+ 				printHex: oop; printOopShort: oop; print: ' pc ';
+ 				printHex: (self fetchPointer: InstructionPointerIndex ofObject: oop); cr].
+ 		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: SpurMemoryManager>>lowSpaceThreshold: (in category 'free space') -----
  lowSpaceThreshold: threshold
  	lowSpaceThreshold := threshold.
+ 	"N.B. The threshold > 0 guard eliminates a warning when
+ 		self lowSpaceThreshold: 0
+ 	 is inlined into setSignalLowSpaceFlagAndSaveProcess"
+ 	(threshold > 0
+ 	 and: [totalFreeOldSpace < threshold]) ifTrue:
- 	totalFreeOldSpace < threshold ifTrue:
  		[self growOldSpaceByAtLeast: threshold - totalFreeOldSpace].
  	self assert: totalFreeOldSpace >= lowSpaceThreshold!

Item was added:
+ ----- Method: SpurMemoryManager>>printActivationsOf: (in category 'debug printing') -----
+ printActivationsOf: aMethodObj
+ 	"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ 	<api>
+ 	self allObjectsDo:
+ 		[:obj| 
+ 		 ((self isContextNonImm: obj)
+ 		  and: [aMethodObj = (self fetchPointer: MethodIndex ofObject: obj)]) ifTrue:
+ 			[coInterpreter
+ 				printHex: obj; printOopShort: obj; print: ' pc ';
+ 				printHex: (self fetchPointer: InstructionPointerIndex ofObject: obj); cr]]!

Item was changed:
  ----- Method: SpurMemoryManager>>printContextReferencesTo: (in category 'debug printing') -----
  printContextReferencesTo: anOop
  	"Scan the heap printing the oops of any and all contexts that refer to anOop"
  	<api>
  	self allObjectsDo:
  		[:obj| | i |
  		 (self isContextNonImm: obj) ifTrue:
  			[i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj).
  			 [(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: obj) ifTrue:
+ 					[coInterpreter
+ 						printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj;
+ 						print: ' pc '; printHex: (self fetchPointer: InstructionPointerIndex ofObject: obj); cr.
- 					[coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr.
  					 i := 0]]]]!

Item was changed:
  ----- Method: StackInterpreter>>directedSuperclassSend (in category 'send bytecodes') -----
  directedSuperclassSend
  	"Send a message to self, starting lookup with the superclass of the class on top of stack."
  	"Assume: messageSelector and argumentCount have been set, and that
  	 the receiver and arguments have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	<sharedCodeInCase: #extSendSuperBytecode>
  	<option: #SistaVM>
  	| class superclass |
  	class := self internalPopStack.
  	(objectMemory isForwarded: class) ifTrue:
  		[class := objectMemory followForwarded: class].
  	superclass := self superclassOf: class.
+ 	"classTagForClass: uses ensureBehaviorHash:"
- 	objectMemory ensureBehaviorHash: superclass.
  	lkupClassTag := objectMemory classTagForClass: superclass.
  	"To maintain the invariant that all receivers are unforwarded we need an explicit
  	 read barrier in the super send cases.  Even though we always follow receivers
  	 on become  e.g. super doSomethingWith: (self become: other) forwards the receiver
  	 self pushed on the stack."
  	self ensureReceiverUnforwarded.
  	self assert: lkupClassTag ~= objectMemory nilObject.
  	self commonSendOrdinary!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| fmt lastIndex startIP bytecodesPerLine column |
  	((objectMemory isImmediate: oop)
  	 or: [(objectMemory addressCouldBeObj: oop) not
  	 or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [objectMemory isForwarded: oop]]]]) ifTrue:
  		[self printOop: oop.
  		 ^self].
  	self printHex: oop.
  	(objectMemory fetchClassOfNonImm: oop)
  		ifNil: [self print: ' has a nil class!!!!']
  		ifNotNil: [:class|
  			self print: ': a(n) '; printNameOfClass: class count: 5;
  				print: ' ('.
  			objectMemory hasSpurMemoryManagerAPI ifTrue:
  				[self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>'].
  			self printHexnp: class; print: ')'].
  	fmt := objectMemory formatOf: oop.
  	self print: ' format '; printHexnp: fmt.
  	fmt > objectMemory lastPointerFormat
  		ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)]
  		ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
  					[| len |
  					len := objectMemory lengthOf: oop.
  					self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
  	objectMemory printHeaderTypeOf: oop.
  	self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
  	self cr.
  	(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		[^self printStringOf: oop; cr].
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
  		[0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchLong32: i ofObject: oop.
  			self space; printNum: i; space; printHex: fieldOop; space; cr].
  		 ^self].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
  			self space; printNum: i - 1; space; printHex: fieldOop; space.
  			(i = 1 and: [objectMemory isCompiledMethod: oop])
  				ifTrue: [self printMethodHeaderOop: fieldOop]
  				ifFalse: [self cCode: [self printOopShort: fieldOop]
  							inSmalltalk: [self print: (self shortPrint: fieldOop)]].
  			self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > lastIndex ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * objectMemory wordSize + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
+ 					[self cCode: 'printf("0x%08lx: ", (unsigned long)(oop+BaseHeaderSize+index-1))'
- 					[self cCode: 'printf("0x%08lx: ", oop+BaseHeaderSize+index-1)'
  						inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
  	| cls fmt lastIndex startIP bytecodesPerLine column |
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[^self shortPrintOop: oop].
  	self printHex: oop.
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [self whereIs: oop]); cr].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop).
  		 objectMemory hasSpurMemoryManagerAPI ifTrue:
  			[self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop).
  			 objectMemory printHeaderTypeOf: oop].
  		 ^self cr].
  	(objectMemory isForwarded: oop) ifTrue:
  		[self
  			print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
  			print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop).
  		 objectMemory printHeaderTypeOf: oop.
  		 ^self cr].
  	self print: ': a(n) '.
  	self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr].
  	fmt := objectMemory formatOf: oop.
  	fmt > objectMemory lastPointerFormat ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
  	self cr.
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		["This will answer false if splObj: ClassAlien is nilObject"
  		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  			self print: ((self isIndirectAlien: oop)
  							ifTrue: [' indirect @ ']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: [' pointer @ ']
  									ifFalse: [' direct @ ']]).
  			 ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
  		 (objectMemory isWords: oop) ifTrue:
  			[lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
  			 lastIndex > 0 ifTrue:
  				[1 to: lastIndex do:
  					[:index|
  					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  						[self cr]].
  				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  					[self cr]].
  			^self].
  		^self printStringOf: oop; cr].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index|
  			self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
  				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  				[self cr]].
  		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  			[self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * objectMemory wordSize + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
+ 					[self cCode: 'printf("0x%08lx: ", (unsigned long)(oop+BaseHeaderSize+index-1))'
- 					[self cCode: 'printf("0x%08lx: ", oop+BaseHeaderSize+index-1)'
  						inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>superclassSend (in category 'send bytecodes') -----
  superclassSend
  	"Send a message to self, starting lookup with the superclass of the class
  	 containing the currently executing method."
  	"Assume: messageSelector and argumentCount have been set, and that
  	 the receiver and arguments have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	<sharedCodeInCase: #singleExtendedSuperBytecode>
  	| superclass |
  	superclass := self superclassOf: (self methodClassOf: method).
+ 	"classTagForClass: uses ensureBehaviorHash:"
- 	objectMemory ensureBehaviorHash: superclass.
  	lkupClassTag := objectMemory classTagForClass: superclass.
  	"To maintain the invariant that all receivers are unforwarded we need an explicit
  	 read barrier in the super send cases.  Even though we always follow receivers
  	 on become  e.g. super doSomethingWith: (self become: other) forwards the receiver
  	 self pushed on the stack."
  	self ensureReceiverUnforwarded.
  	self assert: lkupClassTag ~= objectMemory nilObject.
  	self commonSendOrdinary!



More information about the Vm-dev mailing list