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

commits at source.squeak.org commits at source.squeak.org
Wed Jul 23 22:41:05 UTC 2014 

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

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

Name: VMMaker.oscog-eem.832
Author: eem
Time: 23 July 2014, 12:37:57.226 pm
UUID: afcb9ff1-804f-4aae-b052-a709b5a26470
Ancestors: VMMaker.oscog-eem.831

Spur:
More rationalization of the class table management post
become.  

Fix bug in assigning parameter 55.

Fix printStringOf: (used in e.g. frame print) to not print crs
that would cause previous info to be overwritten.

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

Item was changed:
  ----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in category 'become api') -----
  become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
  	"All references to each object in array1 are swapped with all references to the
  	 corresponding object in array2. That is, all pointers to one object are replaced
  	 with with pointers to the other. The arguments must be arrays of the same length. 
  	 Answers PrimNoErr if the primitive succeeds, otherwise a relevant error code."
  	"Implementation: Uses lazy forwarding to defer updating references until message send."
  	| ec |
  	self assert: becomeEffectsFlags = 0.
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  	(self isArray: array1) ifFalse:
  		[^PrimErrBadReceiver].
  	((self isArray: array2)
  	 and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) ifFalse:
  		[^PrimErrBadArgument].
  	(twoWayFlag or: [copyHashFlag])
  		ifTrue:
  			[ec := self containsOnlyValidBecomeObjects: array1 and: array2]
  		ifFalse:
  			[self followForwardedObjectFields: array2 toDepth: 0.
  			ec := self containsOnlyValidBecomeObjects: array1].
  	ec ~= 0 ifTrue: [^ec].
  
  	coInterpreter preBecomeAction.
  	twoWayFlag
  		ifTrue:
  			[self innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag]
  		ifFalse:
  			[self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
  	self followSpecialObjectsOop.
- 	self postBecomeOrCompactScanClassTable: becomeEffectsFlags.
  	coInterpreter postBecomeAction: becomeEffectsFlags.
  	becomeEffectsFlags := 0.
  
+ 	self assert: self validClassTableHashes.
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	^PrimNoErr "success"!

Item was changed:
  ----- Method: SpurMemoryManager>>classAtIndex:put: (in category 'class table') -----
  classAtIndex: classIndex put: objOop
  	"for become & GC of classes"
  	| classTablePage |
  	self assert: (classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun]).
  	self assert: (objOop = nilObj
+ 				 or: [((self rawHashBitsOf: objOop) = classIndex						"normal entry"
+ 					  or: [(self classAtIndex: (self rawHashBitsOf: objOop)) = objOop])	"become forces duplicate entry"
- 				 or: [(self rawHashBitsOf: objOop) = classIndex
  					and: [coInterpreter objCouldBeClassObj: objOop]]).
  	classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift
  							ofObject: hiddenRootsObj.
  	classTablePage = nilObj ifTrue:
  		[self error: 'attempt to add class to empty page'].
  	^self
  		storePointer: (classIndex bitAnd: self classTableMinorIndexMask)
  		ofObject: classTablePage
  		withValue: objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>doBecome:and:copyHash: (in category 'become implementation') -----
  doBecome: obj1 and: obj2 copyHash: copyHashFlag
+ 	"Inner dispatch for two-way become.
+ 	 N.B. At least in current two-way become use copyHashFlag is false."
- 	"Inner dispatch for two-way become"
  	| o1ClassIndex o2ClassIndex |
  	copyHashFlag ifFalse:
  		["in-lined
  			classIndex := (self isInClassTable: obj) ifTrue: [self rawHashBitsOf: obj] ifFalse: [0]
  		 for speed."
  		 o1ClassIndex := self rawHashBitsOf: obj1.
  		 (o1ClassIndex ~= 0 and: [(self classAtIndex: o1ClassIndex) ~= obj1]) ifTrue:
  			[o1ClassIndex := 0].
  		 o2ClassIndex := self rawHashBitsOf: obj2.
  		 (o2ClassIndex ~= 0 and: [(self classAtIndex: o2ClassIndex) ~= obj2]) ifTrue:
  			[o2ClassIndex := 0]].
+ 	(self numSlotsOf: obj1) = (self numSlotsOf: obj2) ifTrue:
+ 		[self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag.
+ 		 self assert: (o1ClassIndex = 0
+ 					or: [(self rawHashBitsOf: (self classAtIndex: o1ClassIndex)) = o1ClassIndex]).
+ 		 self assert: (o2ClassIndex = 0
+ 					or: [(self rawHashBitsOf: (self classAtIndex: o2ClassIndex)) = o2ClassIndex]).
+ 		 ^self].
+ 	self outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag.
- 	(self numSlotsOf: obj1) = (self numSlotsOf: obj2)
- 		ifTrue:
- 			[self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag]
- 		ifFalse:
- 			[self outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag].
  	"if copyHashFlag then nothing changes, since hashes were also swapped."
  	copyHashFlag ifTrue:
  		[^self].
  	"if copyHash is false then the classTable entries must be updated."
  	o1ClassIndex ~= 0
  		ifTrue:
  			[o2ClassIndex ~= 0
  				ifTrue: "both were in the table; just swap entries"
  					[| tmp |
  					 tmp := self classAtIndex: o1ClassIndex.
  					 self classAtIndex: o1ClassIndex put: obj2.
  					 self classAtIndex: o2ClassIndex put: tmp]
  				ifFalse: "o2 wasn't in the table; put it there"
  					[| newObj2 |
+ 					 newObj2 := self followForwarded: obj1.
- 					 (self isForwarded: obj1)
- 						ifTrue: [newObj2 := self followForwarded: obj1]
- 						ifFalse: [newObj2 := obj1].
  					 self assert: (self rawHashBitsOf: newObj2) = 0.
  					 self setHashBitsOf: newObj2 to: o1ClassIndex.
  					 self classAtIndex: o1ClassIndex put: newObj2]]
  		ifFalse:
  			[o2ClassIndex ~= 0 ifTrue:
  				[| newObj1 |
+ 				 newObj1 := self followForwarded: obj2.
- 				 (self isForwarded: obj2)
- 					ifTrue: [newObj1 := self followForwarded: obj2]
- 					ifFalse: [newObj1 := obj2].
  				 self assert: (self rawHashBitsOf: newObj1) = 0.
  				 self setHashBitsOf: newObj1 to: o2ClassIndex.
  				 self classAtIndex: o2ClassIndex put: newObj1]]!

Item was changed:
  ----- Method: SpurMemoryManager>>doBecome:to:copyHash: (in category 'become implementation') -----
  doBecome: obj1 to: obj2 copyHash: copyHashFlag
+ 	| o1HashBits o2HashBits |
+ 	o1HashBits := self rawHashBitsOf: obj1.
+ 	o2HashBits := self rawHashBitsOf: obj2.
- 	| hashBits |
  	self forward: obj1 to: obj2.
+ 	copyHashFlag ifTrue: [self setHashBitsOf: obj2 to: o1HashBits].
+ 	"obj1 is on its way out.  Remove it from the classTable"
+ 	(o1HashBits ~= 0 and: [(self classAtIndex: o1HashBits) = obj1])
+ 		ifTrue: [self expungeFromClassTable: obj1]
+ 		ifFalse: [o1HashBits := 0]. "= 0 implies was not in class table"
+ 	self deny: (self isForwarded: obj2).
+ 	"o1HashBits ~= 0 implies obj1 was in class table and hence may have had instances.
+ 	 Therefore o1HashBits needs to refer to obj2 (put obj2 in table at o1HashBits)."
+ 	o1HashBits ~= 0 ifTrue:
+ 		[o2HashBits = 0 ifTrue: "obj2 has no hash; we're free to assign one"
+ 			[self setHashBitsOf: obj2 to: o1HashBits].
+ 		 self classAtIndex: o1HashBits put: obj2]!
- 	copyHashFlag ifTrue:
- 		[hashBits := self rawHashBitsOf: obj2.
- 		 "silently refuse to change the hash of classes; this shouldn't happen anyway."
- 		 (self classAtIndex: hashBits) ~= obj2 ifTrue:
- 			[hashBits := self rawHashBitsOf: obj1.
- 			 self setHashBitsOf: obj2 to: hashBits]]!

Item was changed:
  ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:and:copyHash: (in category 'become implementation') -----
  innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag
  	"Inner loop of two-way become."
  	0 to: (self numSlotsOf: array1) - 1 do:
  		[:i| | obj1 obj2 |
  		"At first blush it would appear unnecessary to use followField: here since
  		 the validation in become:with:twoWay:copyHash: follows forwarders.  But
+ 		 there's nothing to ensure all elements of each array are unique and don't
- 		 there's nothing to ensure all elements of each array is unique and doesn't
  		 appear in the other array.  So the enumeration could encounter an object
  		 already becommed earlier in the same enumeration."
  		obj1 := self followField: i ofObject: array1.
  		obj2 := self followField: i ofObject: array2.
  		obj1 ~= obj2 ifTrue:
  			[self doBecome: obj1 and: obj2 copyHash: copyHashFlag.
  			 self followField: i ofObject: array1.
  			 self followField: i ofObject: array2]]!

Item was changed:
  ----- Method: SpurMemoryManager>>isInClassTable: (in category 'class table') -----
  isInClassTable: objOop
  	| hash |
  	hash := self rawHashBitsOf: objOop.
+ 	^hash ~= 0
+ 	 and: [(self classAtIndex: hash) = objOop]!
- 	hash = 0 ifTrue:
- 		[false].
- 	^(self classAtIndex: hash) = objOop!

Item was added:
+ ----- Method: SpurMemoryManager>>noCheckClassAtIndex: (in category 'class table') -----
+ noCheckClassAtIndex: classIndex
+ 	| classTablePage |
+ 	classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift
+ 							ofObject: hiddenRootsObj.
+ 	classTablePage = nilObj ifTrue:
+ 		[^nil].
+ 	^self
+ 		fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask)
+ 		ofObject: classTablePage!

