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

commits at source.squeak.org commits at source.squeak.org
Sat Aug 23 16:13:14 UTC 2014


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

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

Name: VMMaker.oscog-eem.863
Author: eem
Time: 23 August 2014, 5:10:37.802 pm
UUID: 379b797e-e115-4d63-b667-6d17ce3230d9
Ancestors: VMMaker.oscog-eem.862

Add an assert to check for a valid mehtodClassAssociation
in methods (arguably dubious) to help catch malformed
methods in multiple bytecode shenannigans.

Reduce the possibility for heisenbugs by providing
noFixupFollowField:ofObject: and using it in debugging code.

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

Item was changed:
  ----- Method: CoInterpreter>>updateStateOfSpouseContextForFrame:WithSP: (in category 'frame access') -----
  updateStateOfSpouseContextForFrame: theFP WithSP: theSP
  	"Update the frame's spouse context with the frame's current state except for the
  	 sender and instruction pointer, which are used to mark the context as married."
  	| theContext tempIndex pointer argsPointer |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #pointer type: #'char *'>
  	<var: #argsPointer type: #'char *'>
  	self assert: (self frameHasContext: theFP).
  	theContext := self frameContext: theFP.
  	self assert: (objectMemory isContext: theContext).
+ 	self assert: (self frameReceiver: theFP)
+ 				= (objectMemory noFixupFollowField: ReceiverIndex ofObject: theContext).
- 	objectMemory hasSpurMemoryManagerAPI
- 		ifTrue:
- 			["We do not need to follow forwarding pointer to the receiver; makeBaseFrameFor: does that.
- 			  In any case the assignments below updating the non-argument stack contents will do so."
- 			self assert: ((self frameReceiver: theFP)
- 						= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext)
- 						or: [(objectMemory isOopForwarded: (objectMemory fetchPointer: ReceiverIndex ofObject: theContext))
- 							and: [(objectMemory followForwarded: (objectMemory fetchPointer: ReceiverIndex ofObject: theContext))
- 								= (self frameReceiver: theFP)]])]
- 		ifFalse:
- 			[self assert: (self frameReceiver: theFP)
- 						= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext)].
  	(self isMachineCodeFrame: theFP)
  		ifTrue:
  			[tempIndex := self mframeNumArgs: theFP.
  			 pointer := theFP + FoxMFReceiver - BytesPerWord]
  		ifFalse:
  			[tempIndex := self iframeNumArgs: theFP.
  			 pointer := theFP + FoxIFReceiver - BytesPerWord].
  	"update the arguments. this would appear not to be strictly necessary, but is for two reasons.
  	 First, the fact that arguments are read-only is only as convention in the Smalltalk compiler;
  	 other languages may choose to modify arguments.
  	 Second, the Squeak runUntilErrorOrReturnFrom: nightmare pops the stack top, which may, in
  	 certain circumstances, be the last argument, and hence the last argument may not have been
  	 stored into the context."
  	argsPointer := theFP + (self frameStackedReceiverOffsetNumArgs: tempIndex).
  	1 to: tempIndex do:
  		[:i|
  		argsPointer := argsPointer - BytesPerWord.
  		self assert: (objectMemory addressCouldBeOop: (stackPages longAt: argsPointer)).
  		 objectMemory storePointer: ReceiverIndex + i
  			ofObject: theContext
  			withValue: (stackPages longAt: argsPointer)].
  	"now update the non-argument stack contents."
  	[pointer >= theSP] whileTrue:
  		[self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)).
  		 tempIndex := tempIndex + 1.
  		 objectMemory storePointer: ReceiverIndex + tempIndex
  			ofObject: theContext
  			withValue: (stackPages longAt: pointer).
  		 pointer := pointer - BytesPerWord].
  	self assert: ReceiverIndex + tempIndex < (objectMemory lengthOf: theContext).
  	objectMemory storePointerUnchecked: StackPointerIndex
  		ofObject: theContext
  		withValue: (objectMemory integerObjectOf: tempIndex)!

