[Vm-dev] VM Maker: VMMaker.oscog-eem.1052.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Feb 11 19:08:28 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1052.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1052
Author: eem
Time: 11 February 2015, 11:06:52.97 am
UUID: 95db113a-844c-43a2-8da1-a7943c926aee
Ancestors: VMMaker.oscog-eem.1051
Spur:
Fix idiocy with bit-position constants in image segments.
Move the constants to class variables. Make sure
every method is commented as being part of load or save.
=============== Diff against VMMaker.oscog-eem.1051 ===============
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>initializeObjectHeaderConstants (in category 'class initialization') -----
initializeObjectHeaderConstants
BytesPerWord ifNil: [BytesPerWord := 4]. "May get called on fileIn, so supply default"
+ BaseHeaderSize := 8. "This is still needed for VM generation."
+
+ "These are used in image segments"
+ TopHashBit := 1 << (self basicNew identityHashFieldWidth - 1).
+ TopOopBit := 1 << (self basicNew bytesPerOop * 8 - 1)!
- BaseHeaderSize := 8 "This is still needed for VM generation."!
Item was changed:
----- Method: SpurMemoryManager>>assignClassIndicesAndPinFrom:to:outPointers: (in category 'image segment in/out') -----
assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray
"This is part of loadImageSegmentFrom:outPointers:.
Make a final pass, assigning the real class indices and/or pinning pinned objects."
+ | objOop |
- | objOop topHashBit |
- topHashBit := 1 << (self identityHashFieldWidth - 1).
objOop := self objectStartingAt: segmentStart.
[objOop < segmentLimit] whileTrue:
[| classRef classOop classIndex |
"In the segment, class indices are offset indexes into the segment data,
or into outPointers. See mapOopsFrom:to:outPointers:outHashes:."
classRef := (self classIndexOf: objOop) - self firstClassIndexPun.
+ classOop := (classRef anyMask: TopHashBit)
+ ifTrue: [self fetchPointer: classRef - TopHashBit ofObject: outPointerArray]
- classOop := (classRef anyMask: topHashBit)
- ifTrue: [self fetchPointer: classRef - topHashBit ofObject: outPointerArray]
ifFalse: [classRef * self allocationUnit + segmentStart].
classIndex := self rawHashBitsOf: classOop.
self assert: (classIndex > self lastClassIndexPun
and: [(self classOrNilAtIndex: classIndex) = classOop]).
self setClassIndexOf: objOop to: classIndex.
((self isInNewSpace: objOop)
and: [self isPinned: objOop]) ifTrue:
[| oldClone |
oldClone := self cloneInOldSpaceForPinning: objOop.
oldClone ~= 0 ifTrue:
[self setIsPinnedOf: oldClone to: true.
self forward: objOop to: oldClone]].
objOop := self objectAfter: objOop limit: segmentLimit].
!
Item was changed:
----- Method: SpurMemoryManager>>copyObj:toAddr:startAt:stopAt: (in category 'image segment in/out') -----
copyObj: objOop toAddr: segAddr startAt: segStart stopAt: endSeg
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ Copy objOop into the segment beginning at segAddr, and forward it to the copy.
- "Copy objOop into the segment beginning at segAddr, and forward it to the copy.
If it is a class in the class table, set the copy's hash to 0 for reassignment on load,
and mark it as a class by setting its isRemembered bit.
Answer the next segmentAddr if successful. Answer an appropriate error code if not"
"Copy the object..."
| bodySize copy hash newOop |
<inline: false>
bodySize := self bytesInObject: objOop.
(self oop: segAddr + bodySize isGreaterThanOrEqualTo: endSeg) ifTrue:
[^PrimErrWritePastObject].
self mem: segAddr asVoidPointer cp: (self startOfObject: objOop) asVoidPointer y: bodySize.
copy := self objectStartingAt: segAddr.
"Clear remembered, mark bits of all headers copied into the segment (except classes)"
self
setIsRememberedOf: copy to: false;
setIsMarkedOf: copy to: false.
self ifAProxy: objOop updateCopy: copy.
"If the object is a class, zero its identityHash (which is its classIndex) and set its
isRemembered bit. It will be assigned a new hash and entered into the table on load."
hash := self rawHashBitsOf: objOop.
(hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = objOop]) ifTrue:
[self setHashBitsOf: copy to: 0.
self setIsRememberedOf: copy to: true].
newOop := copy - segStart / self allocationUnit.
newOop > self maxIdentityHash ifTrue:
[^PrimErrLimitExceeded].
self setHashBitsOf: objOop to: copy - segStart / self allocationUnit.
self setIsMarkedOf: objOop to: true.
"Answer the new end of segment"
^segAddr + bodySize!
Item was changed:
----- Method: SpurMemoryManager>>enterClassesIntoClassTableFrom:to: (in category 'image segment in/out') -----
enterClassesIntoClassTableFrom: segmentStart to: segmentLimit
+ "This is part of loadImageSegmentFrom:outPointers:.
+ Scan for classes contained in the segment, entering them into the class table,
- "Scan for classes contained in the segment, entering them into the class table,
and clearing their isRemembered: bit. Classes are at the front, after the root
array and have the remembered bit set. If the attempt succeeds, answer 0,
otherwise remove all entered entries and answer an error code."
| objOop errorCode|
objOop := self objectAfter: (self objectStartingAt: segmentStart).
[objOop < segmentLimit
and: [self isRemembered: objOop]] whileTrue:
[self setIsRememberedOf: objOop to: false.
(errorCode := self enterIntoClassTable: objOop) ~= 0 ifTrue:
[| oop |
oop := objOop.
objOop := self objectAfter: (self objectStartingAt: segmentStart).
[objOop < oop] whileTrue:
[self expungeFromClassTable: objOop.
objOop := self objectAfter: objOop limit: segmentLimit].
^errorCode].
objOop := self objectAfter: objOop limit: segmentLimit].
^0!
Item was changed:
----- Method: SpurMemoryManager>>ifAProxy:updateCopy: (in category 'image segment in/out') -----
ifAProxy: objOop updateCopy: copy
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ If the object being copied to the segment is weird and has exotic state,
- "If the object being copied to the segment is weird and has exotic state,
i.e. a married context or a jitted method, update the copy with the vanilla state."
((self isContext: objOop)
and: [coInterpreter isMarriedOrWidowedContext: objOop]) ifTrue:
[| numMediatedSlots |
"Since the context is here via objectsReachableFromRoots: we know it cannot be divorced.
I'd like to assert coInterpreter checkIsStillMarriedContext: objOop currentFP: framePointer,
here but that requires access to framePointer."
numMediatedSlots := coInterpreter numSlotsOfMarriedContext: objOop.
0 to: numMediatedSlots - 1 do:
[:i| | oop |
oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
self storePointerUnchecked: i ofObject: copy withValue: oop].
"And make sure to nil the slots beyond the top of stack..."
numMediatedSlots to: (self numSlotsOf: objOop) - 1 do:
[:i|
self storePointerUnchecked: i ofObject: copy withValue: nilObj]]!
Item was changed:
----- Method: SpurMemoryManager>>mapOopsAndValidateClassRefsFrom:to:outPointers: (in category 'image segment in/out') -----
mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray
"This is part of loadImageSegmentFrom:outPointers:.
Scan through mapping oops and validating class references. Defer
entering any class objects into the class table and/or pinning objects
until the second pass in assignClassIndicesAndPinFrom:to:outPointers:."
+ | numOutPointers objOop |
- | numOutPointers objOop topHashBit topOopBit |
numOutPointers := self numSlotsOf: outPointerArray.
- topHashBit := 1 << (self identityHashFieldWidth - 1).
- topOopBit := 1 << self bytesPerOop * 8 - 1.
objOop := self objectStartingAt: segmentStart.
[objOop < segmentLimit] whileTrue:
[| classIndex hash oop mappedOop |
(self isMarked: objOop) ifTrue:
[^PrimErrInappropriate].
classIndex := (self classIndexOf: objOop) - self firstClassIndexPun.
"validate the class ref, but don't update it until any internal classes have been added to the class table."
+ (classIndex anyMask: TopHashBit)
- (classIndex anyMask: topHashBit)
ifTrue:
+ [classIndex - TopHashBit >= numOutPointers ifTrue:
- [classIndex - topHashBit >= numOutPointers ifTrue:
[^PrimErrBadIndex].
+ mappedOop := self fetchPointer: classIndex - TopHashBit ofObject: outPointerArray.
- mappedOop := self fetchPointer: classIndex - topHashBit ofObject: outPointerArray.
hash := self rawHashBitsOf: mappedOop.
(hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = mappedOop]) ifFalse:
[^PrimErrInappropriate]]
ifFalse: "The class is contained within the segment."
[(oop := classIndex * self allocationUnit + segmentStart) >= segmentLimit ifTrue:
[^PrimErrBadIndex].
(self rawHashBitsOf: oop) ~= 0 ifTrue:
[^PrimErrInappropriate]].
0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
(self isNonImmediate: oop) ifTrue:
+ [(oop anyMask: TopOopBit)
- [(oop anyMask: topOopBit)
ifTrue:
+ [(oop := oop - TopOopBit / self bytesPerOop) >= numOutPointers ifTrue:
- [(oop := oop - topOopBit / self bytesPerOop) >= numOutPointers ifTrue:
[^PrimErrBadIndex].
mappedOop := self fetchPointer: oop ofObject: outPointerArray]
ifFalse:
[(oop bitAnd: self allocationUnit - 1) ~= 0 ifTrue:
[^PrimErrInappropriate].
(mappedOop := oop + segmentStart) >= segmentLimit ifTrue:
[^PrimErrBadIndex]].
self storePointerUnchecked: i ofObject: objOop withValue: mappedOop]].
objOop := self objectAfter: objOop limit: segmentLimit].
^0!
Item was changed:
----- Method: SpurMemoryManager>>mapOopsFrom:to:outPointers:outHashes: (in category 'image segment in/out') -----
mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes
"This is part of storeImageSegmentInto:outPointers:roots:.
Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
have had their hashes set to point to their copies in segmentWordArray. Answer the
outIndex if the scan succeded. Fail if outPointers is too small and answer -1."
+ | objOop outIndex |
- | objOop outIndex topHashBit topOopBit |
outIndex := 0.
self fillObj: outPointerArray numSlots: (self numSlotsOf: outPointerArray) with: nilObj.
- topHashBit := 1 << (self identityHashFieldWidth - 1).
- topOopBit := 1 << self bytesPerOop * 8 - 1.
objOop := self objectStartingAt: segStart.
[objOop < segAddr] whileTrue:
[| oop segIndex |
oop := self fetchClassOfNonImm: objOop.
(self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop"
+ [outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes.
- [outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit.
outIndex = 0 ifTrue:"no room in outPointers; fail"
[^-1]].
"Set the clone's class index to an offset index into segmentWordArray.
Use an offset so that code cannot confuse a clone with e.g. a forwarder."
segIndex := self rawHashBitsOf: oop.
self setClassIndexOf: objOop to: segIndex + self firstClassIndexPun.
0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
(self isNonImmediate: oop) ifTrue:
[(self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop"
+ [outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes.
- [outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit.
outIndex = 0 ifTrue: "no room in outPointers; fail"
[^-1]].
+ oop := self mappedInSegmentOopOf: oop.
- oop := self mappedOopOf: oop topHashBit: topHashBit topOopBit: topOopBit..
self storePointerUnchecked: i ofObject: objOop withValue: oop]].
objOop := self objectAfter: objOop limit: segAddr].
^outIndex!
Item was added:
+ ----- Method: SpurMemoryManager>>mappedInSegmentOopOf: (in category 'image segment in/out') -----
+ mappedInSegmentOopOf: objOop
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ objOop is an object whose hash has been set to its mapped oop in either the segment or the
+ out pointers. If its hash's top bit is set then it is in out pointers. Answer the mapped oop."
+ <inline: true>
+ | hash |
+ hash := self rawHashBitsOf: objOop.
+ ^(hash anyMask: TopHashBit)
+ ifTrue: [hash - TopHashBit * self bytesPerOop + TopOopBit]
+ ifFalse: [hash * self allocationUnit]!
Item was removed:
- ----- Method: SpurMemoryManager>>mappedOopOf:topHashBit:topOopBit: (in category 'image segment in/out') -----
- mappedOopOf: objOop topHashBit: topHashBit topOopBit: topOopBit
- "objOop is an object whose hash has been set to its mapped oop in either the segment or the
- out pointers. If its hash's top bit is set then it is in out pointers. Answer the mapped oop."
- <inline: true>
- | hash |
- hash := self rawHashBitsOf: objOop.
- ^(hash anyMask: topHashBit)
- ifTrue: [hash - topHashBit * self bytesPerOop + topOopBit]
- ifFalse: [hash * self allocationUnit]!
Item was changed:
----- Method: SpurMemoryManager>>markObjectsIn: (in category 'image segment in/out') -----
markObjectsIn: arrayOfRoots
+ "This is part of storeImageSegmentInto:outPointers:roots:."
self setIsMarkedOf: arrayOfRoots to: true.
0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
[:i| | oop |
oop := self followField: i ofObject: arrayOfRoots.
(self isNonImmediate: oop) ifTrue:
[self setIsMarkedOf: oop to: true]]!
Item was changed:
----- Method: SpurMemoryManager>>moveClassesForwardsIn: (in category 'image segment in/out') -----
moveClassesForwardsIn: arrayOfObjects
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ Both to expand the max size of segment and to reduce the length of the
- "Both to expand the max size of segment and to reduce the length of the
load-time pass that adds classes to the class table, move classes to the
front of arrayOfObjects, leaving the root array as the first element."
| there |
there := 0. "if > 0, this is the index of the first non-class past the first element."
1 to: (self numSlotsOf: arrayOfObjects) - 1 do:
[:here| | objOop hash tempObjOop |
objOop := self fetchPointer: here ofObject: arrayOfObjects.
hash := self rawHashBitsOf: objOop.
(hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = objOop])
ifTrue:
[there > 0 ifTrue: "if there is zero we're in a run of classes at the start so don't move"
[tempObjOop := self fetchPointer: there ofObject: arrayOfObjects.
self storePointerUnchecked: there ofObject: arrayOfObjects withValue: objOop.
self storePointerUnchecked: here ofObject: arrayOfObjects withValue: tempObjOop.
there := there + 1]]
ifFalse:
[there = 0 ifTrue:
[there := here]]]!
Item was added:
+ ----- Method: SpurMemoryManager>>newOutPointer:at:in:hashes: (in category 'image segment in/out') -----
+ newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ oop is a new outPointer; allocate its oop, and answer the new outIndex.
+ If outPointerArray is full, answer 0."
+ <inline: true>
+ outIndex >= (self numSlotsOf: outPointerArray) ifTrue:
+ ["no room in outPointers; fail"
+ ^0].
+ self storePointer: outIndex ofObject: outPointerArray withValue: oop.
+ self storeLong32: outIndex ofObject: savedOutHashes withValue: (self rawHashBitsOf: oop).
+ self setHashBitsOf: oop to: outIndex + TopHashBit.
+ self setIsMarkedOf: oop to: true.
+ ^outIndex + 1!
Item was removed:
- ----- Method: SpurMemoryManager>>newOutPointer:at:in:hashes:topHashBit: (in category 'image segment in/out') -----
- newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit
- "oop is a new outPointer; allocate its oop, and answer the new outIndex.
- If outPointerArray is full, answer 0."
- <inline: true>
- outIndex >= (self numSlotsOf: outPointerArray) ifTrue:
- ["no room in outPointers; fail"
- ^0].
- self storePointer: outIndex ofObject: outPointerArray withValue: oop.
- self storeLong32: outIndex ofObject: savedOutHashes withValue: (self rawHashBitsOf: oop).
- self setHashBitsOf: oop to: outIndex + topHashBit.
- self setIsMarkedOf: oop to: true.
- ^outIndex + 1!
Item was changed:
----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
objectsReachableFromRoots: arrayOfRoots
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ Answer an Array of all the objects only reachable from the argument, an Array of root objects,
- "Answer an Array of all the objects only reachable from the argument, an Array of root objects,
starting with arrayOfRoots. If there is no space, answer a SmallInteger whose value is the
number of slots required. This is used to collect the objects to include in an image segment
on Spur, separate from creating the segment, hence simplifying the implementation.
Thanks to Igor Stasenko for this idea."
| freeChunk ptr start limit count oop objOop |
self assert: (self isArray: arrayOfRoots).
"Mark all objects except those only reachable from the arrayOfRoots by marking
each object in arrayOfRoots and then marking all reachable objects (from the
system roots). This leaves unmarked only objects reachable from the arrayOfRoots.
N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
self assert: self allObjectsUnmarked.
self markObjectsIn: arrayOfRoots.
self markObjects: false.
"After the mark phase all unreachable weak slots will have been nilled
and all active ephemerons fired."
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self noUnscannedEphemerons.
"Use the largest free chunk to answer the result."
freeChunk := self allocateLargestFreeChunk.
ptr := start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
count := 0.
"First put the arrayOfRoots; order is important."
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: arrayOfRoots.
ptr := ptr + self bytesPerOop].
0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: arrayOfRoots.
(self isNonImmediate: oop) ifTrue:
[self push: oop onObjStack: markStack]].
"Now collect the unmarked objects reachable from the roots."
[self isEmptyObjStack: markStack] whileFalse:
[objOop := self popObjStack: markStack.
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: objOop.
ptr := ptr + self bytesPerOop].
oop := self fetchClassOfNonImm: objOop.
(self isMarked: oop) ifFalse:
[self setIsMarkedOf: objOop to: true.
self push: oop onObjStack: markStack].
((self isContextNonImm: objOop)
and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the loop"
ifTrue:
[0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
[:i|
oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
((self isImmediate: oop)
or: [self isMarked: oop]) ifFalse:
[self setIsMarkedOf: objOop to: true.
self push: oop onObjStack: markStack]]]
ifFalse:
[0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
((self isImmediate: oop)
or: [self isMarked: oop]) ifFalse:
[self setIsMarkedOf: objOop to: true.
self push: oop onObjStack: markStack]]]].
self unmarkAllObjects.
totalFreeOldSpace := totalFreeOldSpace - (self bytesInObject: freeChunk).
"Now try and allocate the result"
(count > (ptr - start / self bytesPerOop) "not enough room"
or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
[self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
self checkFreeSpace.
^self integerObjectOf: count].
"There's room; set the format, & classIndex and shorten."
self setFormatOf: freeChunk to: self arrayFormat.
self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
self shorten: freeChunk toIndexableSize: count.
self possibleRootStoreInto: freeChunk.
self checkFreeSpace.
self runLeakCheckerFor: GCModeImageSegment.
^freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>restoreObjectsIn:savedHashes: (in category 'image segment in/out') -----
restoreObjectsIn: objArray savedHashes: savedHashes
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ Enumerate the objects in objArray, unmarking them and restoring their hashes
- "Enumerate the objects in objArray, unmarking them and restoring their hashes
from the corresponding 32-bit slots in savedHashes. The first unused entry in
objArray will have a non-hash value entry in savedHashes. Free savedHashes."
<inline: false>
0 to: (self numSlotsOf: objArray) - 1 do:
[:i| | hash oop |
(hash := self fetchLong32: i ofObject: savedHashes) > self maxIdentityHash ifTrue:
[(self isInOldSpace: savedHashes) ifTrue:
[self freeObject: savedHashes].
^self].
oop := self fetchPointer: i ofObject: objArray.
self setHashBitsOf: oop to: hash.
self setIsMarkedOf: oop to: false].
(self isInOldSpace: savedHashes) ifTrue:
[self freeObject: savedHashes]!
Item was changed:
----- Method: SpurMemoryManager>>return:restoringObjectsIn:savedHashes:and:savedHashes: (in category 'image segment in/out') -----
return: errCode restoringObjectsIn: firstArray savedHashes: firstSavedHashes and: secondArray savedHashes: secondSavedHashes
+ "This is part of storeImageSegmentInto:outPointers:roots:."
self restoreObjectsIn: firstArray savedHashes: firstSavedHashes.
self restoreObjectsIn: secondArray savedHashes: secondSavedHashes.
self runLeakCheckerFor: GCModeImageSegment.
self assert: self allObjectsUnmarked.
^errCode!
More information about the Vm-dev
mailing list