Item was removed:
- ----- Method: SpurMemoryManager>>postBecomeOrCompactScanClassTable: (in category 'become implementation') -----
- postBecomeOrCompactScanClassTable: effectsFlags
- 	"Scan the class table post-become (iff a pointer object or compiled method was becommed),
- 	 or post-compact.
- 	 Note that one-way become can cause duplications in the class table.
- 	 When can these be eliminated?  We use the classTableBitmap to mark classTable entries
- 	 (not the classes themselves, since marking a class doesn't help in knowing if its index is used).
- 	 On image load, and during incrememtal scan-mark and full GC, classIndices are marked.
- 	 We can somehow avoid following classes from the classTable until after this mark phase."
- 	self assert: self validClassTableRootPages.
- 
- 	(effectsFlags anyMask: BecamePointerObjectFlag) ifFalse: [^self].
- 
- 	0 to: numClassTablePages - 1 do:
- 		[:i| | page |
- 		page := self fetchPointer: i ofObject: hiddenRootsObj.
- 		self assert: (self isForwarded: page) not.
- 		0 to: (self numSlotsOf: page) - 1 do:
- 			[:j| | classOrNil |
- 			classOrNil := self fetchPointer: j ofObject: page.
- 			classOrNil ~= nilObj ifTrue:
- 				[(self isForwarded: classOrNil) ifTrue:
- 					[classOrNil := self followForwarded: classOrNil.
- 					 self storePointer: j ofObject: page withValue: classOrNil]]]]!

Item was added:
+ ----- Method: SpurMemoryManager>>printInvalidClassTableEntries (in category 'class table') -----
+ printInvalidClassTableEntries
+ 	"Print the objects in the classTable that have bad hashes."
+ 	<api>
+ 	self validClassTableRootPages ifFalse:
+ 		[coInterpreter print: 'class table invalid; cannot print'; cr.
+ 		 ^self].
+ 
+ 	0 to: numClassTablePages - 1 do:
+ 		[:i| | page |
+ 		 page := self fetchPointer: i ofObject: hiddenRootsObj.
+ 		 0 to: self classTablePageSize - 1 do:
+ 			[:j| | classOrNil hash |
+ 			classOrNil := self fetchPointer: j ofObject: page.
+ 			classOrNil ~= nilObj ifTrue:
+ 				[((self isForwarded: classOrNil)
+ 				  or: [(hash := self rawHashBitsOf: classOrNil) = 0
+ 				  or: [(self noCheckClassAtIndex: hash) ~= classOrNil]]) ifTrue:
+ 					[coInterpreter
+ 						print: 'entry '; printHex: i * self classTablePageSize + j;
+ 						print: ' oop '; printHex: classOrNil;
+ 						print: ' hash '; printHex: hash; print: ' => '; printHex: (self classAtIndex: hash);
+ 						cr]]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>setHeapGrowthToSizeGCRatio: (in category 'accessing') -----
  setHeapGrowthToSizeGCRatio: aDouble
  	<var: #aDouble type: #double>
+ 	heapGrowthToSizeGCRatio := aDouble.
+ 	^0!
- 	heapGrowthToSizeGCRatio := aDouble!

Item was removed:
- ----- Method: SpurMemoryManager>>sweepToFollowForwarders (in category 'compaction') -----
- sweepToFollowForwarders
- 	"sweep, following forwarders in all live objects, and answering the first forwarder or free object."
- 	| lowestFree |
- 	lowestFree := 0.
- 	self allOldSpaceEntitiesDo:
- 		[:o|
- 		((self isFreeObject: o) or: [self isForwarded: o])
- 			ifTrue:
- 				[lowestFree = 0 ifTrue:
- 					[lowestFree := o]]
- 			ifFalse:
- 				[0 to: (self numPointerSlotsOf: o) - 1 do:
- 					[:i| | f |
- 					f := self fetchPointer: i ofObject: o.
- 					(self isOopForwarded: f) ifTrue:
- 						[f := self followForwarded: f.
- 						 self storePointer: i ofObject: o withValue: f]]]].
- 	^lowestFree
- !

Item was added:
+ ----- Method: SpurMemoryManager>>validClassTableHashes (in category 'class table') -----
+ validClassTableHashes
+ 	"Check the hashes of classes in the table.  The tricky thing here is that classes may be duplicated
+ 	 in the table.  So each entry ,ust be in the table at its hash, even if it is elsewhere in the table."
+ 
+ 	self validClassTableRootPages ifFalse:
+ 		[^false].
+ 
+ 	0 to: numClassTablePages - 1 do:
+ 		[:i| | page |
+ 		 page := self fetchPointer: i ofObject: hiddenRootsObj.
+ 		 0 to: self classTablePageSize - 1 do:
+ 			[:j| | classOrNil hash |
+ 			classOrNil := self fetchPointer: j ofObject: page.
+ 			classOrNil ~= nilObj ifTrue:
+ 				[(self isForwarded: classOrNil) ifTrue:
+ 					[^0].
+ 				 hash := self rawHashBitsOf: classOrNil.
+ 				 hash = 0 ifTrue:
+ 					[^false].
+ 				 (self noCheckClassAtIndex: hash) ~= classOrNil ifTrue:
+ 					[^false]]]].
+ 
+ 	^true!

Item was changed:
  ----- Method: StackInterpreter>>objCouldBeClassObj: (in category 'debug support') -----
  objCouldBeClassObj: objOop
  	"Answer if objOop looks like a class object.  WIth Spur be lenient if the object doesn't
  	 yet have a hash (i.e. is not yet in the classTable), and accept forwarding pointers."
  	<inline: false>
  	| fieldOop |
  	^(objectMemory isPointersNonImm: objOop)
  	  and: [(objectMemory numSlotsOf: objOop) > InstanceSpecificationIndex
  	  and: [fieldOop := objectMemory fetchPointer: SuperclassIndex ofObject: objOop.
  			((objectMemory isNonImmediate: fieldOop)
  			and:[ (objectMemory isPointersNonImm: fieldOop)
+ 				or: [(objectMemory isOopForwarded: fieldOop)
+ 					and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]])
- 				or: [(objectMemory rawHashBitsOf: fieldOop) = 0
- 					and: [(objectMemory isOopForwarded: fieldOop)
- 					and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]]])
  	  and: [fieldOop := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop.
  			((objectMemory isNonImmediate: fieldOop)
  			and:[ (objectMemory isPointersNonImm: fieldOop)
+ 				or: [(objectMemory isOopForwarded: fieldOop)
+ 					and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]])
- 				or: [(objectMemory rawHashBitsOf: fieldOop) = 0
- 					and: [(objectMemory isOopForwarded: fieldOop)
- 					and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]]])
  	  and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop))]]]]!