Item was added:
+ ----- Method: ObjectMemory>>noFixupFollowField:ofObject: (in category 'forward compatibility') -----
+ noFixupFollowField: fieldIndex ofObject: anObject
+ 	"Spur compatibility; in V3 this is a synonym for fetchPointer:ofObject:"
+ 	<inline: true>
+ 	^self fetchPointer: fieldIndex ofObject: anObject!

Item was added:
+ ----- Method: SpurMemoryManager>>noFixupFollowField:ofObject: (in category 'forwarding') -----
+ noFixupFollowField: fieldIndex ofObject: anObject
+ 	"Make sure the oop at fieldIndex in anObject is not forwarded (follow the
+ 	 forwarder there-in if so).  Answer the (possibly followed) oop at fieldIndex."
+ 	| objOop |
+ 	objOop := self fetchPointer: fieldIndex ofObject: anObject.
+ 	(self isOopForwarded: objOop) ifTrue:
+ 		[objOop := self followForwarded: objOop].
+ 	^objOop!

Item was changed:
  ----- Method: StackInterpreter>>findClassContainingMethod:startingAt: (in category 'debug support') -----
  findClassContainingMethod: meth startingAt: classObj
  	| currClass classDict classDictSize methodArray i |
+ 	(objectMemory isOopForwarded: classObj)
+ 		ifTrue: [currClass := objectMemory followForwarded: classObj]
+ 		ifFalse: [currClass := classObj].
- 	currClass := classObj.
  	[self assert: (objectMemory isForwarded: currClass) not.
+ 	 classDict := objectMemory noFixupFollowField: MethodDictionaryIndex ofObject: currClass.
- 	 classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
  	 self assert: (objectMemory isForwarded: classDict) not.
  	 classDictSize := objectMemory numSlotsOf: classDict.
+ 	 methodArray := objectMemory noFixupFollowField: MethodArrayIndex ofObject: classDict.
- 	 methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
  	 self assert: (objectMemory isForwarded: methodArray) not.
  	 i := 0.
  	 [i < (classDictSize - SelectorStart)] whileTrue:
+ 		[meth = (objectMemory noFixupFollowField: i ofObject: methodArray) ifTrue:
- 		[meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
  			[^currClass].
  		 i := i + 1].
+ 	 currClass := self noFixupSuperclassOf: currClass.
- 	 currClass := self superclassOf: currClass.
  	 currClass = objectMemory nilObject] whileFalse.
  	^currClass		"method not found in superclass chain"!

Item was changed:
  ----- Method: StackInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
  findClassOfMethod: meth forReceiver: rcvr
+ 	| rclass mclass |
- 	| rclass |
  	((objectMemory addressCouldBeOop: rcvr)
  	and: [(objectMemory isOopForwarded: rcvr) not]) ifTrue:
  		[rclass := objectMemory fetchClassOf: rcvr.
  		 (self addressCouldBeClassObj: rclass) ifTrue:
  			[rclass := self findClassContainingMethod: meth startingAt: rclass.
  			rclass ~= objectMemory nilObject ifTrue:
  				[^rclass]]].
  	((objectMemory addressCouldBeObj: meth)
  	 and: [objectMemory isCompiledMethod: meth]) ifFalse:
  		[^objectMemory nilObject].
+ 	mclass := self safeMethodClassOf: meth.
+ 	(self addressCouldBeClassObj: mclass) ifTrue:
+ 		[^objectMemory nilObject].
+ 	^self findClassContainingMethod: meth startingAt: (self safeMethodClassOf: meth)!
- 	^self findClassContainingMethod: meth startingAt: (self methodClassOf: meth)!

Item was changed:
  ----- Method: StackInterpreter>>findSelectorOfMethod: (in category 'debug support') -----
  findSelectorOfMethod: methArg
  	| meth classObj classDict classDictSize methodArray i |
  	(objectMemory addressCouldBeObj: methArg) ifFalse:
  		[^objectMemory nilObject].
  	(objectMemory isForwarded: methArg)
  		ifTrue: [meth := objectMemory followForwarded: methArg]
  		ifFalse: [meth := methArg].
  	 (objectMemory isOopCompiledMethod: meth) ifFalse:
  		[^objectMemory nilObject].
+ 	classObj := self safeMethodClassOf: meth.
- 	classObj := self methodClassOf: meth.
  	(self addressCouldBeClassObj: classObj) ifTrue:
  		[classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: classObj.
  		 classDictSize := objectMemory numSlotsOf: classDict.
  		 methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
  		 i := 0.
  		 [i < (classDictSize - SelectorStart)] whileTrue:
  			[meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
  				[^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)].
  				 i := i + 1]].
  	^objectMemory nilObject!

