[Vm-dev] VM Maker: VMMaker.oscog-eem.2294.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Dec 12 19:38:55 UTC 2017
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2294.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2294
Author: eem
Time: 12 December 2017, 11:38:23.481307 am
UUID: 99a04f27-cda6-4cc2-a5ff-a96e116a63d4
Ancestors: VMMaker.oscog-eem.2293
Spur Image Segments:
Fix objectsReachableFromRoots: which was computing a transitive closure that could include duplicates.
Fix ifAProxy:updateCopy: to fill the fields beyond the stack pointer of single contexts.
Refactor to nuke the unused argument in copyObj:toAddr:[startAt:]stopAt:savedFirstFields:index:
Fix a comment typo and add a counter throuhh the arrayOfObjects/objects copied to segment, for debugging.
Add the CoInterpreter simulation only versions of mapOopsFrom:to:outPointers:outHashes:.
=============== Diff against VMMaker.oscog-eem.2293 ===============
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>mapOopsFrom:to:outPointers:outHashes: (in category 'image segment in/out') -----
+ mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes
+ self leakCheckImageSegments ifTrue:
+ [self halt].
+ ^super mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes!
Item was added:
+ ----- Method: Spur64BitMMLECoSimulator>>mapOopsFrom:to:outPointers:outHashes: (in category 'image segment in/out') -----
+ mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes
+ self leakCheckImageSegments ifTrue:
+ [self halt].
+ ^super mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes!
Item was removed:
- ----- Method: SpurMemoryManager>>copyObj:toAddr:startAt:stopAt:savedFirstFields:index: (in category 'image segment in/out') -----
- copyObj: objOop toAddr: segAddr startAt: segStart stopAt: endSeg savedFirstFields: savedFirstFields index: i
- "This is part of storeImageSegmentInto:outPointers:roots:.
- Copy objOop into the segment beginning at segAddr, and forward it to the copy,
- saving its first field in savedFirstField, and setting its marked bit to indicate it has
- been copied. 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 |
- <inline: false>
- self deny: (self isCopiedIntoSegment: objOop).
- bodySize := self bytesInObject: objOop.
- (self oop: segAddr + bodySize isGreaterThanOrEqualTo: endSeg) ifTrue:
- [^PrimErrWritePastObject halt].
- 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.
-
- "Make any objects with hidden dynamic state (contexts, methods) look like normal objects."
- 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].
-
- "Now forward the object to its copy in the segment."
- self storePointerUnchecked: i ofObject: savedFirstFields withValue: (self fetchPointer: 0 ofObject: objOop);
- storePointerUnchecked: 0 ofObject: objOop withValue: copy;
- markAsCopiedIntoSegment: objOop.
-
- "Answer the new end of segment"
- ^segAddr + bodySize!
Item was added:
+ ----- Method: SpurMemoryManager>>copyObj:toAddr:stopAt:savedFirstFields:index: (in category 'image segment in/out') -----
+ copyObj: objOop toAddr: segAddr stopAt: endSeg savedFirstFields: savedFirstFields index: i
+ "This is part of storeImageSegmentInto:outPointers:roots:.
+ Copy objOop into the segment beginning at segAddr, and forward it to the copy,
+ saving its first field in savedFirstField, and setting its marked bit to indicate it has
+ been copied. 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 |
+ <inline: false>
+ self deny: (self isCopiedIntoSegment: objOop).
+ bodySize := self bytesInObject: objOop.
+ (self oop: segAddr + bodySize isGreaterThanOrEqualTo: endSeg) ifTrue:
+ [^PrimErrWritePastObject halt].
+ 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.
+
+ "Make any objects with hidden dynamic state (contexts, methods) look like normal objects."
+ 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].
+
+ "Now forward the object to its copy in the segment."
+ self storePointerUnchecked: i ofObject: savedFirstFields withValue: (self fetchPointer: 0 ofObject: objOop);
+ storePointerUnchecked: 0 ofObject: objOop withValue: copy;
+ markAsCopiedIntoSegment: objOop.
+
+ "Answer the new end of segment"
+ ^segAddr + bodySize!
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,
i.e. a married context or a jitted method, update the copy with the vanilla state."
+ (self isContext: objOop) ifTrue:
- ((self isContext: objOop)
- and: [coInterpreter isMarriedOrWidowedContext: objOop]) ifTrue:
[| numMediatedSlots |
+ (coInterpreter isMarriedOrWidowedContext: objOop)
+ ifTrue:
+ ["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]]
+ ifFalse:
+ [numMediatedSlots := self numPointerSlotsOf: objOop].
- "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]]!
- [:i|
- self storePointerUnchecked: i ofObject: copy withValue: nilObj]]!
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 first fields set to point to their copies in segmentWordArray. Answer
the outIndex if the scan succeded. Fail if outPointers is too small and answer -1.
As established by copyObj:toAddr:startAt:stopAt:savedFirstFields:index:,
the marked bit is set for all objects in the segment
the remembered bit is set for all classes in the segment.
Class indices should be set as follows (see assignClassIndicesAndPinFrom:to:outPointers:filling:)
- class indices for classes in the segment "
+ | objOop objIndex outIndex |
+ outIndex := objIndex := 0. "objIndex is for debugging; it mirrors indices in the sender's arrayOfObjects."
- | objOop outIndex |
- outIndex := 0.
self fillObj: outPointerArray numSlots: (self numSlotsOf: outPointerArray) with: nilObj.
objOop := self objectStartingAt: segStart.
[self oop: objOop isLessThan: segAddr] whileTrue:
[| heapOop oop hash segIndex |
heapOop := self fetchClassOfNonImm: objOop.
+ "Set the classIndex of the instance. This is a segment offset (segAddr - segStart / allocationUnit) for instances of
- "Set the classIndex of the instance. This is a segment offset (segAddr - segStart / allocatiopnUnit) for instances of
classes within the segment, and an outPointer index (index in outPointers + TopHashBit) for classes outside the segment."
(self isCopiedIntoSegment: heapOop)
ifTrue: "oop is a class in the segment; storeImageSegmentInto:outPointers:roots: established offset is within range."
[oop := self fetchPointer: 0 ofObject: heapOop.
self assert: (self oop: oop isGreaterThanOrEqualTo: segStart andLessThan: segAddr).
segIndex := oop - segStart / self allocationUnit + self firstClassIndexPun.
(segIndex anyMask: TopHashBit) ifTrue: "Too many classes in the segment"
[^-1 halt]]
ifFalse: "oop is an outPointer; locate or allocate its oop"
[hash := self rawHashBitsOf: heapOop.
(self is: hash outPointerClassHashFor: heapOop in: outPointerArray limit: outIndex)
ifTrue: [segIndex := hash]
ifFalse: "oop is a new outPointer; allocate its oop"
[outIndex := self newOutPointer: heapOop at: outIndex in: outPointerArray hashes: savedOutHashes.
outIndex = 0 ifTrue: "no room in outPointers; fail"
[^-1 halt].
segIndex := self rawHashBitsOf: heapOop].
self assert: (segIndex anyMask: TopHashBit)].
self setClassIndexOf: objOop to: segIndex.
0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
heapOop := self fetchPointer: i ofObject: objOop.
(self isNonImmediate: heapOop) ifTrue:
[(self isCopiedIntoSegment: heapOop)
ifTrue: "oop is an object in the segment."
[oop := self fetchPointer: 0 ofObject: heapOop.
self assert: (self oop: oop isGreaterThanOrEqualTo: segStart andLessThan: segAddr).
oop := oop - segStart]
ifFalse: "oop is an outPointer; locate or allocate its oop"
[hash := self rawHashBitsOf: heapOop.
(self is: hash outPointerClassHashFor: heapOop in: outPointerArray limit: outIndex)
ifTrue: [oop := hash - TopHashBit * self bytesPerOop + TopOopBit]
ifFalse: "oop is a new outPointer; allocate its oop"
[outIndex := self newOutPointer: heapOop at: outIndex in: outPointerArray hashes: savedOutHashes.
outIndex = 0 ifTrue: "no room in outPointers; fail"
[^-1 halt].
self assert: ((self rawHashBitsOf: heapOop) anyMask: TopHashBit).
oop := (self rawHashBitsOf: heapOop) - TopHashBit * self bytesPerOop + TopOopBit]].
self storePointerUnchecked: i ofObject: objOop withValue: oop]].
+ objOop := self objectAfter: objOop limit: segAddr.
+ objIndex := objIndex + 1].
- objOop := self objectAfter: objOop limit: segAddr].
^outIndex!
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,
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 |
<var: #freeChunk type: #usqInt> "& hence start & ptr are too; limit is also because of addressAfter:"
<inline: #never>
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.
+ "Now unmark the roots before collecting the transitive closure of unmarked objects accessible from the roots."
+ self unmarkObjectsIn: arrayOfRoots.
+
"Use the largest free chunk to answer the result."
freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
totalFreeOldSpace := totalFreeOldSpace - (self bytesInObject: freeChunk). "but must update so that growth in the markStack does not cause assert fails."
ptr := start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
count := 0.
"First put the arrayOfRoots; order is important."
+ self noCheckPush: arrayOfRoots onObjStack: markStack.
- count := count + 1.
- ptr < limit ifTrue:
- [self longAt: ptr put: arrayOfRoots.
- ptr := ptr + self bytesPerOop].
"Now collect the roots and the transitive closure of unmarked objects from them."
+ [self isEmptyObjStack: markStack] whileFalse:
+ [objOop := self popObjStack: markStack.
+ self assert: (self isMarked: objOop).
+ 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: oop to: true.
+ self noCheckPush: oop onObjStack: markStack].
+ ((self isContextNonImm: objOop)
+ and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the copy 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: oop to: true.
+ self noCheckPush: 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: oop to: true.
+ self noCheckPush: oop onObjStack: markStack]]]].
- 0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
- [:rx|
- oop := self fetchPointer: rx ofObject: arrayOfRoots.
- (self isNonImmediate: oop) ifTrue:
- [self deny: (self isForwarded: oop).
- self noCheckPush: oop onObjStack: markStack.
- "Collect the unmarked objects reachable from this root."
- [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: oop to: true.
- self noCheckPush: 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: oop to: true.
- self noCheckPush: 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: oop to: true.
- self noCheckPush: oop onObjStack: markStack]]]]]].
-
self unmarkAllObjects.
"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 freeObject: freeChunk.
self checkFreeSpace: GCModeImageSegment.
^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 isForwarded: freeChunk) ifTrue:
[freeChunk := self followForwarded: freeChunk].
self possibleRootStoreInto: freeChunk.
self checkFreeSpace: GCModeImageSegment.
self runLeakCheckerFor: GCModeImageSegment.
^freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
storeImageSegmentInto: segmentWordArrayArg outPointers: outPointerArrayArg roots: arrayOfRootsArg
"This primitive is called from Squeak as...
<imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray.
This primitive will store a binary image segment (in the same format as objects in the heap) of the
set of objects in arrayOfObjects. All pointers from within the set to objects outside the set will be
copied into the array of outPointers. In their place in the image segment will be an oop equal to the
offset in the outPointer array (the first would be 8), but with the high bit set.
Since Spur has a class table the load primitive must insert classes that have instances into the
class table. This primitive marks such classes using the isRemembered bit, which isn't meaningful
as a remembered bit in the segment.
The primitive expects the segmentWordArray and outPointerArray to be more than adequately long.
In this case it returns normally, and truncates the two arrays to exactly the right size.
The primitive can fail for the following reasons with the specified failure codes:
PrimErrGenericError: the segmentWordArray is too small for the version stamp
PrimErrWritePastObject: the segmentWordArray is too small to contain the reachable objects
PrimErrBadIndex: the outPointerArray is too small
PrimErrNoMemory: additional allocations failed
PrimErrLimitExceeded: there is no room in the hash field to store out pointer indices or class references."
<inline: false>
| segmentWordArray outPointerArray arrayOfRoots
arrayOfObjects savedFirstFields savedOutHashes segStart segAddr endSeg outIndex numClassesInSegment |
<var: 'segAddr' type: #usqInt>
((self isObjImmutable: segmentWordArrayArg)
or: [self isObjImmutable: outPointerArrayArg]) ifTrue:
[^PrimErrNoModification].
"Since segmentWordArrayArg & outPointerArrayArg may get shortened, they can't be pinned."
((self isPinned: segmentWordArrayArg)
or: [self isPinned: outPointerArrayArg]) ifTrue:
[^PrimErrObjectIsPinned].
(self numSlotsOf: outPointerArrayArg) > self maxIdentityHash ifTrue:
[^PrimErrLimitExceeded].
self runLeakCheckerFor: GCModeImageSegment.
"First scavenge to collect any new space garbage that refers to the graph."
self scavengingGC.
segmentWordArray := self updatePostScavenge: segmentWordArrayArg.
outPointerArray := self updatePostScavenge: outPointerArrayArg.
arrayOfRoots := self updatePostScavenge: arrayOfRootsArg.
self deny: (self forwardersIn: outPointerArray).
self deny: (self forwardersIn: arrayOfRoots).
"Now compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array.
Included in arrayOfObjects are the arrayOfRoots and all its contents. All objects have been unmarked."
arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots.
arrayOfObjects ifNil:
[^PrimErrNoMemory].
self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written"
self deny: (self forwardersIn: arrayOfObjects).
"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."
numClassesInSegment := self moveClassesForwardsIn: arrayOfObjects.
"The scheme is to copy the objects into segmentWordArray, and then map the oops in segmentWordArray.
Therefore the primitive needs to both map efficiently originals to copies in segmentWordArray and
be able to undo any side-effects if the primitive fails because either segmentWordArray or outPointerArray
is too small. The mapping is done by having the objects to be stored in arrayOfObjects refer to their mapped
locations through their first field, just like a forwarding pointer, but without becoming a forwarder, saving their
first field in savedFirstFields, and the objects in outPointerArray pointing to their locations in the outPointerArray
through their identityHashes, saved in savedOutHashes.
Since arrayOfObjects and its savedFirstFields, and outPointerArray and its saved hashes, can be enumerated
side-by-side, the hashes can be restored to the originals. So the first field of the heap object corresponding to
an object in arrayOfObjects is set to its location in segmentWordArray, and the hash of an object in outPointerArray
is set to its index in outPointerArray plus the top hash bit. Classes in arrayOfObjects have their marked bit set.
Oops in objects in segmentWordArray are therefore mapped by accessing the original oop, and following its first
field. Class indices in segmentWordArray are mapped by fetching the original class, and testing its marked bit.
If marked, the first field is followed to access the class copy in the segment. Out pointers (objects and classes,
which are unmarked), the object's identityHash is set (eek!!!!) to its index in the outPointerArray. So savedOutHashes
parallels the outPointerArray. The saved hash array is initialized with an out-of-range hash value so that the first
unused entry can be identified."
savedFirstFields := self allocateSlots: (self numSlotsOf: arrayOfObjects)
format: self wordIndexableFormat
classIndex: self wordSizeClassIndexPun.
savedOutHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4)
format: self firstLongFormat
classIndex: self thirtyTwoBitLongsClassIndexPun.
(savedFirstFields isNil or: [savedOutHashes isNil]) ifTrue:
[self freeObject: arrayOfObjects.
^PrimErrNoMemory].
self fillObj: savedFirstFields numSlots: (self numSlotsOf: savedFirstFields) with: 0.
self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: self savedOutHashFillValue.
segAddr := segmentWordArray + self baseHeaderSize.
endSeg := self addressAfter: segmentWordArray.
"Write a version number for byte order and version check."
segAddr >= endSeg ifTrue: [^PrimErrGenericFailure].
self long32At: segAddr put: self imageSegmentVersion.
self long32At: segAddr + 4 put: self imageSegmentVersion.
segStart := segAddr := segAddr + self allocationUnit.
self assert: arrayOfRoots = (self fetchPointer: 0 ofObject: arrayOfObjects).
"Copy all reachable objects to the segment, setting the marked bit for all objects (clones) in the segment,
and the remembered bit for all classes (clones) in the segment."
0 to: (self numSlotsOf: arrayOfObjects) - 1 do:
[:i| | newSegAddrOrError objOop |
"Check that classes in the segment are addressible. Since the top bit of the hash field is used to tag
classes external to the segment, the segment offset must not inadvertently set this bit. This limit still
allows for a million or more classes."
(i = numClassesInSegment
and: [segAddr - segStart / self allocationUnit + self lastClassIndexPun >= TopHashBit]) ifTrue:
[^self return: PrimErrLimitExceeded
restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields].
objOop := self fetchPointer: i ofObject: arrayOfObjects.
self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]).
newSegAddrOrError := self copyObj: objOop
toAddr: segAddr
- startAt: segStart
stopAt: endSeg
savedFirstFields: savedFirstFields
index: i.
(self oop: newSegAddrOrError isLessThan: segStart) ifTrue:
[^self return: newSegAddrOrError
restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields].
segAddr := newSegAddrOrError].
"Check that it can be safely shortened."
(endSeg ~= segAddr
and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue:
[^self return: PrimErrWritePastObject
restoringObjectsIn: arrayOfObjects upTo: -1 savedFirstFields: savedFirstFields].
"Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
have their first field pointing to the corresponding copy in segmentWordArray."
(outIndex := self mapOopsFrom: segStart
to: segAddr
outPointers: outPointerArray
outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail"
[^self return: PrimErrBadIndex
restoringObjectsIn: arrayOfObjects savedFirstFields: savedFirstFields
and: outPointerArray savedHashes: savedOutHashes].
"We're done. Shorten the results, restore hashes and return."
self shorten: segmentWordArray toIndexableSize: segAddr - (segmentWordArray + self baseHeaderSize) / 4.
self shorten: outPointerArray toIndexableSize: outIndex.
^self return: PrimNoErr
restoringObjectsIn: arrayOfObjects savedFirstFields: savedFirstFields
and: outPointerArray savedHashes: savedOutHashes!
Item was added:
+ ----- Method: SpurMemoryManager>>unmarkObjectsIn: (in category 'image segment in/out') -----
+ unmarkObjectsIn: arrayOfRoots
+ "This is part of storeImageSegmentInto:outPointers:roots:."
+ 0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
+ [:i| | oop |
+ oop := self followField: i ofObject: arrayOfRoots.
+ (self isNonImmediate: oop) ifTrue:
+ [self setIsMarkedOf: oop to: false]]!
Item was changed:
----- Method: StackInterpreterPrimitives>>cloneContext: (in category 'primitive support') -----
cloneContext: aContext
| sz cloned spouseFP sp |
<var: #spouseFP type: #'char *'>
sz := objectMemory numSlotsOf: aContext.
cloned := objectMemory eeInstantiateMethodContextSlots: sz.
cloned ~= 0 ifTrue:
[0 to: StackPointerIndex do:
[:i|
objectMemory
storePointerUnchecked: i
ofObject: cloned
withValue: (self externalInstVar: i ofContext: aContext)].
MethodIndex to: ReceiverIndex do:
[:i|
objectMemory
storePointerUnchecked: i
ofObject: cloned
+ withValue: (objectMemory fetchPointer: i ofObject: aContext)].
- withValue: (self fetchPointer: i ofObject: aContext)].
(self isStillMarriedContext: aContext)
ifTrue:
[spouseFP := self frameOfMarriedContext: aContext.
sp := (self stackPointerIndexForFrame: spouseFP) - 1.
0 to: sp do:
[:i|
objectMemory
storePointerUnchecked: i + CtxtTempFrameStart
ofObject: cloned
withValue: (self temporary: i in: spouseFP)]]
ifFalse:
[sp := (self fetchStackPointerOf: aContext) - 1.
0 to: sp do:
[:i|
objectMemory
storePointerUnchecked: i + CtxtTempFrameStart
ofObject: cloned
+ withValue: (objectMemory fetchPointer: i + CtxtTempFrameStart ofObject: aContext)]]].
- withValue: (self fetchPointer: i + CtxtTempFrameStart ofObject: aContext)]]].
^cloned!
More information about the Vm-dev
mailing list