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

commits at source.squeak.org commits at source.squeak.org
Fri Jan 9 19:21:35 UTC 2015


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

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

Name: VMMaker.oscog-eem.1011
Author: eem
Time: 8 January 2015, 1:01:11.779 pm
UUID: dd0dbcf0-1b1e-4d40-854c-130590e38268
Ancestors: VMMaker.oscog-eem.1010

Spur:
Fix bad bug introduced in become changes in  VMMaker.oscog-eem.841 through 844.  The class
table contains puns, e.g. using Array and WeakArray.
These class index puns must not mislead the
allInstances primitive into concluding that the
classes in question are at multiple indices and
hence avoid wrongly purging them.

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

Item was changed:
  ----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
  enterIntoClassTable: aBehavior
  	"Enter aBehavior into the class table and answer 0.  Otherwise answer a primitive failure code."
  	<inline: false>
  	| initialMajorIndex majorIndex minorIndex page |
  	majorIndex := classTableIndex >> self classTableMajorIndexShift.
  	initialMajorIndex := majorIndex.
  	"classTableIndex should never index the first page; it's reserved for known classes"
  	self assert: initialMajorIndex > 0.
  	minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
  
  	[page := self fetchPointer: majorIndex ofObject: hiddenRootsObj.
  	 page = nilObj ifTrue:
  		[page := self allocateSlotsInOldSpace: self classTablePageSize
  					format: self arrayFormat
  					classIndex: self arrayClassIndexPun.
  		 page ifNil:
  			[^PrimErrNoMemory].
  		 self fillObj: page numSlots: self classTablePageSize with: nilObj.
  		 self storePointer: majorIndex
  			ofObject: hiddenRootsObj
  			withValue: page.
  		 numClassTablePages := numClassTablePages + 1.
  		 minorIndex := 0].
  	 minorIndex to: self classTablePageSize - 1 do:
  		[:i|
  		(self fetchPointer: i ofObject: page) = nilObj ifTrue:
+ 			[classTableIndex := majorIndex << self classTableMajorIndexShift + i..
+ 			 "classTableIndex must never index the first page, which is reserved for classes known to the VM."
+ 			 self assert: classTableIndex >= (1 << self classTableMajorIndexShift).
- 			[classTableIndex := majorIndex << self classTableMajorIndexShift + i.
  			 self storePointer: i
  				ofObject: page
  				withValue: aBehavior.
  			 self setHashBitsOf: aBehavior to: classTableIndex.
  			 self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
  			 ^0]].
  	 majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
  	 majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
  		[^PrimErrLimitExceeded]] repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>expungeDuplicateAndUnmarkedClasses: (in category 'class table') -----
  expungeDuplicateAndUnmarkedClasses: expungeUnmarked
  	"Bits have been set in the classTableBitmap corresponding to
  	 used classes.  Any class in the class table that does not have a
  	 bit set has no instances with that class index.  However, becomeForward:
  	 can create duplicate entries, and these duplicate entries wont match their
  	 identityHash. So expunge duplicates by eliminating unmarked entries that
  	 don't occur at their identityHash."
  	1 to: numClassTablePages - 1 do: "Avoid expunging the puns by not scanning the 0th page."
  		[:i| | classTablePage |
  		classTablePage := self fetchPointer: i ofObject: hiddenRootsObj.
  		 0 to: self classTablePageSize - 1 do:
  			[:j| | classOrNil classIndex |
  			 classOrNil := self fetchPointer: j ofObject: classTablePage.
  			 classIndex := i << self classTableMajorIndexShift + j.
  			 self assert: (classOrNil = nilObj or: [coInterpreter addressCouldBeClassObj: classOrNil]).
  			 "only remove a class if it is at a duplicate entry or it is unmarked and we're expunging unmarked classes."
  			 classOrNil = nilObj
  				ifTrue:
  					[classIndex < classTableIndex ifTrue:
  						[classTableIndex := classIndex]]
  				ifFalse:
  					[((expungeUnmarked and: [(self isMarked: classOrNil) not])
  					   or: [(self rawHashBitsOf: classOrNil) ~= classIndex]) ifTrue:
  						[self storePointerUnchecked: j
  							ofObject: classTablePage
  							withValue: nilObj.
  						 "but if it is marked, it should still be in the table at its correct index."
  						 self assert: ((expungeUnmarked and: [(self isMarked: classOrNil) not])
  									or: [(self classAtIndex: (self rawHashBitsOf: classOrNil)) = classOrNil]).
  						 "If the removed class is before the classTableIndex, set the
  						  classTableIndex to point to the empty slot so as to reuse it asap."
  						 classIndex < classTableIndex ifTrue:
+ 							[classTableIndex := classIndex]]]]].
+ 	"classTableIndex must never index the first page, which is reserved for classes known to the VM."
+ 	self assert: classTableIndex >= (1 << self classTableMajorIndexShift)!
- 							[classTableIndex := classIndex]]]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>expungeFromClassTable: (in category 'class table') -----
  expungeFromClassTable: aBehavior
  	"Remove aBehavior from the class table."
  	<inline: false>
  	| classIndex majorIndex minorIndex classTablePage |
  	self assert: (self isInClassTable: aBehavior).
  	classIndex := self rawHashBitsOf: aBehavior.
  	majorIndex := classIndex >> self classTableMajorIndexShift.
  	minorIndex := classIndex bitAnd: self classTableMinorIndexMask.
  	classTablePage := self fetchPointer: majorIndex ofObject: hiddenRootsObj.
  	self assert: classTablePage ~= classTableFirstPage.
  	self assert: (self numSlotsOf: classTablePage) = self classTablePageSize.
  	self assert: (self fetchPointer: minorIndex ofObject: classTablePage) = aBehavior.
  	self storePointerUnchecked: minorIndex ofObject: classTablePage withValue: nilObj.
  	"If the removed class is before the classTableIndex, set the
  	 classTableIndex to point to the empty slot so as to reuse it asap."
  	classIndex < classTableIndex ifTrue:
