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]]]!
vm-dev@lists.squeakfoundation.org