Item was changed:
  ----- Method: StackInterpreter>>printStringOf: (in category 'debug printing') -----
  printStringOf: oop
  	| fmt len cnt max i |
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[^nil].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^nil].
  	fmt := objectMemory formatOf: oop.
  	fmt < objectMemory firstByteFormat ifTrue: [^nil].
  
  	cnt := (max := 128) min: (len := objectMemory lengthOf: oop).
  	i := 0.
  
  	((objectMemory is: oop
  		  instanceOf: (objectMemory splObj: ClassByteArray)
  		  compactClassIndex: classByteArrayCompactIndex)
  	or: [(self isInstanceOfClassLargePositiveInteger: oop)
  	or: [(self isInstanceOfClassLargeNegativeInteger: oop)]])
  		ifTrue:
  			[[i < cnt] whileTrue:
  				[self printHex: (objectMemory fetchByte: i ofObject: oop).
  				 i := i + 1]]
  		ifFalse:
  			[[i < cnt] whileTrue:
+ 				[self cCode:
+ 						[(objectMemory fetchByte: i ofObject: oop) = 13 "Character cr asInteger" ifTrue:
+ 							[self print: '<CR>'.
+ 							 i + 1 < len ifTrue:
+ 								[self print: '...'].
+ 							 ^self]].
+ 				 self printChar: (objectMemory fetchByte: i ofObject: oop).
- 				[self printChar: (objectMemory fetchByte: i ofObject: oop).
  				 i := i + 1]].
  	len > max ifTrue:
  		[self print: '...'].
  	self flush!

More information about the Vm-dev mailing list