+ 		[classTableIndex := classIndex].
+ 	"classTableIndex must never index the first page, which is reserved for classes known to the VM."
+ 	self assert: classTableIndex >= (1 << self classTableMajorIndexShift)!
- 		[classTableIndex := classIndex]!

Item was changed:
  ----- Method: SpurMemoryManager>>isClassAtUniqueIndex: (in category 'class table') -----
  isClassAtUniqueIndex: aClass
+ 	"Answer if aClass exists at only one index in the class table.  Be careful not to
+ 	 be misled by classes that have puns, such as Array."
- 	"Answer if aClass exists at only one index in the class table."
  	| expectedIndex |
  	expectedIndex := self rawHashBitsOf: aClass.
  	self classTableEntriesDo:
  		[:entry :index|
+ 		 (entry = aClass
+ 		  and: [index ~= expectedIndex
+ 		  and: [index > self lastClassIndexPun]]) ifTrue:
- 		 (entry = aClass and: [index ~= expectedIndex]) ifTrue:
  			[^false]].
  	^true!

Item was changed:
  ----- Method: SpurMemoryManager>>postBecomeScanClassTable: (in category 'become implementation') -----
  postBecomeScanClassTable: effectsFlags
  	"Scan the class table post-become (iff an active class object was becommed) to ensure no
  	 forwarding pointers, and no unhashed classes exist in the class table.
  
  	 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].
  				 (self rawHashBitsOf: classOrNil) = 0 ifTrue:
  					[self storePointerUnchecked: j ofObject: page withValue: nilObj.
  					 "If the removed class is before the classTableIndex, set the
  					  classTableIndex to point to the empty slot so as to reuse it asap."
  					 (i << self classTableMajorIndexShift + j) < classTableIndex ifTrue:
+ 						[classTableIndex := i << self classTableMajorIndexShift + j]]]]].
+ 	"classTableIndex must never index the first page, which is reserved for classes known to the VM."
+ 	self assert: classTableIndex >= (1 << self classTableMajorIndexShift)!
- 						[classTableIndex := i << self classTableMajorIndexShift + j]]]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>purgeDuplicateClassTableEntriesFor: (in category 'class table') -----
  purgeDuplicateClassTableEntriesFor: aClass
  	"Given that either marking or allnstances has ensured that
  	 all instances of aClass  have the class's hash as their class
  	 index, ensure aClass is in the table only at its hash."
  	| expectedIndex |
  	expectedIndex := self rawHashBitsOf: aClass.
  	self classTableEntriesDo:
  		[:entry :index|
  		 (entry = aClass and: [index ~= expectedIndex]) ifTrue:
  			[self classAtIndex: index put: nilObj.
  			 index < classTableIndex ifTrue:
+ 				[classTableIndex := index]]].
+ 	"classTableIndex must never index the first page, which is reserved for classes known to the VM."
+ 	self assert: classTableIndex >= (1 << self classTableMajorIndexShift)!
- 				[classTableIndex := index]]]!



More information about the Vm-dev mailing list