Item was changed:
  ----- Method: StackInterpreter>>initialPCForHeader:method: (in category 'compiled methods') -----
  initialPCForHeader: methodHeader method: theMethod
+ 	"Answer the initial PC for a method; used only in methods that build a frame.
+ 	 Hence add an assert to check that there's a sane methodClassAssociation."
+ 	<inline: true>
+ 	self assert: (self saneMethodClassAssociationIn: theMethod
+ 					numLiterals: (objectMemory literalCountOfMethodHeader: methodHeader)).
- 	<api>
  	^theMethod
  	+ ((LiteralStart + (objectMemory literalCountOfMethodHeader: methodHeader)) * BytesPerOop)
  	+ objectMemory baseHeaderSize!

Item was changed:
  ----- Method: StackInterpreter>>methodClassOf: (in category 'compiled methods') -----
  methodClassOf: methodPointer
  	<api>
  	"Using a read barrier here simplifies the become implementation and costs very little
  	 because the class index and ValueIndex of the association almost certainly share a cache line."
  	^self cppIf: NewspeakVM
  		ifTrue:
  			[| literal |
  			 literal := self followLiteral: (objectMemory literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
  			 literal = objectMemory nilObject
  				ifTrue: [literal]
  				ifFalse: [objectMemory followField: ValueIndex ofObject: literal]]
  		ifFalse:
  			[| literal |
  			 literal := self followLiteral: (objectMemory literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
+ 			 self assert: ((objectMemory isPointers: literal) and: [(objectMemory numSlotsOf: literal) > ValueIndex]).
  			 objectMemory followField: ValueIndex ofObject: literal]!

Item was added:
+ ----- Method: StackInterpreter>>noFixupSuperclassOf: (in category 'message sending') -----
+ noFixupSuperclassOf: classPointer
+ 	"No fixup version of superclassOf: that should not create heisenbugs"
+ 	<inline: true>
+ 	^objectMemory noFixupFollowField: SuperclassIndex ofObject: classPointer!

Item was added:
+ ----- Method: StackInterpreter>>safeMethodClassOf: (in category 'compiled methods') -----
+ safeMethodClassOf: methodPointer
+ 	"Safe version of methodClassOf: that deals with malformed compiled methods,
+ 	 etc, and does not fixup forwarding pointers.."
+ 	| literal maybeClass |
+ 	literal := self literal: (objectMemory literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
+ 	(objectMemory isOopForwarded: literal) ifTrue:
+ 		[literal := objectMemory followForwarded: literal].
+ 	((objectMemory isPointers: literal) and: [(objectMemory numSlotsOf: literal) > ValueIndex]) ifFalse:
+ 		[^objectMemory nilObject].
+ 	maybeClass := objectMemory fetchPointer: ValueIndex ofObject: literal.
+ 	(objectMemory isOopForwarded: maybeClass) ifTrue:
+ 		[maybeClass := objectMemory followForwarded: maybeClass].
+ 	^maybeClass!

Item was added:
+ ----- Method: StackInterpreter>>saneMethodClassAssociationIn:numLiterals: (in category 'compiled methods') -----
+ saneMethodClassAssociationIn: methodObj numLiterals: numLiterals
+ 	| shouldBeAssoc |
+ 	shouldBeAssoc := self literal: numLiterals - 1 ofMethod: methodObj.
+ 	(objectMemory isForwarded: shouldBeAssoc) ifTrue:
+ 		[shouldBeAssoc := objectMemory followForwarded: shouldBeAssoc].
+ 	^(objectMemory isPointers: shouldBeAssoc)
+ 	 and: [(objectMemory numSlotsOf: shouldBeAssoc) > ValueIndex
+ 	 and: [self addressCouldBeClassObj: (objectMemory noFixupFollowField: ValueIndex ofObject: shouldBeAssoc)]]!



More information about the Vm-dev mailing list