07 Jan '23
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3292.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3292
Author: WoC
Time: 7 January 2023, 1:00:24.455682 pm
UUID: e1ddd04f-168d-478a-9e00-685345e32f11
Ancestors: VMMaker.oscog.seperateMarking-WoC.3291
- free partially compacted segments until the point they were compacted (use swizzle to store this info)
- update currentSegmentsBridge at the start of every sweep and compact pass, because the bridge size could have changed when a segment directly behind the current segment was removed
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3291 ===============
Item was changed:
----- Method: Spur64BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'object enumeration') -----
initSegmentBridgeWithBytes: numBytes at: address
<var: #numBytes type: #usqLong>
| numSlots |
"Must have room for a double header or a short object with the forwarding slot (16 bytes either way)."
self assert: (numBytes \\ self allocationUnit = 0
and: [numBytes >= (self baseHeaderSize + self baseHeaderSize)]).
numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
+
+ numSlots < 2
- numSlots = 0
ifTrue: "short bridge for adjacent segments"
[self longAt: address
+ put: (numSlots + 1) << self numSlotsFullShift "(0+1 = 1 => 16 byte bridged; 1+1 = 2 => 24 byte bridged )"
+ + (1 << self pinnedBitShift)
- put: (1 << self pinnedBitShift)
+ (1 << self markedBitFullShift)
+ (self wordIndexableFormat << self formatShift)
+ self segmentBridgePun]
ifFalse: "long bridge"
[self longAt: address
put: self numSlotsMask << self numSlotsFullShift + numSlots;
longAt: address + self baseHeaderSize
put: (self numSlotsMask << self numSlotsFullShift)
+ (1 << self pinnedBitShift)
+ (1 << self markedBitFullShift)
+ (self wordIndexableFormat << self formatShift)
+ self segmentBridgePun]!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>compactSegment:freeStart:segIndex: (in category 'incremental compact') -----
compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
<var: 'segInfo' type: #'SpurSegmentInfo *'>
| fillStart |
fillStart := initialFreeStart.
self deny: segIndex = 0. "Cannot compact seg 0"
manager segmentManager
allEntitiesInSegment: segInfo
exceptTheLastBridgeDo:
[:entity |
(manager isFreeObject: entity)
ifTrue:
[manager detachFreeObject: entity.
"To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
ifFalse:
[ (manager isMarked: entity)
ifTrue: [manager makeWhite: entity.
"During the mutator runs new forwarding references can be created. Ignore them as they get resolved with the other
forwarders in this segment in the next marking pass"
(manager isForwarded: entity)
ifFalse:[| bytesToCopy |
"Copy the object in segmentToFill and replace it by a forwarder."
bytesToCopy := manager bytesInBody: entity.
(self oop: fillStart + bytesToCopy isLessThan: (segmentToFill segLimit - manager bridgeSize))
ifFalse: ["somebody allocated a new object we did not knew about at the moment of planning :( -> it does not fit anymore and we cannot free the whole segment. Make sure to unmark the segment as beeing compacted as it would be completetly freed otherwise!!"
+ coInterpreter cr; print: 'segments if full. Abort compacting of: '; printHex: segInfo segStart ; tab; flush.
- coInterpreter cr; print: 'segments if full. Abort compacting of: '; printHex: segmentToFill segStart ; tab; flush.
self unmarkSegmentAsBeingCompacted: (manager segInfoAt: currentSegmentsIndex).
+ self
+ unmarkSegment: (manager segInfoAt: currentSegmentsIndex)
+ asBeingCompactedAndSaveEndOfCompactionAddress: entity.
"we need to sweep the rest of the segment. As the segment is not marked to be compacted anymore sweepOrCompactFromCurrentObject will decide to sweep it. We want to start sweeping from the current entity, therefore setting currentObject to it and
we have to protect it from beeing freed (with marking it) as it was marked previously and after us unmarking it here would
get collected incorrectly"
manager setIsMarkedOf: entity to: true.
currentObject := entity.
^ fillStart].
self migrate: entity sized: bytesToCopy to: fillStart.
fillStart := fillStart + bytesToCopy.
self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]
ifFalse: [
(manager isRemembered: entity)
ifTrue:
[self assert: (manager isFreeObject: entity) not.
scavenger forgetObject: entity].
"To avoid confusing too much Spur (especially the leak/free checks), we don't make the dead object a free chunk, but make it
a non pointer object to avoid the leak checker to try to follow the pointers of the dead object.
Should we abort compacting this segment the object will get kept alife for one gc cycle"
manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]]].
"we want to advance to the next segment from the bridge"
currentObject := currentSegmentsBridge.
^ fillStart!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>freePastSegmentsAndSetSegmentToFill (in category 'public') -----
freePastSegmentsAndSetSegmentToFill
"The first segment being claimed met becomes the segmentToFill. The others are just freed."
<var: 'segInfo' type: #'SpurSegmentInfo *'>
0 to: manager numSegments - 1 do:
[:i| | segInfo |
segInfo := manager segInfoAt: i.
+ (self wasSegmentsCompactionAborted: segInfo)
+ ifTrue: [ | freeUntil chunkBytes |
+ freeUntil := manager startOfObject: (self getEndOfCompaction: segInfo).
+ chunkBytes := freeUntil - segInfo segStart.
+
+ "maybe we could not even move one object out of the segment. Make sure we do not produce an invalid free chunk"
+ chunkBytes > 0
+ ifTrue: [coInterpreter
+ cr; print: 'partially freeing segment from: '; printHex: segInfo segStart;
+ print: ' to: '; printHex: freeUntil ;tab; flush.
+
+ manager
+ addFreeChunkWithBytes: chunkBytes
+ at: segInfo segStart]].
+
+ (self isSegmentBeingCompacted: segInfo) ifTrue:
- (self isSegmentBeingCompacted: segInfo) ifTrue:
[ | freeChunk chunkBytes |
self assert: (manager segmentManager allObjectsAreForwardedInSegment: segInfo includingFreeSpace: false).
self assert: (manager noElementOfFreeSpaceIsInSegment: segInfo).
coInterpreter
cr; print: 'freeing segment from: '; printHex: segInfo segStart;
print: ' to: '; printHex: segInfo segStart + segInfo segSize ;tab; flush.
chunkBytes := segInfo segSize - manager bridgeSize.
freeChunk := manager
addFreeChunkWithBytes: chunkBytes
at: segInfo segStart.
self unmarkSegmentAsBeingCompacted: segInfo.
segmentToFill ifNil:
[manager detachFreeObject: freeChunk.
segmentToFill := segInfo]]]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>getEndOfCompaction: (in category 'segment access') -----
+ getEndOfCompaction: segInfo
+
+ self assert: (self wasSegmentsCompactionAborted: segInfo).
+ ^ segInfo swizzle!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'public') -----
incrementalSweepAndCompact
scStartTime := coInterpreter ioUTCMicrosecondsNow.
self initIfNecessary.
"should in between sweeper calls segments be removed the index would not be correct anymore. Reset it here so we can be sure it is correct"
currentSegmentsIndex := manager segmentManager segmentIndexContainingObj: currentObject.
+ "if the bridge between segments was small before and the segment directly after the current one was removed the position of the bridge moved. Update
+ the current position to avoid this case"
+ currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
self assert: manager validObjectColors.
self doincrementalSweepAndCompact
ifTrue: [self finishSweepAndCompact.
^ true].
coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush.
^ false!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>isSegmentAtIndexBeingCompacted: (in category 'testing') -----
isSegmentAtIndexBeingCompacted: segIndex
+ ^ self isSegmentBeingCompacted: (manager segInfoAt: segIndex) !
- "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
- ^ (manager segInfoAt: segIndex) swizzle = 1!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>isSegmentBeingCompacted: (in category 'testing') -----
isSegmentBeingCompacted: segInfo
<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted.
+ swizzle = 0 -> not compacted
+ swizzle = 1 -> compacted
+ swizzle > 7 -> aborted compaction; swizzle is set to the objOop of the object after the compacted part"
- "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
^ segInfo swizzle = 1!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>markSegmentAsBeingCompacted: (in category 'segment access') -----
markSegmentAsBeingCompacted: segInfo
<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted.
+ swizzle = 0 -> not compacted
+ swizzle = 1 -> compacted
+ swizzle > 7 -> aborted compaction; swizzle is set to the objOop of the object after the compacted part"
- "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
self assert: (manager numSegments > 1 and: [segInfo ~= (self addressOf: (manager segmentManager segments at: 0))]).
segInfo swizzle: 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>unmarkSegment:asBeingCompactedAndSaveEndOfCompactionAddress: (in category 'segment access') -----
+ unmarkSegment: segInfo asBeingCompactedAndSaveEndOfCompactionAddress: address
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted.
+ swizzle = 0 -> not compacted
+ swizzle = 1 -> compacted
+ swizzle > 7 -> aborted compaction; swizzle is set to the objOop of the object after the compacted part"
+ self assert: (address bitAnd: 7) = 0.
+ segInfo swizzle: address!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>unmarkSegmentAsBeingCompacted: (in category 'segment access') -----
unmarkSegmentAsBeingCompacted: segInfo
<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted.
+ swizzle = 0 -> not compacted
+ swizzle = 1 -> compacted
+ swizzle > 7 -> aborted compaction; swizzle is set to the objOop of the object after the compacted part"
- "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
segInfo swizzle: 0!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>wasSegmentsCompactionAborted: (in category 'testing') -----
+ wasSegmentsCompactionAborted: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted.
+ swizzle = 0 -> not compacted
+ swizzle = 1 -> compacted
+ swizzle > 7 -> aborted compaction; swizzle is set to the objOop of the object after the compacted part"
+ ^ segInfo swizzle > 7!
Item was removed:
- ----- Method: SpurIncrementalMarker>>pushOnMarkingStack: (in category 'marking-stack') -----
- pushOnMarkingStack: objOop
-
- manager push: objOop onObjStack: manager markStack!
1
0
07 Jan '23
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3291.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3291
Author: WoC
Time: 7 January 2023, 1:14:24.991442 am
UUID: 36af9fd6-1dcf-42b2-a6d6-93110b2f36a9
Ancestors: VMMaker.oscog.seperateMarking-WoC.3290
- adpated barriers to use with 2 phase GC (needs to handle segmentToFill)
- some recategorization
- try to limit 2 phase gc actions to a time frame (5 ms); mixed results until now (sometimes works really good, sometimes gc takes "much longer")
- entered default values for SpurStopTheWorldGarbageCollector functions that were previously empty, because I thought that would translate to a nop (instead a return value was generated (return 0 what translates to false for all my checks) and used in the code)
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3290 ===============
Item was changed:
----- Method: CoInterpreter>>mapPrimTraceLog (in category 'debug support') -----
mapPrimTraceLog
"The prim trace log is a circular buffer of objects. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
<inline: false>
| entryOop |
(primTraceLog at: (self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize)) = 0 ifTrue:
[^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[primTraceLogIndex to: PrimTraceLogSize - 1 do:
[:i|
entryOop := primTraceLog at: i.
(entryOop ~= 0
and: [objectMemory shouldRemapOop: entryOop]) ifTrue:
[primTraceLog at: i put: (objectMemory remapObj: entryOop)]]].
0 to: primTraceLogIndex - 1 do:
[:i|
entryOop := primTraceLog at: i.
(entryOop ~= 0
and: [objectMemory shouldRemapOop: entryOop]) ifTrue:
[primTraceLog at: i put: (objectMemory remapObj: entryOop)]]!
Item was changed:
----- Method: CoInterpreter>>mapStackPages (in category 'object memory support') -----
mapStackPages
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
<inline: #never>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #frameRcvrOffset type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIPPtr type: #'char *'>
| numLivePages |
numLivePages := 0.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP frameRcvrOffset callerFP theIPPtr theIP oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
numLivePages := numLivePages + 1.
theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage
ifTrue: [theIPPtr := ((self isMachineCodeFrame: theFP)
or: [(self iframeSavedIP: theFP) = 0])
ifTrue: [0]
ifFalse: [theFP + FoxIFSavedIP]]
ifFalse:
[theIPPtr := theSP.
theSP := theSP + objectMemory wordSize].
[self assert: (thePage addressIsInPage: theFP).
self assert: (thePage addressIsInPage: theSP).
self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
frameRcvrOffset := self frameReceiverLocation: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory shouldRemapOop: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[(objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory remapObj: (self frameContext: theFP))].
"With SqueakV3 objectMemory or SpurPlanningCompactor can't assert since object body is yet to move."
(objectMemory hasSpurMemoryManagerAPI
and: [(objectMemory slidingCompactionInProgress or: [objectMemory scavengeInProgress]) not]) ifTrue:
[self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]].
(self isMachineCodeFrame: theFP) ifFalse:
[(objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue:
[theIPPtr ~= 0 ifTrue:
[theIP := stackPages longAt: theIPPtr.
theIP = cogit ceReturnToInterpreterPC
ifTrue:
[self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP).
theIPPtr := theFP + FoxIFSavedIP.
theIP := stackPages longAt: theIPPtr]
ifFalse:
[self assert: theIP > (self iframeMethod: theFP)].
theIP := theIP - (self iframeMethod: theFP)].
stackPages
longAt: theFP + FoxMethod
put: (objectMemory remapObj: (self iframeMethod: theFP)).
theIPPtr ~= 0 ifTrue:
[stackPages longAt: theIPPtr put: theIP + (self iframeMethod: theFP)]]].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory shouldRemapOop: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
theSP := theSP + objectMemory wordSize]]].
stackPages recordLivePagesOnMapping: numLivePages!
Item was changed:
----- Method: CoInterpreter>>mapTraceLog (in category 'debug support') -----
mapTraceLog
"The trace log is a circular buffer of pairs of entries. If there is
an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.
If there is something at traceLogIndex it has wrapped."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
<inline: false>
| limit |
limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
(traceLog at: limit) = 0 ifTrue: [^self].
(traceLog at: traceLogIndex) ~= 0 ifTrue:
[limit := TraceBufferSize - 3].
0 to: limit by: 3 do:
[:i| | intOrClass selectorOrMethod |
intOrClass := traceLog at: i.
(objectMemory shouldRemapOop: intOrClass) ifTrue:
[traceLog at: i put: (objectMemory remapObj: intOrClass)].
selectorOrMethod := traceLog at: i + 1.
(objectMemory shouldRemapOop: selectorOrMethod) ifTrue:
[traceLog at: i + 1 put: (objectMemory remapObj: selectorOrMethod)]]!
Item was changed:
+ ----- Method: SpurAllAtOnceMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurAllAtOnceMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
setIsMarkedOf: objOop
manager setIsMarkedOf: objOop to: true!
Item was changed:
SpurIncrementalMarker subclass: #SpurCountingIncrementalMarker
+ instanceVariableNames: 'mStartTime'
- instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
Item was changed:
+ ----- Method: SpurCountingIncrementalMarker>>getUsedMemoryOf: (in category 'segment occupation') -----
- ----- Method: SpurCountingIncrementalMarker>>getUsedMemoryOf: (in category 'as yet unclassified') -----
getUsedMemoryOf: segInfo
<var: 'segInfo' type: #'SpurSegmentInfo *'>
"hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
how much life data is in the segment"
^ segInfo lastFreeObject!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>incrementalMarkObjects (in category 'marking - incremental') -----
+ incrementalMarkObjects
+ "this method is to be run directly after a scavenge -> we can assume there are ony objects in the now past survivor space"
+
+ <inline: #never> "for profiling"
+
+ "manager runLeakCheckerFor: GCModeIncremental."
+
+ mStartTime := coInterpreter ioUTCMicrosecondsNow.
+ self initForNewMarkingPassIfNecessary.
+
+ [ | continueMarking |
+ (manager isEmptyObjStack: manager markStack)
+ ifTrue: [self pushAllRootsOnMarkStack.
+ " manager sizeOfObjStack: manager markStack.
+ did we finish marking?"
+ (manager isEmptyObjStack: manager markStack)
+ ifTrue: [self finishMarking.
+ ^ true]].
+
+
+ "due to a slang limitations we have to assign the result into variable => do not remove!!"
+ continueMarking := self incrementalMark.
+
+ continueMarking
+ ifTrue: [true]
+ ifFalse: [
+ coInterpreter cr; print: 'Time until now: '; printNum: coInterpreter ioUTCMicrosecondsNow - mStartTime ; tab; flush.
+ (coInterpreter ioUTCMicrosecondsNow - mStartTime) < (5000 / 2)]] whileTrue.
+
+ ^ false!
Item was changed:
+ ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
setIsMarkedOf: objOop
| segmentContainingObject |
super setIsMarkedOf: objOop.
self flag: #Todo. "we need a more efficient way to get the segment"
segmentContainingObject := manager segmentManager segmentContainingObj: objOop.
self
setUsedMemory: (self getUsedMemoryOf: segmentContainingObject) + (manager bytesInBody: objOop)
for: segmentContainingObject!
Item was changed:
+ ----- Method: SpurCountingIncrementalMarker>>setUsedMemory:for: (in category 'segment occupation') -----
- ----- Method: SpurCountingIncrementalMarker>>setUsedMemory:for: (in category 'as yet unclassified') -----
setUsedMemory: usedMemory for: segInfo
<var: 'segInfo' type: #'SpurSegmentInfo *'>
"hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
how much life data is in the segment"
segInfo lastFreeObject: usedMemory!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
+
+ ^ (self selectorsInIncrementalAndStopTheWorldGC includes: aSelectorSymbol)
+ ifTrue: [self staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: SpurIncrementalGarbageCollector]
+ ifFalse: [aSelectorSymbol]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
+ assertSettingGCFlagsIsOk: objOop
+
+ checkSetGCFlags ifFalse: [^ self].
+
+ "do not color young objects. They have an extra state we do not want to change"
+ self assert: (manager isOldObject: objOop).
+ (manager isOldObject: objOop)
+ ifFalse: [self cCode: 'raise(SIGINT)'].
+
+ "while sweeping: do not color objects behind the currently point the sweeper is at. This would infer with the next marking pass"
+ self assert: (self allocatorShouldAllocateBlack not or: [self inSweepingAheadOfSweepersPosition: objOop]).
+ self assert: (self isInSegmentToFill: objOop) not!
Item was changed:
----- Method: SpurIncremental2PhaseGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
| startTime |
phase = InMarkingPhase
ifTrue: [ | finishedMarking |
marker isCurrentlyMarking
ifFalse: [self assert: manager allObjectsUnmarked].
coInterpreter cr; print: 'start marking '; tab; flush.
finishedMarking := marker incrementalMarkObjects.
"self assert: manager validObjectColors."
finishedMarking
ifTrue: [
+ "manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)]."
- manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
We only know if they should get swept after the next marking -> keep them alive for this cycle"
self allocatorShouldAllocateBlack: true.
compactor setInitialSweepingEntity.
phase := InSweepingPhase.
"marking is done and thus all forwarding from the last compaction references are resolved
-> we can use the now free segments that were compacted during the last cycle"
compactor freePastSegmentsAndSetSegmentToFill.
compactor assertNoSegmentBeingCompacted.
self assert: manager noObjectGrey.
coInterpreter cr; print: 'finish marking '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
0 to: manager numSegments - 1
do: [:i | | segInfo |
segInfo := manager segInfoAt: i.
coInterpreter cr; print: 'occupation from marking: '; printNum: (segInfo lastFreeObject asFloat / segInfo segSize) * 100; tab; flush].
+ "manager printSegmentOccupationFromMarkedObjects."
- manager printSegmentOccupationFromMarkedObjects.
^ self]
+ ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush. "manager runLeakCheckerFor: GCModeIncremental"]].
- ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
phase = InSweepingPhase
ifTrue: [
coInterpreter cr; print: 'start sweeping '; tab; flush.
compactor incrementalSweepAndCompact
ifTrue: [
self allocatorShouldAllocateBlack: false.
+ self assert: manager allObjectsWhite.
- manager allOldSpaceObjectsDo: [:ea | (manager isWhite: ea) ifFalse: [self cCode: 'raise(SIGINT)']. self assert: (manager isWhite: ea) ].
"self assert: manager allObjectsUnmarked."
coInterpreter cr; print: 'finish sweeping '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
phase := InMarkingPhase.
^ self]]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>isInSegmentToFill: (in category 'testing') -----
+ isInSegmentToFill: objOop
+
+ ^ compactor segmentToFill notNil and: [manager segmentManager is: objOop inSegment: compactor segmentToFill]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') -----
+ isOkToScavengeRememberedObject: objOop
+ "When sweeping we can alreay have freed an object A that is referenced by B. If B is behind the sweepers
+ position and not marked it is garbage and to be collected. Yet B is still in the remembered set and will get
+ scanned, during which the freed object will be visited an an error caused. Use this check to prevent this
+
+ Objects in the segmentToFll are implicitly marked as they only get copied there if they were marked before"
+
+ ^ (self inSweepingAheadOfSweepersPosition: objOop) not
+ or: [(manager isMarked: objOop)
+ or: [self isInSegmentToFill: objOop]]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>maybeModifyCopiedObject: (in category 'object creation barriers') -----
+ maybeModifyCopiedObject: objOop
+
+ "1. when marking always mark as we already could have marked all objects pointing to objOop
+ 2. during sweeping mark objects behind the sweepers current position so it does not collect objOop"
+
+ (manager isOldObject: objOop)
+ ifTrue: [
+ marker isCurrentlyMarking
+ ifTrue: [
+ "If the object is not white we would skip it. Therefore make sure it is, as all young space objects
+ should be"
+ self assert: (manager isWhite: objOop).
+
+ "do not just color it but handle it correctly, depending on which type of object it is and
+ do things like scanning its class"
+ marker markAndShouldScan: objOop].
+
+ "do not mark objects in segment to fill as it gets ignored during sweeping"
+ ((self inSweepingAheadOfSweepersPosition: objOop) and: [(self isInSegmentToFill: objOop) not])
+ ifTrue: [manager setIsMarkedOf: objOop to: true]]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>maybeModifyGCFlagsOf: (in category 'object creation barriers') -----
+ maybeModifyGCFlagsOf: objOop
+
+ "when allocating a new object behind the current sweeping hight mark it should be allocated black so it does not get garbage
+ collected although we do not know if this is correct (but to know this we would need to mark again and that is expensive +
+ the object was allocated in old space therefore lets assume we want to keep it around (black allocation))
+
+ As the segmentToFill gets ignored we do not color objects there"
+ <inline: true>
+ ((manager isOldObject: objOop) and: [(self inSweepingAheadOfSweepersPosition: objOop) and: [(self isInSegmentToFill: objOop) not]])
+ ifTrue: [manager setIsMarkedOf: objOop to: true]!
Item was changed:
SpurCompactor subclass: #SpurIncrementalCompactingSweeper
+ instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer scStartTime'
- instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer'
classVariableNames: 'MaxObjectsToFree MaxOccupationForCompaction'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+
+ !SpurIncrementalCompactingSweeper commentStamp: 'WoC 1/5/2023 23:21' prior: 0!
+ A SpurIncrementalCompactingSweeper is an incremental sweeper that compacts too. It is a merge of SpurIncrementalSweeper and SpurIncrementalCompactor with slight changes to the algorithm to accomodate
+ to the fact both parts run at the same time. It traverses the heap one time sweeps normal segments, compacts segments that are planned to be compacted (more on that later) and skips the segment that should get filled. The compaction is adapted from: Lazy Pointer Update for Low Heap Compaction Pause Times (Clément Béra; Eliot Miranda; Elisa Gonzalez Boix -> https://doi.org/10.1145/3359619.3359741)
+
+ The SpurIncrementalCompactingSweeper is designed to run after the SpurCountingIncrementalMarker. The SpurCountingIncrementalMarker will write how many bytes of life data are in segments into the segmentInfo lastFreeObject. As a first step we decide if and when yes which segments should get compacted. We try to compact as many segments as possible, that are under a certain threshold (see MaxOccupationForCompaction what the actual value is), into the segmentToFill (an completetly empty segment we reserve or allocate when no empty segment is available)
+
+ The interesting entry point for understanding the algorithm is doincrementalSweepAndCompact. We already planned the compaction (read from planCompactionAndReserveSpace) and reserved the segmentToFill (freePastSegmentsAndSetSegmentToFill or findOrAllocateSegmentToFill). We now scan the whole heap. When the current object is in a normal segment we just do a normal sweep. This includes unmarking marked objects and coalescing unmarked objects and free chunks to larger free chunks (the whole succession of free chunks and unmarked objects until the next marked object or end of segment (attention!! only until the end of the segment the first object of this succession is)).
+
+ Should the current object we see be in the segmentToFill we skip the whole segment. We can safely skip it as it was empty previously (the mutator cannot allocate into the segmentToFill) and we only copy life objects here -> we do not need to do work here as everything here is life.
+
+ If the current object is in a segment that should be compacted (the current object will then be at the beginning of the segment) we start to compact it into segmentToFill. Free chunks get detached and set to a different class (so other safety mechanism ignore them). Marked objects get unmarked and forwarded to the segmentToFill. Unmarked objects get ignored (we just unremember them).
+
+ Instance Variables
+ currentCopyToPointer: <Object>
+ currentObject: <Object>
+ currentSegmentsBridge: <Object>
+ currentSegmentsIndex: <Object>
+ currentsCycleSeenObjectCount: <Object>
+ isCurrentlyWorking: <Object>
+ segmentToFill: <Object>
+ shouldCompact: <Object>
+
+ currentCopyToPointer
+ - xxxxx
+
+ currentObject
+ - xxxxx
+
+ currentSegmentsBridge
+ - xxxxx
+
+ currentSegmentsIndex
+ - xxxxx
+
+ currentsCycleSeenObjectCount
+ - xxxxx
+
+ isCurrentlyWorking
+ - xxxxx
+
+ segmentToFill
+ - xxxxx
+
+ shouldCompact
+ - xxxxx
+ !
Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>declareCVarsIn: (in category 'translation') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>declareCVarsIn: (in category 'as yet unclassified') -----
declareCVarsIn: aCCodeGenerator
aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'.
SpurMemoryManager wantsIncrementalGC
ifTrue: [
(self selectors intersection: SpurPlanningCompactor selectors)
do: [:key |
aCCodeGenerator
staticallyResolveMethodNamed: key
forClass: self
to: (self staticallyResolvePolymorphicSelector: key)]]!
Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>hasPolymorphicSelectors (in category 'translation') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>hasPolymorphicSelectors (in category 'as yet unclassified') -----
hasPolymorphicSelectors
"when using the incremental gc we have polymorphic selectors and have to resolve them"
^ SpurMemoryManager wantsIncrementalGC!
Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>initialize (in category 'initialization') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>initialize (in category 'as yet unclassified') -----
initialize
super initialize.
"If the segment is occupied by more than MaxOccupationForCompaction,
it's not worth compacting it, whatever the rest of the system looks like.
MaxOccupationForCompaction is included in [0;16rFFFF]."
MaxOccupationForCompaction := 16rD000. "81%"
MaxObjectsToFree := 100000!
Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>staticallyResolvePolymorphicSelector: (in category 'translation') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
staticallyResolvePolymorphicSelector: aSelectorSymbol
| intersection |
intersection := (self selectors intersection: SpurPlanningCompactor selectors).
^ (intersection includes: aSelectorSymbol)
ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
ifFalse: [aSelectorSymbol]!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>compactSegment:freeStart:segIndex: (in category 'incremental compact') -----
compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
<var: 'segInfo' type: #'SpurSegmentInfo *'>
| fillStart |
fillStart := initialFreeStart.
self deny: segIndex = 0. "Cannot compact seg 0"
manager segmentManager
allEntitiesInSegment: segInfo
exceptTheLastBridgeDo:
[:entity |
(manager isFreeObject: entity)
ifTrue:
[manager detachFreeObject: entity.
"To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
ifFalse:
[ (manager isMarked: entity)
ifTrue: [manager makeWhite: entity.
"During the mutator runs new forwarding references can be created. Ignore them as they get resolved with the other
forwarders in this segment in the next marking pass"
(manager isForwarded: entity)
ifFalse:[| bytesToCopy |
"Copy the object in segmentToFill and replace it by a forwarder."
bytesToCopy := manager bytesInBody: entity.
(self oop: fillStart + bytesToCopy isLessThan: (segmentToFill segLimit - manager bridgeSize))
ifFalse: ["somebody allocated a new object we did not knew about at the moment of planning :( -> it does not fit anymore and we cannot free the whole segment. Make sure to unmark the segment as beeing compacted as it would be completetly freed otherwise!!"
coInterpreter cr; print: 'segments if full. Abort compacting of: '; printHex: segmentToFill segStart ; tab; flush.
self unmarkSegmentAsBeingCompacted: (manager segInfoAt: currentSegmentsIndex).
"we need to sweep the rest of the segment. As the segment is not marked to be compacted anymore sweepOrCompactFromCurrentObject will decide to sweep it. We want to start sweeping from the current entity, therefore setting currentObject to it and
we have to protect it from beeing freed (with marking it) as it was marked previously and after us unmarking it here would
get collected incorrectly"
manager setIsMarkedOf: entity to: true.
currentObject := entity.
^ fillStart].
self migrate: entity sized: bytesToCopy to: fillStart.
fillStart := fillStart + bytesToCopy.
self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]
ifFalse: [
(manager isRemembered: entity)
ifTrue:
[self assert: (manager isFreeObject: entity) not.
scavenger forgetObject: entity].
+ "To avoid confusing too much Spur (especially the leak/free checks), we don't make the dead object a free chunk, but make it
+ a non pointer object to avoid the leak checker to try to follow the pointers of the dead object.
+ Should we abort compacting this segment the object will get kept alife for one gc cycle"
+ manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]]].
- "To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
- manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]]].
"we want to advance to the next segment from the bridge"
currentObject := currentSegmentsBridge.
^ fillStart!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>computeSegmentsToCompact (in category 'compaction planning') -----
computeSegmentsToCompact
"Compute segments to compact: least occupied.
Answers true if compaction should be done
(at least 1 segment is being compacted and
there is a segment to compact into)."
| canStillClaim aboutToClaim aboutToClaimSegment atLeastOneSegmentToCompact |
<var: 'aboutToClaimSegment' type: #'SpurSegmentInfo *'>
atLeastOneSegmentToCompact := false.
aboutToClaimSegment := self findNextSegmentToCompact.
"Segment to fill is one of the segment compacted last GC.
If no segment were compacted last GC, and that there is
at least one segment to compact, allocate a new one."
aboutToClaimSegment ifNil: [^false].
segmentToFill ifNil:
[self findOrAllocateSegmentToFill.
segmentToFill ifNil: ["Abort compaction"^false]].
canStillClaim := segmentToFill segSize - manager bridgeSize.
[aboutToClaimSegment ifNil: [^atLeastOneSegmentToCompact].
aboutToClaim := self sizeClaimedIn: aboutToClaimSegment.
aboutToClaim < canStillClaim ] whileTrue:
[self markSegmentAsBeingCompacted: aboutToClaimSegment.
coInterpreter cr;
+ print: 'about to compact segment ';
+ printNum: (manager segmentManager indexOfSegment: aboutToClaimSegment);
+ print: ' from: '; printHex: aboutToClaimSegment segStart;
- print: 'about to compact segment from: '; printHex: aboutToClaimSegment segStart;
print: ' to: '; printHex: aboutToClaimSegment segStart + aboutToClaimSegment segSize ;tab; flush.
atLeastOneSegmentToCompact := true.
canStillClaim := canStillClaim - aboutToClaim.
aboutToClaimSegment := self findNextSegmentToCompact].
^atLeastOneSegmentToCompact!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>doincrementalSweepAndCompact (in category 'sweep and compact') -----
doincrementalSweepAndCompact
"Scan the heap for unmarked objects and free them. Coalescence "
self assert: currentObject notNil.
currentsCycleSeenObjectCount := 0.
[self oop: currentObject isLessThan: manager endOfMemory] whileTrue:
[ currentObject = currentSegmentsBridge
ifTrue: [self advanceSegment]
ifFalse: [self sweepOrCompactFromCurrentObject].
currentsCycleSeenObjectCount >= MaxObjectsToFree
+ ifTrue: [" | segInfo segIndex bytesAhead |
+ segIndex := (manager segmentIndexContainingObj: currentObject).
+ segInfo := manager segInfoAt: segIndex.
+
+ bytesAhead := segInfo segSize - (currentObject - segInfo segStart).
+
+ segIndex + 1 to: manager numSegments
+ do: [:index | | segment|
+ segment := manager segInfoAt: index.
+ bytesAhead := bytesAhead + segment segSize]."
+
+
+
+ (coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000
+ ifTrue: [^ false]
+ ifFalse: [currentsCycleSeenObjectCount := 0]]].
- ifTrue: [^ false]].
"set occupation for last segment"
manager checkFreeSpace: GCModeIncremental.
^ true!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'public') -----
incrementalSweepAndCompact
+ scStartTime := coInterpreter ioUTCMicrosecondsNow.
self initIfNecessary.
+ "should in between sweeper calls segments be removed the index would not be correct anymore. Reset it here so we can be sure it is correct"
+ currentSegmentsIndex := manager segmentManager segmentIndexContainingObj: currentObject.
+
self assert: manager validObjectColors.
self doincrementalSweepAndCompact
ifTrue: [self finishSweepAndCompact.
^ true].
coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush.
^ false!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>sweepOrCompactFromCurrentObject (in category 'sweep and compact') -----
sweepOrCompactFromCurrentObject
self shouldCompactCurrentSegment
ifTrue: [self doIncrementalCompact.
"either we finished compacting the segment or we had to abort compaction as the segment to fill cannot take more objects from this segment. We have to continue sweeping. This is done by unmarking the current segment as beeing compacted and making sure the last object we nearly copied before (and we know was alive after marking) is kept alive for sweeping"
self assert: ((manager isSegmentBridge: currentObject)
+ or: [(manager isMarked: currentObject) and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]]).
+
+ (coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000
+ ifTrue: ["we just compacted a whole segment. Maybe this took a long time therefore set currentsCycleSeenObjectCount to max to force a check in doincrementalSweepAndCompact"
+ currentsCycleSeenObjectCount := MaxObjectsToFree]]
- or: [(manager isMarked: currentObject) and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]])]
ifFalse: [self doIncrementalSweep.
currentObject := self nextCurrentObject]
!
Item was changed:
SpurGarbageCollector subclass: #SpurIncrementalGarbageCollector
instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags'
classVariableNames: 'InCompactingPhase InMarkingPhase InSweepingPhase'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+
+ !SpurIncrementalGarbageCollector commentStamp: 'WoC 1/5/2023 21:36' prior: 0!
+ A SpurIncrementalGarbageCollector is a garbage collection algorithm. The GC is a mark and sweep with an additional compaction if certain conditions are fulfilled.
+ This class manages SpurIncrementalMarker and SpurIncrementalSweepAndCompact (which in turn manages SpurIncrementalCompactor and SpurIncrementalSweeper). The 3 classes
+ implementing the GC are therefore SpurIncrementalMarker, SpurIncrementalSweeper and SpurIncrementalCompactor.
+
+ Instance Variables
+ allAtOnceMarker: <SpurAllAtOnceMarker>
+ checkSetGCFlags: <Bool>
+ phase: <Number (InMarkingPhase|InSweepingPhase|InCompactingPhase)>
+
+ allAtOnceMarker
+ - an instance of SpurAllAtOnceMarker. We sometimes need parts of the old (stop-the-world) gc algorithm. This is the marking algorithm we can use through static polymorphism
+
+ checkSetGCFlags
+ - should we check if it ok to set gc flags or not
+
+ phase
+ - in which phase is the gc algorithm at the moment. Is either InMarkingPhase, InSweepingPhase or InCompactingPhase
+ !
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>maybeModifyGCFlagsOf: (in category 'object creation barriers') -----
maybeModifyGCFlagsOf: objOop
"when allocating a new object behind the current sweeping hight mark it should be allocated black so it does not get garbage
+ collected although we do not know if this is correct (but to know this we would need to mark again and that is expensive +
+ the object was allocated in old space therefore lets assume we want to keep it around (black allocation))"
- collected although we do not know if this is correct"
<inline: true>
((manager isOldObject: objOop) and: [self inSweepingAheadOfSweepersPosition: objOop])
ifTrue: [manager setIsMarkedOf: objOop to: true]!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>writeBarrierFor:at:with: (in category 'barrier') -----
writeBarrierFor: anObject at: index with: value
"a dijkstra style write barrier with the addition of the generation check
objects that are not able to contain pointers are ignored too, as the write barries
should ensure we lose no references and this objects do not hold any of them"
<inline: true>
self flag: #Todo. "we probably want the oldObject check to be the first one as it is only a pointer comparison and no dereferencing is needed"
"((manager isImmediate: value) not and: [(manager isPureBitsNonImm: value)])
ifTrue: [coInterpreter cr; print: 'saw: '; printHexnp: value; tab; flush]."
+ self flag: #Todo. "do I need the immediate check?"
(self marking and: [(manager isImmediate: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]])
ifTrue: [marker markAndShouldScan: value]!
Item was changed:
----- Method: SpurIncrementalMarker class>>initialize (in category 'as yet unclassified') -----
initialize
"experimental value. needs some measurements"
+ SlotLimitPerPass := 256 * 1024 !
- SlotLimitPerPass := 10 * 1024 * 1024!
Item was changed:
+ ----- Method: SpurIncrementalMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
setIsMarkedOf: objOop
manager setIsMarkedOf: objOop to: true!
Item was changed:
+ ----- Method: SpurMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
setIsMarkedOf: objOop
self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>allOldSpaceEntitiesFrom:excludingTo:do: (in category 'object enumeration') -----
+ allOldSpaceEntitiesFrom: initialObject excludingTo: finalObject do: aBlock
+ <inline: true>
+ | prevObj prevPrevObj objOop |
+ self assert: ((self isNonImmediate: initialObject) and: [segmentManager isInSegments: initialObject]).
+ self assert: ((self isNonImmediate: finalObject) and: [segmentManager isInSegments: finalObject]).
+ prevPrevObj := prevObj := nil.
+ objOop := initialObject.
+ [self assert: objOop \\ self allocationUnit = 0.
+ self oop: objOop isLessThan: finalObject] whileTrue:
+ [self assert: (self long64At: objOop) ~= 0.
+ aBlock value: objOop.
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := self objectAfter: objOop limit: endOfMemory].
+ self touch: prevPrevObj.
+ self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>validObjectColors (in category 'debug support') -----
validObjectColors
| currentSweepingEntityT |
currentSweepingEntityT := gc sweepersCurrentSweepingEntity ifNil: [self firstObject].
self allOldSpaceEntitiesFrom: currentSweepingEntityT do: [:obj |
((self isMarked: obj) and: [(self isPointers: obj) and: [(self isContext: obj) not]])
ifTrue: [| slotCount |
slotCount := self numSlotsOf: obj.
0 to: slotCount - 1
do: [:index | | slot |
slot := self fetchPointer: index ofObject: obj.
((self isNonImmediate: slot) and: [(self isOldObject: slot) and: [(self isForwarded: slot) not]])
ifTrue: [(slot >= currentSweepingEntityT and: [(self isMarked: slot) not])
+ ifTrue: [
+ "for the 2 phase incremental gc. When we call this method while already having compacted some objects they are not marked anymore as we unmark them and do not sweep the segmentToFill"
+ (compactor segmentToFill notNil and: [(self segmentManager is: slot inSegment: compactor segmentToFill) not])
+ ifTrue: [self halt.
+ coInterpreter longPrintOop: (self firstReferenceTo:(self firstReferenceTo: obj)).
+ self printReferencesTo: (self firstReferenceTo: obj).
+ self printReferencesTo: obj.
+
+ self printRelativePositionOf: obj.
+ self printRelativePositionOf: slot.
+
+ coInterpreter longPrintOop: obj.
+ coInterpreter longPrintOop: slot.
+
+ self cCode: 'raise(SIGINT)'.
+
+ ^ false]]]]]].
- ifTrue: [self halt.
- coInterpreter longPrintOop: (self firstReferenceTo:(self firstReferenceTo: obj)).
- self printReferencesTo: (self firstReferenceTo: obj).
- self printReferencesTo: obj.
-
- self printRelativePositionOf: obj.
- self printRelativePositionOf: slot.
-
- coInterpreter longPrintOop: obj.
- coInterpreter longPrintOop: slot.
-
- self cCode: 'raise(SIGINT)'.
-
- ^ false]]]]].
^ true!
Item was changed:
----- Method: SpurStopTheWorldGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
assertSettingGCFlagsIsOk: objOop
+ "please keep this method. Needed to generate polymorpic version for this method"
+
+ ^ true!
- "please keep this method. Needed to generate polymorpic version for this method"!
Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>doScavenge: (in category 'scavenge') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>doScavenge: (in category 'as yet unclassified') -----
doScavenge: tenuringCriterion
"needed to generate polymorphic version of this method"
"The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
<inline: false>
manager doAllocationAccountingForScavenge.
manager gcPhaseInProgress: ScavengeInProgress.
manager pastSpaceStart: (scavenger scavenge: tenuringCriterion).
self assert: (self
oop: manager pastSpaceStart
isGreaterThanOrEqualTo: scavenger pastSpace start
andLessThanOrEqualTo: scavenger pastSpace limit).
manager freeStart: scavenger eden start.
manager gcPhaseInProgress: 0.
manager resetAllocationAccountingAfterGC.!
Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>isIncremental (in category 'testing') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>isIncremental (in category 'as yet unclassified') -----
isIncremental
^ false!
Item was changed:
----- Method: SpurStopTheWorldGarbageCollector>>isOkToClearReference: (in category 'testing') -----
isOkToClearReference: objOop
+ ^ true!
- "nop here"!
Item was changed:
----- Method: SpurStopTheWorldGarbageCollector>>isOkToDeleteSegment: (in category 'testing') -----
+ isOkToDeleteSegment: segment
+
+ ^ true!
- isOkToDeleteSegment: segment!
Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') -----
+ isOkToScavengeRememberedObject: objOop
+
+ ^ true!
- ----- Method: SpurStopTheWorldGarbageCollector>>isOkToScavengeRememberedObject: (in category 'as yet unclassified') -----
- isOkToScavengeRememberedObject: objOop!
Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>scavengingGCTenuringIf: (in category 'scavenge') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>scavengingGCTenuringIf: (in category 'as yet unclassified') -----
scavengingGCTenuringIf: tenuringCriterion
"Run the scavenger."
<inline: false>
self assert: manager remapBufferCount = 0.
(self asserta: scavenger eden limit - manager freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse:
[coInterpreter tab;
printNum: scavenger eden limit - manager freeStart; space;
printNum: coInterpreter interpreterAllocationReserveBytes; space;
printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - manager freeStart); cr].
manager checkMemoryMap.
manager checkFreeSpace: GCModeNewSpace.
manager runLeakCheckerFor: GCModeNewSpace.
coInterpreter
preGCAction: GCModeNewSpace;
"would prefer this to be in mapInterpreterOops, but
compatibility with ObjectMemory dictates it goes here."
flushMethodCacheFrom: manager newSpaceStart to: manager oldSpaceStart.
manager needGCFlag: false.
manager gcStartUsecs: coInterpreter ioUTCMicrosecondsNow.
self doScavenge: tenuringCriterion.
manager statScavenges: manager statScavenges + 1.
manager statGCEndUsecs: coInterpreter ioUTCMicrosecondsNow.
manager statSGCDeltaUsecs: manager statGCEndUsecs - manager gcStartUsecs.
manager statScavengeGCUsecs: manager statScavengeGCUsecs + manager statSGCDeltaUsecs.
manager statRootTableCount: scavenger rememberedSetSize.
scavenger logScavenge.
coInterpreter postGCAction: GCModeNewSpace.
manager runLeakCheckerFor: GCModeNewSpace.
manager checkFreeSpace: GCModeNewSpace!
Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>writeBarrierFor:at:with: (in category 'barrier') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>writeBarrierFor:at:with: (in category 'as yet unclassified') -----
writeBarrierFor: anObject at: index with: value!
Item was changed:
----- Method: StackInterpreter>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
checkForEventsMayContextSwitch: mayContextSwitch
"Check for possible interrupts and handle one if necessary.
Answer if a context switch has occurred."
| switched sema now |
<inline: false>
<var: #now type: #usqLong>
<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector>
statCheckForEvents := statCheckForEvents + 1.
"restore the stackLimit if it has been smashed."
self restoreStackLimit.
self externalWriteBackHeadFramePointers.
self assert: stackPage = stackPages mostRecentlyUsedPage.
"Allow the platform to do anything it needs to do synchronously."
self ioSynchronousCheckForEvents.
self checkCogCompiledCodeCompactionCalledFor.
objectMemory needGCFlag ifTrue:
["sufficientSpaceAfterGC: runs the incremental GC and
then, if not enough space is available, the fullGC."
- self cr; print: 'context switch '; tab; flush.
(objectMemory sufficientSpaceAfterGC: 0) ifFalse:
[self setSignalLowSpaceFlagAndSaveProcess]].
mayContextSwitch ifFalse: [^false].
switched := false.
(profileProcess ~= objectMemory nilObject
or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
[self zeroNextProfileTick.
"Take a sample (if not already done so) for the profiler if it is active. This
must be done before any of the synchronousSignals below or else we will
attribute a pause in ioRelinquishProcessor to the newly activated process."
profileProcess = objectMemory nilObject ifTrue:
[profileProcess := self activeProcess.
profileMethod := objectMemory nilObject].
"and signal the profiler semaphore if it is present"
(profileSemaphore ~= objectMemory nilObject
and: [self synchronousSignal: profileSemaphore]) ifTrue:
[switched := true]].
self cppIf: #LRPCheck
ifTrue:
[self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
[switched := true]].
objectMemory signalLowSpace ifTrue:
[objectMemory signalLowSpace: false. "reset flag"
sema := objectMemory splObj: TheLowSpaceSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
"inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
ioProcessEvents e.g. for native GUIs. We would like to manage that here but can't
since the platform code may choose to call ioProcessEvents itself in various places."
false
ifTrue:
[((now := self ioUTCMicroseconds) >= nextPollUsecs
and: [inIOProcessEvents = 0]) ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
inIOProcessEvents := inIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
inIOProcessEvents > 0 ifTrue:
[inIOProcessEvents := inIOProcessEvents - 1].
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]]
ifFalse:
[(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]].
interruptPending ifTrue:
[interruptPending := false.
"reset interrupt flag"
sema := objectMemory splObj: TheInterruptSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
nextWakeupUsecs ~= 0 ifTrue:
[now >= nextWakeupUsecs ifTrue:
[nextWakeupUsecs := 0.
"set timer interrupt to 0 for 'no timer'"
sema := objectMemory splObj: TheTimerSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]]].
"signal any pending finalizations"
pendingFinalizationSignals > 0 ifTrue:
[pendingFinalizationSignals := 0.
sema := objectMemory splObj: TheFinalizationSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
"signal all semaphores in semaphoresToSignal"
self signalExternalSemaphores ifTrue:
[switched := true].
^switched!
1
0
Eliot Miranda uploaded a new version of VMMakerUI to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerUI-eem.59.mcz
==================== Summary ====================
Name: VMMakerUI-eem.59
Author: eem
Time: 6 January 2023, 1:33:50.018176 pm
UUID: faac0746-9d3a-4c62-b470-d3ef8d2e0adc
Ancestors: VMMakerUI-mt.58
Change the updateVMMaker script so that it updates the current branch, rather than insisting on VMMaker.oscog/update.oscog. e.g. now it also handles VMMaker.oscog.seperateMarking/update.oscog.seperateMarking
=============== Diff against VMMakerUI-mt.58 ===============
Item was changed:
----- Method: TheWorldMainDockingBar>>updateVMMaker (in category '*VMMakerUI-updater') -----
updateVMMaker
<updater: 'Update VMMaker'>
+ | branch updateMap updater history message |
+ branch := (PackageInfo named: #VMMaker) workingCopy currentVersionInfo name.
+ updateMap := branch first: (branch indexOf: $- ifAbsent: [branch size + 1]) - 1.
+ updateMap := 'update', (updateMap allButFirst: #VMMaker size).
- | updater history message |
updater := MCMcmUpdater
+ updateMapNamed: updateMap
+ repository: 'http://source.squeak.org/VMMaker'.
- updateMapNamed: 'update.oscog'
- repository: 'http://source.squeak.org/VMMaker'.
updater lastUpdateMap ifEmpty: [
"If this is the first time that you use the updater, start at 5.mcm to avoid loading old code."
updater lastUpdateMap at: updater repository put: 5].
history := updater dependentPackages
collect: [:package | package name -> (package workingCopy ancestors
"N.B. the first version in a package's history will have empty ancestors."
ifEmpty: [nil] ifNotEmpty: [:ancestors| ancestors first])]
as: OrderedDictionary.
updater doUpdate: false.
"Set update history to the packages that actually changed."
updater dependentPackages do: [:package | | oldVersionInfo newVersionInfo |
oldVersionInfo := history at: package name ifAbsent: [].
newVersionInfo := package workingCopy ancestors first.
(oldVersionInfo ifNil: [0] ifNotNil: [oldVersionInfo versionNumber]) < newVersionInfo versionNumber
ifTrue: [history at: package name put: {oldVersionInfo. newVersionInfo}]
ifFalse: [history removeKey: package name]].
"Prepare message, including the update history and OSVM ci badges."
message := String streamContents: [:s |
s nextPutAll: 'VMMaker update succesful.<br><br>'.
history
ifEmpty: [s nextPutAll: 'All packages were already up-to-date.']
ifNotEmpty: [s nextPutAll: 'Updated packages:'].
history keysAndValuesDo: [:packageName :updateInfo |
s nextPutAll: '<br> - '.
s nextPutAll: packageName; space.
updateInfo isArray
ifFalse: [s nextPutAll: '*removed*' translated]
ifTrue: [
updateInfo first
ifNil: [s nextPutAll: '*added*' translated]
ifNotNil: [s print: updateInfo first versionNumber].
s nextPutAll: ' -> <b>'.
s print: updateInfo second versionNumber.
s nextPutAll: '</b>']].
s nextPutAll: ('<br><br>Url: <a href="{1}">{1}</a>' format: {updater repository}).
s nextPutAll: '<br>Map: '; print: updater updateMapName.
s nextPutAll: '<br>'.
#('macOS (x86)' macos
'macOS (ARM)' 'macos-arm'
'Windows' win
'Linux (x86)' linux
'Linux (ARM)' 'linux-arm')
groupsDo: [:label :workflow |
s nextPutAll: ('<br><a href="{2}"><img src="{3}" /> {4}</a> {1}'
format: {
label.
self osvm_GitHubActions_statusPageUrl: workflow.
self osvm_GitHubActions_statusBadgeUrl: workflow.
self osvm_GitHubActions_statusTimestamp: workflow})].
s nextPutAll: ('<br><br>Note that updated platform sources might be available, too: <a href="{1}">{1}</a>' format: {'https://github.com/OpenSmalltalk/opensmalltalk-vm'}).
].
self inform: message asTextFromHtml.!
2
1
In addition to LicheePi (Allwinner D1), OpenSmalltalk linux64riscv stack
build works directly on
the StarFive VisionFive-2 board:
https://ameridroid.com/products/visionfive-2
Happy New Year!
-KenD
[Cuis: "1 tinyBenchmark" --> 74.07 megaByteCodes/second; 3.82
megaSends/second]
2
1
Hi Gerald,
Could it be related to the transcript logging in console? It seems
strange to me because the VM has way to know at start up the log will go
to the console.
Hilaire
Le 04/01/2023 à 16:31, Gerald Klix a écrit :
> you are using console output --indirectly via the Transcript,
> I presume -- which only works, as the name indicates, with
> SqueakConsole. For Haver I only packaged the SqueakConsole
> executable, because of this problem.
--
GNU Dr. Geo
http://drgeo.eu
http://blog.drgeo.eu
1
0
05 Jan '23
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3290.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3290
Author: WoC
Time: 5 January 2023, 9:21:20.809577 pm
UUID: 768f93a1-b2fc-4512-874e-4bea6c9c78a6
Ancestors: VMMaker.oscog.seperateMarking-WoC.3289
Implemented a second version of incremental GC still based on the first attempt but in two phases and not three (counting of life objects in marking and sweeping + compacting in one step)
- CCodeGenerator now keeps track of which classes get generated (I wanted the use this, but do not need it anymore. As it was a nice info to have one time during debugging I decided to keep it)
- prepared SpurAllAtOnceMarker and SpurIncrementalMarker for introduction of SpurCountingIncrementalMarker
-added SpurCountingIncrementalMarker SpurIncremental2PhaseGarbageCollector and SpurIncrementalCompactingSweeper which implement the modified algorithm
- added some helper functions on SpurMemoryMarker that print useful information
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3289 ===============
Item was changed:
Object subclass: #CCodeGenerator
+ instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers recursivelyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining mappingForRecursivePolymophism removedForPolymorphism recursivePolymorphicMethodsMap toGenerate classesToBeGenerated'
- instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers recursivelyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining mappingForRecursivePolymophism removedForPolymorphism recursivePolymorphicMethodsMap toGenerate'
classVariableNames: 'NoRegParmsInAssertVMs'
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-Translation to C'!
!CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.
See VMMaker for more useful info!
Item was changed:
----- Method: CCodeGenerator>>addClass: (in category 'public') -----
addClass: aClass
"Add the variables and methods of the given class to the code base."
+ classesToBeGenerated add: aClass.
aClass prepareToBeAddedToCodeGenerator: self.
self checkClassForNameConflicts: aClass.
self addClassVarsFor: aClass.
"ikp..."
self addPoolVarsFor: aClass.
(aClass inheritsFrom: VMStructType) ifFalse:
[variables addAll: (self instVarNamesForClass: aClass)].
self retainMethods: (aClass requiredMethodNames: self options).
'Adding Class ' , aClass name , '...'
displayProgressAt: Sensor cursorPoint
from: 0
to: aClass selectors size
during:
[:bar |
aClass selectors withIndexDo:
[:sel :i | | source |
bar value: i.
self addMethodFor: aClass selector: sel]].
aClass declareCVarsIn: self!
Item was added:
+ ----- Method: CCodeGenerator>>classesToBeGenerated (in category 'accessing') -----
+ classesToBeGenerated
+
+ ^ classesToBeGenerated!
Item was changed:
----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:fromMethod:in: (in category 'public') -----
ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode fromMethod: aTMethod in: aClass
"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
prefixed with a given string to disambiguate. This hack allows us to use two different
compaction algorithms with the same API at the same time; the selection being done
by a class which holds the flag stating which algorithm is in effect at the current time."
| class receiverSymbol |
staticallyResolvedPolymorphicReceivers ifNil: [^self].
"for debugging. Please do not remove!!"
+ "(aTMethod selector = #slidingCompactionRemapObj: and: [aSendNode selector = #isMobile:]) ifTrue: [self halt]."
- "aTMethod selector = #mapStackPages and: [aSendNode selector = #shouldRemapOop:]) ifTrue: [self halt]."
(aSendNode receiver isVariable
or: [(self hasPolymorphicMethod: aSendNode selector in: aClass )
or: [removedForPolymorphism includesKey: aSendNode selector]])
ifFalse: [^self].
receiverSymbol := aSendNode receiver name.
class := (aTMethod pragmasAt: #staticallyResolveMethod:to:)
ifNotNil: [:pragmas |
pragmas
detect: [:pragma | aSendNode selector = (pragma argumentAt: 1)]
ifFound: [:pragma | "self halt."
self
resolve: aSendNode
to: (Smalltalk at: (pragma argumentAt: 2))
ifFound: [^self]]
ifNone: []].
class := (aTMethod pragmaAt: #declareTypeForStaticPolymorphism:)
ifNotNil: [:pragma | | typeHint classFromHint |
typeHint := pragma argumentAt: 1.
classFromHint := Smalltalk at: (pragma argumentAt: 1).
"if we look at a polymorphic base method do not resolve it to its default but the type hint if it knows it"
methods at: aSendNode selector
ifPresent: [:method |
method isPolymorphicBase
ifTrue: [(method classes includes: classFromHint)
ifTrue: [ | newSelector |
newSelector := method polymorphicSelectorForClass: classFromHint.
aSendNode setSelectorForPolymorphism: newSelector.
^ self]].
method isPolymorphic
ifTrue: [self error: 'Should not happen']].
removedForPolymorphism at: aSendNode selector
ifPresent: [:dictionary |
dictionary at: classFromHint
ifPresent: [:selector |
aSendNode
setSelectorForPolymorphism: selector.
^ self].
(mappingForRecursivePolymophism associationsSelect: [:assoc | assoc value = classFromHint]) keys
detect: [:key | dictionary includesKey: key]
ifFound: [:clazz |
aSendNode
setSelectorForPolymorphism: (dictionary at: clazz).
^ self]
]].
class ifNil: [self resolveRecursivePolymorphism: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: [^ self]].
class := class ifNil: [self getClassFromPragmasIn: aTMethod ifMatching: receiverSymbol].
class := class ifNil: [self getClassFor: receiverSymbol in: aClass].
class := class ifNil: [
removedForPolymorphism at: aSendNode selector
ifPresent: [: dict |
+ "you probably ask yourself: why am I here? This halt is triggered if we were unable to resolve your method, although
+ it is polymorphic with a very high probability. You either have to declare to which type the method has to be resolved, you
+ did not implement to method in the class you would it expect to be in (inspect dict and see if the class you would expect is
+ listed there as a key. If not you did not call staticallyResolveMethodNamed:forClass:to: on the selector in the missing class, please
+ investigate) or I forgot to include one case if the type should already be known
- "you probably ask yourself: why am I here? This halt is triggered if we wre unable to resolve your method, although
- it is polymorphic with a very high probability. You either have to declare to which type the method has to be resolved
- or I forgot to include one case if the type should already be known
Please have a look what aTMethod to know in which method the problem occured and aSendNode to know the call in aTMethod that is not enough defined. Probably you want to include a pragma #staticallyResolveReceiver:to: to define of which type the receiver is. Should the current method be a Polymorphic(Base)TMethod it is probably interesting why resolveRecursivePolymorphism:in:fromMethod:in:ifMatch: above does not resolve it."
self halt]].
"we have to find a class to resolve the selector"
class
ifNotNil: [
aSendNode
setSelectorForPolymorphism: (class staticallyResolvePolymorphicSelector: aSendNode selector)]
!
Item was changed:
----- Method: CCodeGenerator>>initialize (in category 'initialize-release') -----
initialize
translationDict := Dictionary new.
inlineList := Array new.
constants := Dictionary new: 100.
variables := Set new: 100.
variableDeclarations := Dictionary new: 100.
methods := Dictionary new: 500.
kernelReturnTypes := self computeKernelReturnTypes.
macros := Dictionary new.
self initializeCTranslationDictionary.
headerFiles := OrderedCollection new.
globalVariableUsage := Dictionary new.
useSymbolicConstants := true.
generateDeadCode := true.
scopeStack := OrderedCollection new.
self getLogger.
pools := IdentitySet new.
selectorTranslations := IdentityDictionary new.
accessorDepthCache := IdentityDictionary new.
beganInlining := false.
suppressAsmLabels := false.
previousCommentMarksInlining := false.
previousCommenter := nil.
breakSrcInlineSelectors := IdentitySet new.
+ breakDestInlineSelectors := IdentitySet new.
+ classesToBeGenerated := IdentitySet new!
- breakDestInlineSelectors := IdentitySet new!
Item was changed:
----- Method: SpurAllAtOnceMarker>>markAndShouldScan: (in category 'marking') -----
markAndShouldScan: objOop
"Helper for markAndTrace:.
Mark the argument, and answer if its fields should be scanned now.
Immediate objects don't need to be marked.
Already marked objects have already been processed.
Pure bits objects don't need scanning, although their class does.
Weak objects should be pushed on the weakling stack.
Anything else need scanning."
| format |
<inline: true>
(manager isImmediate: objOop) ifTrue:
[^false].
"if markAndTrace: is to follow and eliminate forwarding pointers
in its scan it cannot be handed an r-value which is forwarded."
self assert: (manager isForwarded: objOop) not.
(manager isMarked: objOop) ifTrue:
[^false].
+ self setIsMarkedOf: objOop.
- manager setIsMarkedOf: objOop to: true.
format := manager formatOf: objOop.
(manager isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack."
["Avoid tracing classes of non-objects on the heap, e.g. IRC caches, Sista counters."
(manager classIndexOf: objOop) > manager lastClassIndexPun ifTrue:
[self markAndTraceClassOf: objOop].
^false].
(manager isWeakFormat: format) ifTrue: "push weaklings on the weakling stack to scan later"
[manager push: objOop onObjStack: manager weaklingStack.
^false].
((manager isEphemeronFormat: format)
and: [manager activeAndDeferredScan: objOop]) ifTrue:
[^false].
^true!
Item was changed:
----- Method: SpurAllAtOnceMarker>>markAndTraceClassOf: (in category 'marking') -----
markAndTraceClassOf: objOop
"Ensure the class of the argument is marked, pushing it on the markStack if not already marked.
And for one-way become, which can create duplicate entries in the class table, make sure
objOop's classIndex refers to the classObj's actual classIndex.
Note that this is recursive, but the metaclass chain should terminate quickly."
<inline: false>
| classIndex classObj realClassIndex |
classIndex := manager classIndexOf: objOop.
classObj := manager classOrNilAtIndex: classIndex.
self assert: (coInterpreter objCouldBeClassObj: classObj).
realClassIndex := manager rawHashBitsOf: classObj.
(classIndex ~= realClassIndex
and: [classIndex > manager lastClassIndexPun]) ifTrue:
[manager setClassIndexOf: objOop to: realClassIndex].
(manager isMarked: classObj) ifFalse:
+ [self setIsMarkedOf: classObj.
- [manager setIsMarkedOf: classObj to: true.
self markAndTraceClassOf: classObj.
manager push: classObj onObjStack: manager markStack]!
Item was changed:
----- Method: SpurAllAtOnceMarker>>markAndTraceHiddenRoots (in category 'marking') -----
markAndTraceHiddenRoots
"The hidden roots hold both the class table pages and the obj stacks,
and hence need special treatment. The obj stacks must be marked
specially; their pages must be marked, but only the contents of the
mournQueue should be marked.
If a class table page is weak we can mark and trace the hiddenRoots,
which will not trace through class table pages because they are weak.
But if class table pages are strong, we must mark the pages and *not*
trace them so that only classes reachable from the true roots will be
marked, and unreachable classes will be left unmarked."
self markAndTraceObjStack: manager markStack andContents: false.
self markAndTraceObjStack: manager weaklingStack andContents: false.
self markAndTraceObjStack: manager mournQueue andContents: true.
+ self setIsMarkedOf: manager rememberedSetObj.
+ self setIsMarkedOf: manager freeListsObj.
- manager setIsMarkedOf: manager rememberedSetObj to: true.
- manager setIsMarkedOf: manager freeListsObj to: true.
(manager isWeakNonImm: manager classTableFirstPage) ifTrue:
[^self markAndTrace: manager hiddenRootsObj].
+ self setIsMarkedOf: manager hiddenRootsObj.
- manager setIsMarkedOf: manager hiddenRootsObj to: true.
self markAndTrace: manager classTableFirstPage.
1 to: manager numClassTablePages - 1 do:
+ [:i| self setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)]!
- [:i| manager setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)
- to: true]!
Item was changed:
----- Method: SpurAllAtOnceMarker>>markAndTraceObjStack:andContents: (in category 'marking') -----
markAndTraceObjStack: stackOrNil andContents: markAndTraceContents
"An obj stack is a stack of objects stored in a hidden root slot, such
as the markStack or the ephemeronQueue. It is a linked list of
segments, with the hot end at the head of the list. It is a word object.
The stack pointer is in ObjStackTopx and 0 means empty."
<inline: false>
| index field |
stackOrNil = manager nilObj ifTrue:
[^self].
+ self setIsMarkedOf: stackOrNil.
- manager setIsMarkedOf: stackOrNil to: true.
self assert: (manager numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
field := manager fetchPointer: ObjStackNextx ofObject: stackOrNil.
field ~= 0 ifTrue:
[self markAndTraceObjStack: field andContents: markAndTraceContents].
field := stackOrNil.
[field := manager fetchPointer: ObjStackFreex ofObject: field.
field ~= 0] whileTrue:
+ [self setIsMarkedOf: field].
- [manager setIsMarkedOf: field to: true].
markAndTraceContents ifFalse:
[^self].
"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5."
index := (manager fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
[index >= ObjStackFixedSlots] whileTrue:
[field := manager followObjField: index ofObject: stackOrNil.
(manager isImmediate: field) ifFalse:
[self markAndTrace: field].
index := index - 1]!
Item was added:
+ ----- Method: SpurAllAtOnceMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ manager setIsMarkedOf: objOop to: true!
Item was added:
+ SpurIncrementalMarker subclass: #SpurCountingIncrementalMarker
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurGarbageCollector'!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker class>>selectorsInOverlappingClasses (in category 'as yet unclassified') -----
+ selectorsInOverlappingClasses
+
+ ^ SpurAllAtOnceMarker selectors intersection: (SpurIncrementalMarker selectors union: self selectors)!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>getUsedMemoryOf: (in category 'as yet unclassified') -----
+ getUsedMemoryOf: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+
+ "hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
+ how much life data is in the segment"
+ ^ segInfo lastFreeObject!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>initForNewMarkingPass (in category 'marking-initialization') -----
+ initForNewMarkingPass
+
+ super initForNewMarkingPass.
+
+ 0 to: manager numSegments - 1
+ do: [:index |
+ self setUsedMemory: 0 for: (manager segInfoAt: index)]!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ | segmentContainingObject |
+ super setIsMarkedOf: objOop.
+
+ self flag: #Todo. "we need a more efficient way to get the segment"
+ segmentContainingObject := manager segmentManager segmentContainingObj: objOop.
+ self
+ setUsedMemory: (self getUsedMemoryOf: segmentContainingObject) + (manager bytesInBody: objOop)
+ for: segmentContainingObject!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>setUsedMemory:for: (in category 'as yet unclassified') -----
+ setUsedMemory: usedMemory for: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+
+ "hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
+ how much life data is in the segment"
+ segInfo lastFreeObject: usedMemory!
Item was added:
+ SpurIncrementalGarbageCollector subclass: #SpurIncremental2PhaseGarbageCollector
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurGarbageCollector'!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>compactorClass (in category 'accessing class hierarchy') -----
+ compactorClass
+
+ ^ SpurIncrementalCompactingSweeper!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>declareRecursivePolymorphismMappingForIncrementalClasses: (in category 'translation') -----
+ declareRecursivePolymorphismMappingForIncrementalClasses: aCCodeGenerator
+
+ aCCodeGenerator
+ forRecursivePolymorphismResolve: SpurCountingIncrementalMarker as: SpurIncrementalGarbageCollector;
+ forRecursivePolymorphismResolve: SpurIncrementalCompactingSweeper as: SpurIncrementalGarbageCollector!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>markerClass (in category 'accessing class hierarchy') -----
+ markerClass
+
+ ^ SpurCountingIncrementalMarker!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>markerClassesForTranslation (in category 'translation') -----
+ markerClassesForTranslation
+
+ ^ super markerClassesForTranslation , {SpurCountingIncrementalMarker}!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>sweeperAndCompactorClassesForTranslation (in category 'translation') -----
+ sweeperAndCompactorClassesForTranslation
+
+ ^ {SpurPlanningCompactor . SpurIncrementalCompactingSweeper}!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
+ doIncrementalCollect
+
+ | startTime |
+
+ phase = InMarkingPhase
+ ifTrue: [ | finishedMarking |
+ marker isCurrentlyMarking
+ ifFalse: [self assert: manager allObjectsUnmarked].
+
+ coInterpreter cr; print: 'start marking '; tab; flush.
+ finishedMarking := marker incrementalMarkObjects.
+
+ "self assert: manager validObjectColors."
+
+ finishedMarking
+ ifTrue: [
+ manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
+
+ "when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
+ We only know if they should get swept after the next marking -> keep them alive for this cycle"
+ self allocatorShouldAllocateBlack: true.
+ compactor setInitialSweepingEntity.
+ phase := InSweepingPhase.
+
+ "marking is done and thus all forwarding from the last compaction references are resolved
+ -> we can use the now free segments that were compacted during the last cycle"
+ compactor freePastSegmentsAndSetSegmentToFill.
+ compactor assertNoSegmentBeingCompacted.
+
+ self assert: manager noObjectGrey.
+
+ coInterpreter cr; print: 'finish marking '; tab; flush.
+
+ startTime := coInterpreter ioUTCMicrosecondsNow.
+ manager
+ setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
+ runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
+ checkFreeSpace: GCModeFull.
+
+ coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
+
+ 0 to: manager numSegments - 1
+ do: [:i | | segInfo |
+ segInfo := manager segInfoAt: i.
+ coInterpreter cr; print: 'occupation from marking: '; printNum: (segInfo lastFreeObject asFloat / segInfo segSize) * 100; tab; flush].
+
+ manager printSegmentOccupationFromMarkedObjects.
+
+ ^ self]
+ ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
+
+ phase = InSweepingPhase
+ ifTrue: [
+ coInterpreter cr; print: 'start sweeping '; tab; flush.
+ compactor incrementalSweepAndCompact
+ ifTrue: [
+ self allocatorShouldAllocateBlack: false.
+ manager allOldSpaceObjectsDo: [:ea | (manager isWhite: ea) ifFalse: [self cCode: 'raise(SIGINT)']. self assert: (manager isWhite: ea) ].
+ "self assert: manager allObjectsUnmarked."
+
+ coInterpreter cr; print: 'finish sweeping '; tab; flush.
+
+ startTime := coInterpreter ioUTCMicrosecondsNow.
+ manager
+ setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
+ runLeakCheckerFor: GCModeFull;
+ checkFreeSpace: GCModeFull.
+ coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
+
+ phase := InMarkingPhase.
+ ^ self]]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>inSweepingAheadOfSweepersPosition: (in category 'testing') -----
+ inSweepingAheadOfSweepersPosition: objOop
+
+ ^ self isSweeping and: [objOop >= compactor currentObject]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>sweepersCurrentSweepingEntity (in category 'as yet unclassified') -----
+ sweepersCurrentSweepingEntity
+
+ ^ compactor currentObject!
Item was added:
+ SpurCompactor subclass: #SpurIncrementalCompactingSweeper
+ instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer'
+ classVariableNames: 'MaxObjectsToFree MaxOccupationForCompaction'
+ poolDictionaries: ''
+ category: 'VMMaker-SpurGarbageCollector'!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>declareCVarsIn: (in category 'as yet unclassified') -----
+ declareCVarsIn: aCCodeGenerator
+
+ aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'.
+
+ SpurMemoryManager wantsIncrementalGC
+ ifTrue: [
+ (self selectors intersection: SpurPlanningCompactor selectors)
+ do: [:key |
+ aCCodeGenerator
+ staticallyResolveMethodNamed: key
+ forClass: self
+ to: (self staticallyResolvePolymorphicSelector: key)]]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>hasPolymorphicSelectors (in category 'as yet unclassified') -----
+ hasPolymorphicSelectors
+ "when using the incremental gc we have polymorphic selectors and have to resolve them"
+
+ ^ SpurMemoryManager wantsIncrementalGC!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ super initialize.
+ "If the segment is occupied by more than MaxOccupationForCompaction,
+ it's not worth compacting it, whatever the rest of the system looks like.
+ MaxOccupationForCompaction is included in [0;16rFFFF]."
+ MaxOccupationForCompaction := 16rD000. "81%"
+ MaxObjectsToFree := 100000!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
+
+ | intersection |
+ intersection := (self selectors intersection: SpurPlanningCompactor selectors).
+
+ ^ (intersection includes: aSelectorSymbol)
+ ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
+ ifFalse: [aSelectorSymbol]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>advanceSegment (in category 'sweep and compact') -----
+ advanceSegment
+
+ self assert: (manager isSegmentBridge: currentObject).
+ currentSegmentsIndex := currentSegmentsIndex + 1.
+
+ self flag: #Todo. "is this ever false? Mhh, investigate"
+ currentSegmentsIndex < manager segmentManager numSegments
+ ifTrue: [currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex].
+
+ currentObject := self nextCurrentObject
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>assertNoSegmentBeingCompacted (in category 'as yet unclassified') -----
+ assertNoSegmentBeingCompacted
+ "Assertion only - no segment is being claimed at this point. All being compacted bits get cleared during sweeping when setting the occupation of the segments"
+ | segInfo |
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 0 to: manager numSegments - 1 do:
+ [:i|
+ segInfo := manager segInfoAt: i.
+ self deny: (self isSegmentBeingCompacted: segInfo).
+ (self isSegmentBeingCompacted: segInfo)
+ ifTrue: [self cCode: 'raise(SIGINT)']].!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>biasForGC (in category 'api') -----
+ biasForGC!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>biasForSnapshot (in category 'api') -----
+ biasForSnapshot!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>canUseAsFreeSpace: (in category 'testing') -----
+ canUseAsFreeSpace: objOop
+
+ <inline: true>
+ ^ (manager isFreeObject: objOop) or: [(manager isMarked: objOop) not]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>cannotBeCompacted: (in category 'testing') -----
+ cannotBeCompacted: segInfo
+
+ ^ (self isSegmentBeingCompacted: segInfo)
+ or: [segInfo containsPinned
+ or: [manager segmentManager isEmptySegment: segInfo]]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>cautiousBulkFreeChunkFrom: (in category 'incremental sweeping') -----
+ cautiousBulkFreeChunkFrom: objOop
+ "The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
+ from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
+ | bytes start next currentObj |
+ self assert: (self canUseAsFreeSpace: objOop).
+
+ start := manager startOfObject: objOop.
+ currentObj := objOop.
+ bytes := 0.
+
+ [bytes := bytes + (manager bytesInBody: currentObj).
+ (manager isRemembered: currentObj)
+ ifTrue:
+ [self assert: (manager isFreeObject: currentObj) not.
+ scavenger forgetObject: currentObj].
+
+ (manager isFreeObject: currentObj)
+ ifTrue: [ "we need to unlink chunks for concurrent sweeping. In the stop the world sweeper we can just reset the freeLists but here we need to keep them
+ around so the mutator can still work between sweeping passes"
+
+ self flag: #Todo. "we want to optimize for lilliputian chunks!! For now it is ok(ish) but we have to do something about it.
+ At the moment I see 3 possibilities:
+ - have the lilliputian list always sorted (O(n) insert in the worst case!!)
+ - sort the lilliputian part before sweeping (O(n log n) at the start. but everytime before sweeping)
+ - be cheeky and discard the lilliputian list (problem: the mutator has no access to the list + it can insert unsorted chunks (for the duration of sweeping we could let it use a second list and just append it after sweeping)"
+ manager detachFreeObject: currentObj.
+ "self assert: manager totalFreeOldSpace = manager totalFreeListBytes."].
+
+
+ next := manager objectStartingAt: start + bytes.
+ currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.
+ self assert: ((manager oop: next isLessThan: manager endOfMemory)
+ or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
+
+ "should the next object not be usable as free space (because it is marked) abort the loop. Attention:
+ briges at the end of segments are marked and therefore we leave the loop here. This is important as the
+ newly created free space segment should not be bigger than there still is space left in the current segment"
+ (self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]]
+ whileTrue: [currentObj := next].
+
+ ^ manager addFreeChunkWithBytes: bytes at: start!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>compactSegment:freeStart:segIndex: (in category 'incremental compact') -----
+ compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+
+ | fillStart |
+ fillStart := initialFreeStart.
+
+ self deny: segIndex = 0. "Cannot compact seg 0"
+ manager segmentManager
+ allEntitiesInSegment: segInfo
+ exceptTheLastBridgeDo:
+ [:entity |
+ (manager isFreeObject: entity)
+ ifTrue:
+ [manager detachFreeObject: entity.
+ "To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
+ manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
+ ifFalse:
+ [ (manager isMarked: entity)
+ ifTrue: [manager makeWhite: entity.
+ "During the mutator runs new forwarding references can be created. Ignore them as they get resolved with the other
+ forwarders in this segment in the next marking pass"
+ (manager isForwarded: entity)
+ ifFalse:[| bytesToCopy |
+ "Copy the object in segmentToFill and replace it by a forwarder."
+ bytesToCopy := manager bytesInBody: entity.
+
+ (self oop: fillStart + bytesToCopy isLessThan: (segmentToFill segLimit - manager bridgeSize))
+ ifFalse: ["somebody allocated a new object we did not knew about at the moment of planning :( -> it does not fit anymore and we cannot free the whole segment. Make sure to unmark the segment as beeing compacted as it would be completetly freed otherwise!!"
+ coInterpreter cr; print: 'segments if full. Abort compacting of: '; printHex: segmentToFill segStart ; tab; flush.
+ self unmarkSegmentAsBeingCompacted: (manager segInfoAt: currentSegmentsIndex).
+
+ "we need to sweep the rest of the segment. As the segment is not marked to be compacted anymore sweepOrCompactFromCurrentObject will decide to sweep it. We want to start sweeping from the current entity, therefore setting currentObject to it and
+ we have to protect it from beeing freed (with marking it) as it was marked previously and after us unmarking it here would
+ get collected incorrectly"
+ manager setIsMarkedOf: entity to: true.
+ currentObject := entity.
+
+ ^ fillStart].
+
+ self migrate: entity sized: bytesToCopy to: fillStart.
+
+ fillStart := fillStart + bytesToCopy.
+ self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]
+ ifFalse: [
+ (manager isRemembered: entity)
+ ifTrue:
+ [self assert: (manager isFreeObject: entity) not.
+ scavenger forgetObject: entity].
+
+ "To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
+ manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]]].
+
+ "we want to advance to the next segment from the bridge"
+ currentObject := currentSegmentsBridge.
+ ^ fillStart!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>computeSegmentsToCompact (in category 'compaction planning') -----
+ computeSegmentsToCompact
+ "Compute segments to compact: least occupied.
+ Answers true if compaction should be done
+ (at least 1 segment is being compacted and
+ there is a segment to compact into)."
+ | canStillClaim aboutToClaim aboutToClaimSegment atLeastOneSegmentToCompact |
+ <var: 'aboutToClaimSegment' type: #'SpurSegmentInfo *'>
+ atLeastOneSegmentToCompact := false.
+ aboutToClaimSegment := self findNextSegmentToCompact.
+ "Segment to fill is one of the segment compacted last GC.
+ If no segment were compacted last GC, and that there is
+ at least one segment to compact, allocate a new one."
+ aboutToClaimSegment ifNil: [^false].
+ segmentToFill ifNil:
+ [self findOrAllocateSegmentToFill.
+ segmentToFill ifNil: ["Abort compaction"^false]].
+ canStillClaim := segmentToFill segSize - manager bridgeSize.
+ [aboutToClaimSegment ifNil: [^atLeastOneSegmentToCompact].
+ aboutToClaim := self sizeClaimedIn: aboutToClaimSegment.
+ aboutToClaim < canStillClaim ] whileTrue:
+ [self markSegmentAsBeingCompacted: aboutToClaimSegment.
+
+ coInterpreter cr;
+ print: 'about to compact segment from: '; printHex: aboutToClaimSegment segStart;
+ print: ' to: '; printHex: aboutToClaimSegment segStart + aboutToClaimSegment segSize ;tab; flush.
+
+ atLeastOneSegmentToCompact := true.
+ canStillClaim := canStillClaim - aboutToClaim.
+ aboutToClaimSegment := self findNextSegmentToCompact].
+ ^atLeastOneSegmentToCompact!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>currentObject (in category 'accessing') -----
+ currentObject
+
+ <cmacro: '() GIV(currentObject)'>
+ ^ currentObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>doIncrementalCompact (in category 'incremental compact') -----
+ doIncrementalCompact
+
+ | segInfo |
+ segInfo := manager segInfoAt: currentSegmentsIndex.
+
+ self assert: segInfo ~= segmentToFill.
+ self assert: (self isSegmentBeingCompacted: segInfo).
+
+ coInterpreter cr;
+ print: 'Compact from: '; printHex: segInfo segStart;
+ print: ' to: '; printHex: segInfo segStart + segInfo segSize;
+ print: ' into: ' ; printHex: segmentToFill segStart; tab; flush.
+
+ currentCopyToPointer := self compactSegment: segInfo freeStart: currentCopyToPointer segIndex: currentSegmentsIndex.
+ self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
+ self assert: (self oop: currentCopyToPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)).
+
+ "guarantee heap parsability for the segmentToFill, for example when invoking checkHeapFreeSpaceIntegrityForIncrementalGC where we walk to whole heap and could enter segmentToFill in an invalid state"
+ self occupyRestOfFreeCompactedIntoSegment.
+
+ coInterpreter cr;
+ print: 'Pointer now: '; printHex: currentCopyToPointer; tab; flush.
+
+ self postCompactionAction!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>doIncrementalSweep (in category 'incremental sweeping') -----
+ doIncrementalSweep
+
+ self assert: (self addressOf: (manager segmentManager segments at: currentSegmentsIndex)) ~= segmentToFill.
+
+ (self canUseAsFreeSpace: currentObject)
+ ifTrue: [currentObject := self cautiousBulkFreeChunkFrom: currentObject]
+ ifFalse: [self unmarkCurrentObject]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>doincrementalSweepAndCompact (in category 'sweep and compact') -----
+ doincrementalSweepAndCompact
+
+ "Scan the heap for unmarked objects and free them. Coalescence "
+ self assert: currentObject notNil.
+
+ currentsCycleSeenObjectCount := 0.
+
+ [self oop: currentObject isLessThan: manager endOfMemory] whileTrue:
+ [ currentObject = currentSegmentsBridge
+ ifTrue: [self advanceSegment]
+ ifFalse: [self sweepOrCompactFromCurrentObject].
+
+ currentsCycleSeenObjectCount >= MaxObjectsToFree
+ ifTrue: [^ false]].
+
+ "set occupation for last segment"
+ manager checkFreeSpace: GCModeIncremental.
+ ^ true!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>findAndSetSegmentToFill (in category 'segment to fill') -----
+ findAndSetSegmentToFill
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ | segInfo |
+ 0 to: manager numSegments - 1
+ do: [:i |
+ segInfo := manager segInfoAt: i.
+ (self segmentIsEmpty: segInfo)
+ ifTrue: [segmentToFill := segInfo.
+ ^ i]].
+
+ ^ -1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>findNextSegmentToCompact (in category 'compaction planning') -----
+ findNextSegmentToCompact
+ "Answers the next segment to compact or nil if none.
+ The next segment to compact:
+ - cannot be segment 0 (Segment 0 has specific objects
+ (nil, true, etc.) and special size computed at start-up
+ that we don't want to deal with)
+ - cannot have a high occupation rate (> MaxOccupationForCompaction)"
+ | leastOccupied leastOccupiedSegment tempOccupied segInfo |
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ leastOccupied := 1.
+ 1 to: manager numSegments - 1 do:
+ [:i|
+ segInfo := manager segInfoAt: i.
+ (self cannotBeCompacted: segInfo)
+ ifFalse:
+ [(tempOccupied := self occupationOf: segInfo) <= leastOccupied
+ ifTrue: [ leastOccupied := tempOccupied.
+ leastOccupiedSegment := segInfo ]]].
+ leastOccupied > MaxOccupationForCompaction ifTrue:
+ [^self cCoerceSimple: nil to: #'SpurSegmentInfo *'].
+ ^leastOccupiedSegment!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>findOrAllocateSegmentToFill (in category 'segment to fill') -----
+ findOrAllocateSegmentToFill
+ "There was no compacted segments from past GC that we can directly re-use.
+ We need either to find an empty segment or allocate a new one."
+ | segIndex |
+ "segment was already set from freePastSegmentsAndSetSegmentToFill at the end of the last markingpass. No need to do something. "
+ segmentToFill ifNotNil: [^0].
+
+ self findAndSetSegmentToFill.
+ segmentToFill ifNotNil: [self reserveSegmentToFill. ^0].
+
+ "No empty segment. We need to allocate a new one"
+ (manager growOldSpaceByAtLeast: manager growHeadroom) ifNil: ["failed to allocate"^0].
+
+ "We don't know which segment it is that we've just allocated... So we look for it... This is a bit dumb."
+ segIndex := self findAndSetSegmentToFill.
+ self assert: segmentToFill ~~ nil.
+ self reserveSegmentToFill!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>finishSweepAndCompact (in category 'sweep and compact') -----
+ finishSweepAndCompact
+
+ self assert: manager allObjectsWhite.
+ self reset.
+ self flag: #Todo. "update time needed for gc"!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>freePastSegmentsAndSetSegmentToFill (in category 'public') -----
+ freePastSegmentsAndSetSegmentToFill
+
+ "The first segment being claimed met becomes the segmentToFill. The others are just freed."
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 0 to: manager numSegments - 1 do:
+ [:i| | segInfo |
+ segInfo := manager segInfoAt: i.
+ (self isSegmentBeingCompacted: segInfo) ifTrue:
+ [ | freeChunk chunkBytes |
+ self assert: (manager segmentManager allObjectsAreForwardedInSegment: segInfo includingFreeSpace: false).
+ self assert: (manager noElementOfFreeSpaceIsInSegment: segInfo).
+
+ coInterpreter
+ cr; print: 'freeing segment from: '; printHex: segInfo segStart;
+ print: ' to: '; printHex: segInfo segStart + segInfo segSize ;tab; flush.
+
+ chunkBytes := segInfo segSize - manager bridgeSize.
+ freeChunk := manager
+ addFreeChunkWithBytes: chunkBytes
+ at: segInfo segStart.
+
+ self unmarkSegmentAsBeingCompacted: segInfo.
+
+ segmentToFill ifNil:
+ [manager detachFreeObject: freeChunk.
+ segmentToFill := segInfo]]]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'public') -----
+ incrementalSweepAndCompact
+
+ self initIfNecessary.
+
+ self assert: manager validObjectColors.
+
+ self doincrementalSweepAndCompact
+ ifTrue: [self finishSweepAndCompact.
+ ^ true].
+
+ coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush.
+
+ ^ false!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initForCompaction (in category 'state initialization') -----
+ initForCompaction
+
+ self assertNoSegmentBeingCompacted.
+ self planCompactionAndReserveSpace.
+
+ self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
+
+ shouldCompact
+ ifTrue: [currentCopyToPointer := segmentToFill segStart].!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initForSweeping (in category 'state initialization') -----
+ initForSweeping
+
+ currentSegmentsIndex := 0.
+ currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
+
+ currentObject := manager firstObject.!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initIfNecessary (in category 'state initialization') -----
+ initIfNecessary
+
+ isCurrentlyWorking
+ ifFalse: [
+ self initForSweeping.
+ self initForCompaction.
+
+ isCurrentlyWorking := true]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initialize (in category 'initialize-release') -----
+ initialize
+
+ isCurrentlyWorking := false.
+ currentSegmentsIndex := 0.
+ currentsCycleSeenObjectCount := 0.
+ currentSegmentsBridge := nil.
+ currentObject := nil.
+ segmentToFill := nil.
+ shouldCompact := false.
+ currentCopyToPointer := nil!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>isMobile: (in category 'as yet unclassified') -----
+ isMobile: obj
+
+ <inline: true>
+ self flag: #Todo. "investigate this one here"
+ ^ (manager isPinned: obj) not!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>isSegmentAtIndexBeingCompacted: (in category 'testing') -----
+ isSegmentAtIndexBeingCompacted: segIndex
+
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ ^ (manager segInfoAt: segIndex) swizzle = 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>isSegmentBeingCompacted: (in category 'testing') -----
+ isSegmentBeingCompacted: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ ^ segInfo swizzle = 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>markSegmentAsBeingCompacted: (in category 'segment access') -----
+ markSegmentAsBeingCompacted: segInfo
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ self assert: (manager numSegments > 1 and: [segInfo ~= (self addressOf: (manager segmentManager segments at: 0))]).
+ segInfo swizzle: 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>migrate:sized:to: (in category 'incremental compact') -----
+ migrate: obj sized: bytesToCopy to: address
+
+ | copy |
+ self assert: (manager isPinned: obj) not.
+
+ manager memcpy: address asVoidPointer _: (manager startOfObject: obj) asVoidPointer _: bytesToCopy.
+
+ copy := manager objectStartingAt: address.
+ (manager isRemembered: copy) ifTrue:
+ ["copy has the remembered bit set, but is not in the remembered table."
+ manager setIsRememberedOf: copy to: false.
+ scavenger remember: copy].
+
+ manager forward: obj to: (manager objectStartingAt: address).
+
+ ^ copy!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>nextCurrentObject (in category 'sweep and compact') -----
+ nextCurrentObject
+
+ | nextObject |
+ nextObject := manager objectAfter: currentObject limit: manager endOfMemory.
+
+ (segmentToFill notNil and: [manager segmentManager is: nextObject inSegment: segmentToFill])
+ ifTrue: [
+ "skip the reserved segment. Return the bridge so we go into advanceSegment"
+ nextObject := manager segmentManager bridgeFor: segmentToFill].
+
+ ^ nextObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>occupationOf: (in category 'segment access') -----
+ occupationOf: segInfo
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "lastFreeObject is abused to save the claimed memory for the given segment"
+
+ ^ segInfo lastFreeObject asFloat / segInfo segSize!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>occupyRestOfFreeCompactedIntoSegment (in category 'incremental compact') -----
+ occupyRestOfFreeCompactedIntoSegment
+
+ manager
+ initFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentCopyToPointer
+ at: currentCopyToPointer.
+
+ "avoid confusing spur, especially for leak checks"
+ manager
+ set: (manager objectStartingAt: currentCopyToPointer)
+ classIndexTo: manager wordSizeClassIndexPun
+ formatTo: manager wordIndexableFormat!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>planCompactionAndReserveSpace (in category 'compaction planning') -----
+ planCompactionAndReserveSpace
+
+ shouldCompact := self computeSegmentsToCompact
+
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>postCompactionAction (in category 'incremental compact') -----
+ postCompactionAction
+
+ | allFlags |
+ "For now we don't optimize and just follow everything everywhere on stack and in caches, let's see in the profiler if we need to optimize with those cases. My guess is that this is < 100 microSecond"
+ manager followSpecialObjectsOop.
+ allFlags := BecamePointerObjectFlag + BecameActiveClassFlag bitOr: BecameCompiledMethodFlag.
+ "Note: there is not the OldBecameNewFlag"
+ "gcMode flag is cleared after postBecomeAction, reset it."
+ manager coInterpreter postBecomeAction: allFlags.
+ manager coInterpreter setGCMode: GCModeFull.
+
+ "Special to selective, crazy objects can be forwarded..."
+ "manager postBecomeScanClassTable: allFlags. => Done in followClassTable"
+ manager followClassTable.
+ manager followProcessList.
+ manager followForwardedObjStacks.
+
+ "Not sure the following are needed...
+ coInterpreter mapInterpreterOops.
+ manager mapExtraRoots."
+ self assert: manager validClassTableHashes.!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>postSwizzleAction (in category 'public') -----
+ postSwizzleAction
+ "Since the compact abuses the swizzle field of segment, it needs to be reset after start-up."
+
+ | segInfo |
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 0 to: manager numSegments - 1 do:
+ [:i|
+ segInfo := manager segInfoAt: i.
+ segInfo swizzle: 0 ]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>remapObj: (in category 'api') -----
+ remapObj: objOop
+ "Scavenge or simply follow objOop. Answer the new location of objOop.
+ The send should have been guarded by a send of shouldRemapOop:.
+ The method is called remapObj: for compatibility with ObjectMemory."
+ <api>
+ <inline: false>
+ ^manager slidingCompactionRemapObj: objOop!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>reserveSegmentToFill (in category 'segment access') -----
+ reserveSegmentToFill
+ "remove the free space from the freeLists so the mutator cannot allocate in this segment"
+
+ | freeChunk |
+ self assert: segmentToFill notNil.
+ self assert: (self segmentIsEmpty: segmentToFill).
+
+ freeChunk := manager objectStartingAt: segmentToFill segStart.
+ manager detachFreeObject: freeChunk!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>reset (in category 'sweep and compact') -----
+ reset
+
+ self setFreeChunkOfCompactedIntoSegment.
+
+ isCurrentlyWorking := false.
+ shouldCompact := false.
+ currentCopyToPointer := 0.
+ currentSegmentsIndex := 0.
+ currentObject := 0.
+ currentSegmentsIndex := nil.
+ currentsCycleSeenObjectCount := 0!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>segmentIsEmpty: (in category 'testing') -----
+ segmentIsEmpty: segInfo
+ "a free segment contains only a free chunk and a bridge (every segment ends in one of these)"
+
+ ^ manager segmentManager isEmptySegment: segInfo!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>segmentToFill (in category 'accessing') -----
+ segmentToFill
+
+ <cmacro: '() GIV(segmentToFill)'>
+ ^ segmentToFill!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>setFreeChunkOfCompactedIntoSegment (in category 'incremental compact') -----
+ setFreeChunkOfCompactedIntoSegment
+
+ shouldCompact ifFalse: [^ self].
+
+ self assert: segmentToFill notNil.
+ self assert: (self oop: currentCopyToPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)).
+
+ manager
+ addFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentCopyToPointer
+ at: currentCopyToPointer.
+
+ "we have compacted into segmentToFill. It is now not empty anymore and we need to look for a new one"
+ segmentToFill := nil
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>setInitialSweepingEntity (in category 'as yet unclassified') -----
+ setInitialSweepingEntity
+
+ currentObject := manager firstObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>setSegmentToFillToAddress: (in category 'segment to fill') -----
+ setSegmentToFillToAddress: segInfo
+ "part of canReactToShiftSegment:to:. We cannot make any assertions, as the segment still has to be moved in the segments array
+ and right at this moment we do not point to the right address, but we will in a moment (see removeSegment: and canReactToShiftSegment:to: or insertSegmentFor: that brings us to this method to understand better)"
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ segmentToFill := segInfo!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>shouldCompactCurrentSegment (in category 'sweep and compact') -----
+ shouldCompactCurrentSegment
+
+ | currentSegment |
+ shouldCompact ifFalse: [^ false].
+
+ currentSegment := (manager segInfoAt: currentSegmentsIndex).
+ ^ self isSegmentBeingCompacted: currentSegment!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>shouldRemapObj: (in category 'api') -----
+ shouldRemapObj: objOop
+ "Answer if the obj should be scavenged, or simply followed. Sent via the compactor
+ from shouldRemapObj:. We test for being already scavenged because mapStackPages
+ via mapInterpreterOops may be applied twice in the context of a global GC where a
+ scavenge, followed by a scan-mark-free, and final compaction passes may result in
+ scavenged fields being visited twice."
+ <api>
+ <inline: false>
+ ^manager slidingCompactionShouldRemapObj: objOop!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>sizeClaimedIn: (in category 'as yet unclassified') -----
+ sizeClaimedIn: segment
+ <var: 'segment' type: #'SpurSegmentInfo *'>
+
+ ^ segment lastFreeObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>sweepOrCompactFromCurrentObject (in category 'sweep and compact') -----
+ sweepOrCompactFromCurrentObject
+
+ self shouldCompactCurrentSegment
+ ifTrue: [self doIncrementalCompact.
+
+ "either we finished compacting the segment or we had to abort compaction as the segment to fill cannot take more objects from this segment. We have to continue sweeping. This is done by unmarking the current segment as beeing compacted and making sure the last object we nearly copied before (and we know was alive after marking) is kept alive for sweeping"
+ self assert: ((manager isSegmentBridge: currentObject)
+ or: [(manager isMarked: currentObject) and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]])]
+ ifFalse: [self doIncrementalSweep.
+ currentObject := self nextCurrentObject]
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>unmark: (in category 'incremental sweeping') -----
+ unmark: objOop
+
+ self assert: ((manager isMarked: objOop) and: [(manager isFreeObject: objOop) not]).
+
+ (manager isSegmentBridge: objOop)
+ ifFalse: [manager
+ setIsMarkedOf: objOop to: false;
+ setIsGreyOf: objOop to: false].
+
+ (manager isPinned: objOop)
+ ifTrue: [manager segmentManager notePinned: objOop]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>unmarkCurrentObject (in category 'incremental sweeping') -----
+ unmarkCurrentObject
+
+ self unmark: currentObject.
+ currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>unmarkSegmentAsBeingCompacted: (in category 'segment access') -----
+ unmarkSegmentAsBeingCompacted: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ segInfo swizzle: 0!
Item was changed:
----- Method: SpurIncrementalGarbageCollector class>>classesForTranslation (in category 'translation') -----
classesForTranslation
+ ^ super classesForTranslation , self markerClassesForTranslation , {SpurStopTheWorldGarbageCollector} , self sweeperAndCompactorClassesForTranslation!
- ^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurStopTheWorldGarbageCollector . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }!
Item was changed:
----- Method: SpurIncrementalGarbageCollector class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
super declareCVarsIn: aCCodeGenerator.
aCCodeGenerator
var: 'phase' declareC: 'sqInt phase = 0';
var: 'checkSetGCFlags' declareC: 'sqInt checkSetGCFlags = 1'.
aCCodeGenerator
staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker in: self.
+
+ SpurMemoryManager gcClass = self
+ ifTrue: [
+ self declareRecursivePolymorphismMappingForIncrementalClasses: aCCodeGenerator.
+
+ "just important when doiing incremental compaction, therefore doin it here"
+ aCCodeGenerator
+ forRecursivePolymorphismResolve: SpurAllAtOnceMarker as: SpurStopTheWorldGarbageCollector;
+ forRecursivePolymorphismResolve: SpurPlanningCompactor as: SpurStopTheWorldGarbageCollector].
+ !
- aCCodeGenerator
- forRecursivePolymorphismResolve: SpurIncrementalMarker as: self;
- forRecursivePolymorphismResolve: SpurIncrementalCompactor as: self;
- forRecursivePolymorphismResolve: SpurIncrementalSweepAndCompact as: self;
- forRecursivePolymorphismResolve: SpurIncrementalSweeper as: self.
-
- "just important when doiing incremental compaction, therefore doin it here"
- aCCodeGenerator
- forRecursivePolymorphismResolve: SpurAllAtOnceMarker as: SpurStopTheWorldGarbageCollector;
- forRecursivePolymorphismResolve: SpurPlanningCompactor as: SpurStopTheWorldGarbageCollector!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector class>>declareRecursivePolymorphismMappingForIncrementalClasses: (in category 'nil') -----
+ declareRecursivePolymorphismMappingForIncrementalClasses: aCCodeGenerator
+
+ aCCodeGenerator
+ forRecursivePolymorphismResolve: SpurIncrementalMarker as: self;
+ forRecursivePolymorphismResolve: SpurIncrementalCompactor as: self;
+ forRecursivePolymorphismResolve: SpurIncrementalSweepAndCompact as: self;
+ forRecursivePolymorphismResolve: SpurIncrementalSweeper as: self.!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector class>>markerClassesForTranslation (in category 'translation') -----
+ markerClassesForTranslation
+
+ ^ {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker}!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector class>>sweeperAndCompactorClassesForTranslation (in category 'translation') -----
+ sweeperAndCompactorClassesForTranslation
+
+ ^ {SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact}!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
assertSettingGCFlagsIsOk: objOop
checkSetGCFlags ifFalse: [^ self].
"do not color young objects. They have an extra state we do not want to change"
self assert: (manager isOldObject: objOop).
(manager isOldObject: objOop)
ifFalse: [self cCode: 'raise(SIGINT)'].
"while sweeping: do not color objects behind the currently point the sweeper is at. This would infer with the next marking pass"
+ self assert: (self allocatorShouldAllocateBlack not or: [self inSweepingAheadOfSweepersPosition: objOop]).
- self assert: (self allocatorShouldAllocateBlack not or: [objOop >= self compactor currentSweepingEntity]).
+ (self allocatorShouldAllocateBlack not or: [self inSweepingAheadOfSweepersPosition: objOop])
- (self allocatorShouldAllocateBlack not or: [objOop >= self compactor currentSweepingEntity])
ifFalse: [self cCode: 'raise(SIGINT)']!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
| startTime |
phase = InMarkingPhase
ifTrue: [ | finishedMarking |
marker isCurrentlyMarking
ifFalse: [self assert: manager allObjectsUnmarked].
coInterpreter cr; print: 'start marking '; tab; flush.
finishedMarking := marker incrementalMarkObjects.
"self assert: manager validObjectColors."
finishedMarking
ifTrue: [
manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
We only know if they should get swept after the next marking -> keep them alive for this cycle"
self allocatorShouldAllocateBlack: true.
compactor setInitialSweepingEntity.
phase := InSweepingPhase.
"marking is done and thus all forwarding from the last compaction references are resolved
-> we can use the now free segments that were compacted during the last cycle"
compactor freePastSegmentsAndSetSegmentToFill.
self assert: manager noObjectGrey.
coInterpreter cr; print: 'finish marking '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
-
+ 0 to: manager numSegments - 1
+ do: [:i | | segInfo |
+ segInfo := manager segInfoAt: i.
+ coInterpreter cr; print: 'occupation from marking: '; printNum: (segInfo lastFreeObject asFloat / segInfo segSize) * 100; tab; flush].
+
^ self]
ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
phase = InSweepingPhase
ifTrue: [
coInterpreter cr; print: 'start sweeping '; tab; flush.
compactor incrementalSweep
ifTrue: [
self allocatorShouldAllocateBlack: false.
manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
"self assert: manager allObjectsUnmarked."
coInterpreter cr; print: 'finish sweeping '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
compactor assertNoSegmentBeingCompacted.
phase := InCompactingPhase.
^ self]].
phase = InCompactingPhase
ifTrue: [
"self cCode: 'raise(SIGINT)'."
coInterpreter cr; print: 'start compacting '; tab; flush.
+ "compactor isCurrentlyCompacting
+ ifFalse: [manager printFreeSpaceStatistics]."
- compactor isCurrentlyCompacting
- ifFalse: [manager printFreeSpaceStatistics].
compactor incrementalCompact
ifTrue: [
coInterpreter cr; print: 'finish compacting '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
phase := InMarkingPhase.
^ self]]!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') -----
isOkToScavengeRememberedObject: objOop
"When sweeping we can alreay have freed an object A that is referenced by B. If B is behind the sweepers
position and not marked it is garbage and to be collected. Yet B is still in the remembered set and will get
scanned, during which the freed object will be visited an an error caused. Use this check to prevent this"
+ ^ ((self inSweepingAheadOfSweepersPosition: objOop)
+ and: [(manager isMarked: objOop) not]) not!
- ^ (phase = InSweepingPhase
- and: [objOop >= compactor currentSweepingEntity
- and: [(manager isMarked: objOop) not]]) not!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>maybeModifyForwarder: (in category 'object creation barriers') -----
maybeModifyForwarder: objOop
"mark forwarders so they do not get garbage collected before they can get resolved.
1. Does only apply to marking because only in this phase we can overlook forwarding references to be resolved (e.g. when
the mutator runs after the first marking pass and an object that is referenced by at least one already black object gets a forwarded -> the pointer of the black object won't get updated in this marking pass and during sweeping the forwarding pointer will get removed).
2. Does not apply to sweeping or compacting because the forwarder is set on the header of the original object, which already includes
the correcty set mark bit"
self assert: (manager isForwarded: objOop).
((manager isOldObject: objOop) and: [marker isCurrentlyMarking])
+ ifTrue: [marker setIsMarkedOf: objOop]!
- ifTrue: [manager setIsMarkedOf: objOop to: true]!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>sweepersCurrentSweepingEntity (in category 'as yet unclassified') -----
+ sweepersCurrentSweepingEntity
+
+ ^ compactor sweeper currentSweepingEntity!
Item was changed:
SpurMarker subclass: #SpurIncrementalMarker
instanceVariableNames: 'isCurrentlyMarking'
classVariableNames: 'SlotLimitPerPass'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+ !SpurIncrementalMarker commentStamp: 'WoC 1/4/2023 00:21' prior: 0!
+ Marker for the SpurIncrementalGarbageCollector. It is concipated to mark objects in old space (and only in old space!!) while beeing able to be interrupted
- !SpurIncrementalMarker commentStamp: 'WoC 12/2/2022 23:39' prior: 0!
- Marker for the SpurIncrementalGarbageCollector.
Roots are:
- Stack references
- hidden objects
- extra objects
- young space objects
Instance Variables
isCurrentlyMarking: <Object>
isCurrentlyMarking
- xxxxx
!
Item was changed:
----- Method: SpurIncrementalMarker>>blackenObject: (in category 'as yet unclassified') -----
blackenObject: obj
self flag: #Todo. "do we need to ungrey the object or can we save the call? Idea:
-> if grey set -> grey
-> if mark set -> ignore grey, interpret it as black"
manager setIsGreyOf: obj to: false.
+ self setIsMarkedOf: obj!
- manager setIsMarkedOf: obj to: true!
Item was changed:
----- Method: SpurIncrementalMarker>>incrementalMark (in category 'marking - incremental') -----
incrementalMark
"does one marking cycle. Breaks after a certain amount of slots is marked and the last object, that amount is crossed in, is completely scanned"
| currentObj slotsLeft |
"manager objStack: manager markStack do: [:index :page | Transcript showln: (manager fetchPointer: index ofObject: page)].
manager sizeOfObjStack: manager markStack"
currentObj := manager popObjStack: manager markStack.
"skip young objects. They get already scanned as they are part of the roots"
[(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]]
+ whileTrue: [(manager isInClassTable: currentObj) ifTrue: [self setIsMarkedOf: currentObj ].
- whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true].
currentObj := manager popObjStack: manager markStack].
currentObj
ifNil: [^ true]. "there is nothing more on the stack and we are done"
slotsLeft := SlotLimitPerPass.
[
| slotNumber slotsToVisit startIndex |
"after passing the limit we push the current index on the stack. Is the currentObj only an index? "
(manager isImmediate: currentObj)
ifTrue: [startIndex := manager integerValueOf: currentObj.
currentObj := manager popObjStack: manager markStack.]
ifFalse: [startIndex := 0.
self assert: (manager isFreeObject: currentObj) not.
(manager isForwarded: currentObj)
ifTrue: [currentObj := manager followForwarded: currentObj].
self assert: (manager isYoung: currentObj) not.
self markAndTraceClassOf: currentObj.
"eager color the object black. Either it will get scanned completely and the color is correct
or we have at least scanned some of the slots. In the second case the mutator could
modify one of the slots of the object that already were scanned and we would could lose
this object. Therefore color the object early to trigger the write barrier on writes. There will
be some overhead (trigger the barrier always although only the already scanned slots are
technically black) but it seems we need to do this for correctness"
self blackenObject: currentObj].
slotNumber := manager numStrongSlotsOfInephemeral: currentObj.
slotsToVisit := slotNumber - startIndex.
slotsLeft - slotsToVisit < 0
ifTrue: [ | countThatCanBeVisited |
countThatCanBeVisited := slotsToVisit - slotsLeft.
self
markFrom: startIndex
nSlots: countThatCanBeVisited
of: currentObj.
"If we need to abort earlier we push the index and the currently scanned object on the marking stack. Otherwise it is not possible
for immediates to be on the stack (they have no fields to be scanned) -> we can use the immediated to detect this pattern"
(manager topOfObjStack: manager markStack) ~= currentObj ifTrue:
[manager push: currentObj onObjStack: manager markStack].
manager
push: (manager integerObjectOf: startIndex + countThatCanBeVisited)
onObjStack: manager markStack.
"we need to abort early to not run into some extreme corner cases (giant objects) that would explode our mark time assumptions"
^ false]
ifFalse: ["we can mark all"
slotsLeft := slotsLeft - slotsToVisit.
self markFrom: startIndex nSlots: slotsToVisit of: currentObj].
currentObj := manager popObjStack: manager markStack.
[(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]]
+ whileTrue: [(manager isInClassTable: currentObj) ifTrue: [self setIsMarkedOf: currentObj].
- whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true].
currentObj := manager popObjStack: manager markStack].
"repeat while there still are objects"
currentObj notNil] whileTrue.
^ true!
Item was changed:
----- Method: SpurIncrementalMarker>>incrementalMarkFrom: (in category 'marking - incremental') -----
incrementalMarkFrom: objOop
"does one marking cycle. Breaks after a certain amount of slots is marked and the last object, that amount is crossed in, is completely scanned"
| currentObj slotsLeft |
"manager objStack: manager markStack do: [:index :page | Transcript showln: (manager fetchPointer: index ofObject: page)].
manager sizeOfObjStack: manager markStack"
currentObj := objOop.
currentObj
ifNil: [^ true]. "there is nothing more on the stack and we are done"
slotsLeft := SlotLimitPerPass.
[
| slotNumber slotsToVisit startIndex |
"after passing the limit we push the current index on the stack. Is the currentObj only an index? "
(manager isImmediate: currentObj)
ifTrue: [startIndex := manager integerValueOf: currentObj.
currentObj := manager popObjStack: manager markStack.]
ifFalse: [startIndex := 0].
((manager isYoung: currentObj) and: [manager isInClassTable: currentObj])
+ ifTrue: [self setIsMarkedOf: currentObj].
- ifTrue: [manager setIsMarkedOf: currentObj to: true].
slotNumber := manager numStrongSlotsOfInephemeral: currentObj.
slotsToVisit := slotNumber - startIndex.
slotsLeft - slotsToVisit < 0
ifTrue: [
self
markFrom: startIndex
nSlots: slotsLeft
of: currentObj.
"If we need to abort earlier we push the index and the currently scanned object on the marking stack. Otherwise it is not possible
for immediates to be on the stack (they have no fields to be scanned) -> we can use the immediated to detect this pattern"
(manager topOfObjStack: manager markStack) ~= currentObj ifTrue:
[manager push: currentObj onObjStack: manager markStack].
manager push: (manager integerObjectOf: slotsLeft + 1) onObjStack: manager markStack.
"we need to abort early to not run into some extreme corner cases (giant objects) that would explode our mark time assumptions"
^ false]
ifFalse: ["we can mark all"
slotsLeft := slotsLeft - slotsToVisit.
self markFrom: startIndex nSlots: slotsToVisit of: currentObj].
"we finished everything there is to be done with to obj -> make it black"
self blackenObject: currentObj.
currentObj := manager popObjStack: manager markStack.
"repeat while there still are objects"
currentObj notNil] whileTrue.
^ true!
Item was added:
+ ----- Method: SpurIncrementalMarker>>initForNewMarkingPass (in category 'marking-initialization') -----
+ initForNewMarkingPass
+
+ manager initializeMarkStack.
+ manager initializeWeaklingStack.
+ manager initializeEphemeronStack.
+
+ "This must come first to enable stack page reclamation. It clears
+ the trace flags on stack pages and so must precede any marking.
+ Otherwise it will clear the trace flags of reached pages."
+ coInterpreter initStackPageGC.
+
+ self markHelperStructures.
+
+ isCurrentlyMarking := true.
+ marking := true.
+ self pushInternalStructuresOnMarkStack
+
+ !
Item was changed:
----- Method: SpurIncrementalMarker>>initForNewMarkingPassIfNecessary (in category 'marking-initialization') -----
initForNewMarkingPassIfNecessary
isCurrentlyMarking
+ ifFalse: [self initForNewMarkingPass]
- ifFalse: [
- manager initializeMarkStack.
- manager initializeWeaklingStack.
- manager initializeEphemeronStack.
-
- "This must come first to enable stack page reclamation. It clears
- the trace flags on stack pages and so must precede any marking.
- Otherwise it will clear the trace flags of reached pages."
- coInterpreter initStackPageGC.
-
- self markHelperStructures.
-
- isCurrentlyMarking := true.
- marking := true.
- self pushInternalStructuresOnMarkStack].
!
Item was changed:
----- Method: SpurIncrementalMarker>>markAndTraceObjStack:andContents: (in category 'marking-initialization') -----
markAndTraceObjStack: stackOrNil andContents: markAndTraceContents
"An obj stack is a stack of objects stored in a hidden root slot, such
as the markStack or the ephemeronQueue. It is a linked list of
segments, with the hot end at the head of the list. It is a word object.
The stack pointer is in ObjStackTopx and 0 means empty."
<inline: false>
| index field |
stackOrNil = manager nilObj ifTrue:
[^self].
+ self setIsMarkedOf: stackOrNil.
- manager setIsMarkedOf: stackOrNil to: true.
self assert: (manager numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
field := manager fetchPointer: ObjStackNextx ofObject: stackOrNil.
field ~= 0 ifTrue:
[self markAndTraceObjStack: field andContents: markAndTraceContents].
field := stackOrNil.
[field := manager fetchPointer: ObjStackFreex ofObject: field.
field ~= 0] whileTrue:
+ [self setIsMarkedOf: field].
- [manager setIsMarkedOf: field to: true].
markAndTraceContents ifFalse:
[^self].
"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5."
index := (manager fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
[index >= ObjStackFixedSlots] whileTrue:
[field := manager followObjField: index ofObject: stackOrNil.
(manager isImmediate: field) ifFalse:
[self pushOnMarkingStackAndMakeGrey: field].
index := index - 1]!
Item was changed:
----- Method: SpurIncrementalMarker>>markHelperStructures (in category 'marking-initialization') -----
markHelperStructures
"marks the structures needed during GC"
+ self setIsMarkedOf: manager rememberedSetObj.
+ self setIsMarkedOf: manager freeListsObj.
- manager setIsMarkedOf: manager rememberedSetObj to: true.
- manager setIsMarkedOf: manager freeListsObj to: true.
(manager isWeakNonImm: manager classTableFirstPage) ifTrue:
[self pushOnMarkingStackAndMakeGrey: manager hiddenRootsObj].
+ self setIsMarkedOf: manager hiddenRootsObj!
- manager setIsMarkedOf: manager hiddenRootsObj to: true!
Item was changed:
----- Method: SpurIncrementalMarker>>pushHiddenRootsReferencesOnMarkingStack (in category 'root-scanning') -----
pushHiddenRootsReferencesOnMarkingStack
| classTablePageSizeLocal |
self markAndTraceObjStack: manager markStack andContents: false.
self markAndTraceObjStack: manager weaklingStack andContents: false.
self markAndTraceObjStack: manager mournQueue andContents: true.
self markAndTraceObjStack: manager ephemeronStack andContents: false.
classTablePageSizeLocal := manager numStrongSlotsOfInephemeral: manager classTableFirstPage.
self markNSlots: classTablePageSizeLocal of: manager classTableFirstPage.
self blackenObject: manager classTableFirstPage.
1 to: manager numClassTablePages - 1 do:
+ [:i| self setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)]!
- [:i| manager setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)
- to: true].!
Item was added:
+ ----- Method: SpurIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ manager setIsMarkedOf: objOop to: true!
Item was changed:
----- Method: SpurIncrementalSweeper>>cautiousBulkFreeChunkFrom: (in category 'api - incremental') -----
cautiousBulkFreeChunkFrom: objOop
"The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
| bytes start next currentObj |
self assert: (self canUseAsFreeSpace: objOop).
start := manager startOfObject: objOop.
currentObj := objOop.
bytes := 0.
[bytes := bytes + (manager bytesInBody: currentObj).
(manager isRemembered: currentObj)
ifTrue:
[self assert: (manager isFreeObject: currentObj) not.
scavenger forgetObject: currentObj].
(manager isFreeObject: currentObj)
ifTrue: [ "we need to unlink chunks for concurrent sweeping. In the stop the world sweeper we can just reset the freeLists but here we need to keep them
around so the mutator can still work between sweeping passes"
self flag: #Todo. "we want to optimize for lilliputian chunks!! For now it is ok(ish) but we have to do something about it.
At the moment I see 3 possibilities:
- have the lilliputian list always sorted (O(n) insert in the worst case!!)
- sort the lilliputian part before sweeping (O(n log n) at the start. but everytime before sweeping)
- be cheeky and discard the lilliputian list (problem: the mutator has no access to the list + it can insert unsorted chunks (for the duration of sweeping we could let it use a second list and just append it after sweeping)"
manager detachFreeObject: currentObj.
"self assert: manager totalFreeOldSpace = manager totalFreeListBytes."].
next := manager objectStartingAt: start + bytes.
currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.
self assert: ((manager oop: next isLessThan: manager endOfMemory)
or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
-
- "we found the end of a segment (old space segments always end in a bridge). Advance to the next"
- "next = currentSegmentsBridge
- ifTrue: [self cCode: 'raise(SIGINT)'.
- self advanceSegment]."
"should the next object not be usable as free space (because it is marked) abort the loop. Attention:
briges at the end of segments are marked and therefore we leave the loop here. This is important as the
newly created free space segment should not be bigger than there still is space left in the current segment"
(self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]]
whileTrue: [currentObj := next].
currentSegmentUnused := currentSegmentUnused + bytes.
^ manager addFreeChunkWithBytes: bytes at: start!
Item was changed:
----- Method: SpurIncrementalSweeper>>nextSweepingEntity (in category 'as yet unclassified') -----
nextSweepingEntity
| nextEntity reservedSegmentsFreeChunk |
nextEntity := manager objectAfter: currentSweepingEntity limit: manager endOfMemory.
reservedSegmentsFreeChunk := self compactorsSegmentToFill ifNotNil: [manager objectStartingAt: self compactorsSegmentToFill segStart].
nextEntity = reservedSegmentsFreeChunk
ifTrue: [ | segmentIndex |
"reset the claim bit!! (would otherwise stay untouched which would trigger errors)
unused does not match here as long used stays 0 which will drop down the complete
calculation to 0"
segmentIndex := manager segmentManager segmentIndexContainingObj: nextEntity.
+ self flag: #Todo. "the occupation gets set two times (here and in advance segment). We should be able
+ to remove this here. Investigate!!"
self
setOccupationAtIndex: segmentIndex
used: 0
unused: 1.
currentSegmentUsed := 0.
currentSegmentUnused := manager bytesInBody: reservedSegmentsFreeChunk.
nextEntity := manager objectAfter: nextEntity limit: manager endOfMemory].
^ nextEntity!
Item was changed:
----- Method: SpurMarker class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
"resolve keys present in both the incremental marker and the all at once mark when incremental GC is selected for generation"
self = SpurMarker ifTrue: [^ self].
SpurMemoryManager wantsIncrementalGC ifFalse: [^ self].
+ self selectorsInOverlappingClasses
+ do: [:selector |
- self selectorsInAllAtOnceMarkerAndIncrementalMarker
- do: [:key |
aCCodeGenerator
+ staticallyResolveMethodNamed: selector
- staticallyResolveMethodNamed: key
forClass: self
+ to: (self staticallyResolvePolymorphicSelector: selector)].
+
- to: (self staticallyResolvePolymorphicSelector: key)]
!
Item was removed:
- ----- Method: SpurMarker class>>selectorsInAllAtOnceMarkerAndIncrementalMarker (in category 'as yet unclassified') -----
- selectorsInAllAtOnceMarkerAndIncrementalMarker
-
- ^ (SpurAllAtOnceMarker selectors intersection: SpurIncrementalMarker selectors)!
Item was added:
+ ----- Method: SpurMarker class>>selectorsInOverlappingClasses (in category 'as yet unclassified') -----
+ selectorsInOverlappingClasses
+
+ ^ SpurAllAtOnceMarker selectors intersection: ((SpurMemoryManager markerClass withAllSuperclasses copyUpTo: SpurMarker) gather: #selectors)!
Item was changed:
----- Method: SpurMarker class>>staticallyResolvePolymorphicSelector: (in category 'nil') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
- staticallyResolvePolymorphicSelector: aSelectorSymbol
+ ^ (self selectorsInOverlappingClasses includes: aSelectorSymbol)
+ ifTrue: [ | classes classesUpToMarker |
+ classesUpToMarker := SpurMemoryManager markerClass withAllSuperclasses copyUpTo: SpurMarker.
+ (classesUpToMarker includes: self)
+ ifTrue: [classes := classesUpToMarker]
+ ifFalse: [classes := (self withAllSuperclasses copyUpTo: SpurMarker)].
+
+ classes
+ detect: [:class | class selectors includes: aSelectorSymbol]
+ ifFound: [:class | self staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: class]
+ ifNone: [self halt]]
- ^ (self selectorsInAllAtOnceMarkerAndIncrementalMarker includes: aSelectorSymbol)
- ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
ifFalse: [aSelectorSymbol]!
Item was added:
+ ----- Method: SpurMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self wantsIncrementalGC
ifTrue: [aCCodeGenerator
recursivelyResolvePolymorpicReceiver: 'gc' toVariants: {SpurIncrementalGarbageCollector. SpurStopTheWorldGarbageCollector} in: self default: SpurIncrementalGarbageCollector;
+ staticallyResolvedPolymorphicReceiver: 'gc' to: self markerClass in: SpurIncrementalGarbageCollector;
+ staticallyResolvedPolymorphicReceiver: 'compactor' to: self compactorClass in: self;
+ staticallyResolvedPolymorphicReceiver: 'marker' to: self markerClass in: self].
- staticallyResolvedPolymorphicReceiver: 'gc' to: SpurIncrementalMarker in: SpurIncrementalGarbageCollector;
- staticallyResolvedPolymorphicReceiver: 'compactor' to: SpurIncrementalSweepAndCompact in: self;
- staticallyResolvedPolymorphicReceiver: 'marker' to: SpurIncrementalMarker in: self].
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
aCCodeGenerator removeVariable: 'memory'. "memory is a simulation time thing only"
self declareCAsOop: #( freeStart scavengeThreshold newSpaceStart pastSpaceStart
oldSpaceStart lowSpaceThreshold freeOldSpaceStart endOfMemory)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']), #(statAllocatedBytes)
in: aCCodeGenerator.
aCCodeGenerator
var: #lastHash type: #usqInt;
var: #freeListsMask type: #usqInt;
var: #freeLists type: #'sqInt *';
var: #objStackInvalidBecause type: #'char *';
var: #unscannedEphemerons type: #SpurContiguousObjStack;
var: #heapGrowthToSizeGCRatio type: #float;
var: #heapSizeAtPreviousGC type: #usqInt;
var: #totalFreeOldSpace type: #usqInt;
var: #maxOldSpaceSize type: #usqInt.
aCCodeGenerator
var: #oldSpaceUsePriorToScavenge type: #sqLong.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.
self wantsIncrementalGC
ifTrue: [aCCodeGenerator
staticallyResolvedPolymorphicReceiver: 'manager gc' to: SpurIncrementalGarbageCollector in: SpurSegmentManager;
"the vm needs (from handwritten C code) the method fullGC. Generate it later on"
generate: #fullGC from: #SIGC_fullGC]!
Item was changed:
----- Method: SpurMemoryManager class>>wantsIncrementalGC (in category 'as yet unclassified') -----
wantsIncrementalGC
+ ^ self gcClass includesBehavior: SpurIncrementalGarbageCollector!
- ^ self gcClass = SpurIncrementalGarbageCollector!
Item was changed:
----- Method: SpurMemoryManager>>printFreeSpaceStatistics (in category 'debug printing') -----
printFreeSpaceStatistics
"used for debugging"
<export: true>
<var: 'sizeCount' declareC:'static unsigned long long sizeCount[64] = {0}'>
| sizeCount |
self cCode:'' inSmalltalk:[
sizeCount := CArrayAccessor on: (DoubleWordArray new: 64).
].
coInterpreter cr;
print: '----------------------------------------- '; cr;
print: '----------------------------------------- ';
cr.
0 to: self numSegments -1
+ do: [:index | | segInfo bigFreeChunkMemory freeSpace occupiedSpace objectCount |
- do: [:index | | segInfo bigFreeChunkMemory freeSpace occupiedSpace |
segInfo := self segInfoAt: index.
bigFreeChunkMemory := 0.
freeSpace := 0.
occupiedSpace := 0.
+ objectCount := 0.
segmentManager
allEntitiesInSegment: segInfo
+ exceptTheLastBridgeDo: [:oop | | oopSize slotCount |
+ oopSize := self bytesInBody: oop.
+ slotCount := oopSize >> 3.
- exceptTheLastBridgeDo: [:oop | | oopSize |
- oopSize := self numSlotsOfAny: oop.
(self isFreeOop: oop)
ifTrue: [
"index > 0
ifTrue: [self cCode: 'raise(SIGINT)']."
freeSpace := freeSpace + oopSize.
+ slotCount < 64
- oopSize < 64
ifTrue: [
+ sizeCount at: slotCount put: ((sizeCount at: slotCount) + 1)]
- sizeCount at: oopSize put: ((sizeCount at: oopSize) + 1)]
ifFalse: [sizeCount at: 0 put: ((sizeCount at: 0) + 1).
bigFreeChunkMemory := bigFreeChunkMemory + oopSize]]
+ ifFalse: [objectCount := objectCount + 1.
+ occupiedSpace := occupiedSpace + oopSize]].
- ifFalse: [occupiedSpace := occupiedSpace + oopSize]].
coInterpreter cr;
print: 'Segment ';
printNum: index;
print: ' (starting at: ';
printHex: segInfo segStart; tab;
print: 'max slots: '; tab;
printNum: segInfo segSize >> 3;
print: ')';
cr; cr; flush.
coInterpreter cr;
print: 'Currently occupied space: '; tab;
+ printNum: occupiedSpace; tab;
+ print: 'From '; printNum: objectCount; print: ' objects'; cr;
- printNum: occupiedSpace; cr;
print: 'Currently free space: '; tab;
printNum: freeSpace; cr;
print: 'Resulting in an occupation percentage of: '; tab;
printNum: (occupiedSpace asFloat / (occupiedSpace + freeSpace)) * 100;
cr; cr; flush.
coInterpreter tab;
print: 'big free chunks ';
printNum: (sizeCount at: 0);
print: ' reserving number of slots: ';
printNum: bigFreeChunkMemory;
cr; flush.
sizeCount at: 0 put: 0.
1 to: 63
do: [:i |
(sizeCount at: i) > 0
ifTrue: [coInterpreter tab;
print: 'free chunk of size '; printNum: i; print: ': ';
printNum: (sizeCount at: i);
cr; flush.
sizeCount at: i put: 0.]].
coInterpreter cr;
print: '----------------------------------------- '; cr.].
coInterpreter cr;
print: '----------------------------------------- '; cr;
print: '----------------------------------------- ';
cr.
!
Item was added:
+ ----- Method: SpurMemoryManager>>printSegmentOccupationFromMarkedObjects (in category 'debug printing') -----
+ printSegmentOccupationFromMarkedObjects
+
+ "used for debugging"
+ <export: true>
+
+ coInterpreter cr;
+ print: '----------------------------------------- '; cr;
+ print: '----------------------------------------- ';
+ cr.
+
+ 0 to: self numSegments -1
+ do: [:index | | segInfo occupiedSpace |
+ segInfo := self segInfoAt: index.
+ occupiedSpace := 0.
+
+ segmentManager
+ allEntitiesInSegment: segInfo
+ exceptTheLastBridgeDo: [:oop | | oopSize |
+ oopSize := self bytesInBody: oop.
+
+ (self isFreeOop: oop)
+ ifFalse: [
+ (self isMarked: oop)
+ ifTrue: [occupiedSpace := occupiedSpace + oopSize]]].
+
+ coInterpreter cr;
+ print: 'Segment ';
+ printNum: index;
+ print: ' (starting at: ';
+ printHex: segInfo segStart;
+ print: ')';
+ cr; cr; flush.
+
+ coInterpreter cr;
+ print: 'Currently occupied space: '; tab;
+ printNum: occupiedSpace; tab;
+ print: 'Resulting in an occupation percentage of: '; tab;
+ printNum: (occupiedSpace asFloat / (segInfo segSize)) * 100;
+ cr; cr; flush.
+
+
+ ].
+
+ coInterpreter cr;
+ print: '----------------------------------------- '; cr;
+ print: '----------------------------------------- ';
+ cr.
+ !
Item was changed:
----- Method: SpurMemoryManager>>validObjectColors (in category 'debug support') -----
validObjectColors
| currentSweepingEntityT |
+ currentSweepingEntityT := gc sweepersCurrentSweepingEntity ifNil: [self firstObject].
- currentSweepingEntityT := gc compactor sweeper currentSweepingEntity ifNil: [self firstObject].
self allOldSpaceEntitiesFrom: currentSweepingEntityT do: [:obj |
((self isMarked: obj) and: [(self isPointers: obj) and: [(self isContext: obj) not]])
ifTrue: [| slotCount |
slotCount := self numSlotsOf: obj.
0 to: slotCount - 1
do: [:index | | slot |
slot := self fetchPointer: index ofObject: obj.
((self isNonImmediate: slot) and: [(self isOldObject: slot) and: [(self isForwarded: slot) not]])
ifTrue: [(slot >= currentSweepingEntityT and: [(self isMarked: slot) not])
ifTrue: [self halt.
coInterpreter longPrintOop: (self firstReferenceTo:(self firstReferenceTo: obj)).
self printReferencesTo: (self firstReferenceTo: obj).
self printReferencesTo: obj.
self printRelativePositionOf: obj.
self printRelativePositionOf: slot.
coInterpreter longPrintOop: obj.
coInterpreter longPrintOop: slot.
self cCode: 'raise(SIGINT)'.
^ false]]]]].
^ true!
Item was changed:
----- Method: VMClass class>>staticallyResolvePolymorphicSelector: (in category 'translation') -----
staticallyResolvePolymorphicSelector: aSelectorSymbol
+
+ ^ self staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: self!
- ^((self name select: [:ea| ea isUppercase]), '_', aSelectorSymbol) asSymbol!
Item was added:
+ ----- Method: VMClass class>>staticallyResolvePolymorphicSelector:forClass: (in category 'translation') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: aClass
+
+ ^ ((aClass name select: [:ea| ea isUppercase]), '_', aSelectorSymbol) asSymbol!
Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpur2PhaseIncrementalStack64VM (in category 'configurations') -----
+ generateSqueakSpur2PhaseIncrementalStack64VM
+ "No primitives since we can use those from the Cog VM"
+ ^VMMaker
+ generate: StackInterpreter
+ with: #(ObjectMemory Spur64BitMemoryManager
+ gcClass SpurIncremental2PhaseGarbageCollector
+ FailImbalancedPrimitives false
+ MULTIPLEBYTECODESETS true
+ TempVectReadBarrier true
+ bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
+ to: self sourceTree, '/src/spur64.stack'
+ platformDir: self sourceTree, '/platforms'
+ including: #()!
Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurIncrementalCog64VM (in category 'configurations') -----
+ generateSqueakSpurIncrementalCog64VM
+ "No primitives since we can use those for the Cog VM"
+ ^VMMaker
+ generate: CoInterpreter
+ and: StackToRegisterMappingCogit
+ with: #(ObjectMemory Spur64BitCoMemoryManager
+ MULTIPLEBYTECODESETS true
+ TempVectReadBarrier true
+ bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
+ to: self sourceTree, '/src/spur64.cog'
+ platformDir: self sourceTree, '/platforms'
+ including:#()!
1
0
Hi,
On Windows, I have observed when I start the Squeak VM, the VM starts (I
can see the process) but there is no window.
If I start SqueakConsole from the same VM distribution, it is ok.
What I want is to start the VM with a one line .bat file, with no
subsequent command window to popup:
START "" /MAX /B VM\Squeak
with the Squeak.ini set accordingly:
[Global]
DeferUpdate=1
ShowConsole=0
DynamicConsole=1
ReduceCPUUsage=1
ReduceCPUInBackground=0
3ButtonMouse=0
1ButtonMouse=0
UseDirectSound=1
PriorityBoost=1
B3DXUsesOpenGL=1
CaseSensitiveFileMode=0
ImageFile="..\Resources\image\drgeo.image"
WindowTitle="GNU Dr. Geo"
QuitDialogLabel="GNU Dr. Geo"
QuitDialogMessage="Do you really want to quit?"
The directory structure of my distribution:
├── DrGeo.bat
├── README
├── Resources
│  ├── doc
│  ├── fonts
│  │  └── WenQuanYi Zen Hei Sharp Regular.ttf
│  ├── icons
│  │  └── splash.bmp
│  ├── image
│  │  ├── CuisV6.sources
│  │  ├── drgeo.changes
│  │  ├── drgeo.image
│  │  └── locale
│  ├── MyExports
│  ├── MySketches
│  ├── Sketches
│  └── SmalltalkSketches
│      └── README
└── VM
   ├── B3DAcceleratorPlugin.dll
   ├── DESPlugin.dll
   ├── FileAttributesPlugin.dll
   ├── MD5Plugin.dll
   ├── SHA2Plugin.dll
   ├── Squeak3D.dll
   ├── SqueakConsole.exe
   ├── SqueakConsole.exe.manifest
   ├── Squeak.exe
   ├── Squeak.exe.manifest
   ├── SqueakFFIPrims.dll
   ├── Squeak.ini
   ├── SqueakSSL.dll
   ├── UUIDPlugin.dll
   ├── VectorEnginePlugin.dll
   └── Win32OSProcessPlugin.dll
When I start like this, it works but it opens a console window:
START "" /MAX /B VM\SqueakConsole.exe Resources\image\drgeo.image
Observe that if I replace SqueakConsole.exe by Squeak.exe it does not work
Any idea?
Thanks
Hilaire
--
GNU Dr. Geo
http://drgeo.eu
http://blog.drgeo.eu
1
1
[OpenSmalltalk/opensmalltalk-vm] 5208bb: CogVM source as per VMMaker.oscog-eem.3287
by Eliot Miranda 04 Jan '23
by Eliot Miranda 04 Jan '23
04 Jan '23
Branch: refs/heads/virtend
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: 5208bb6a003118e7db74511e7195db662ab0901b
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/5208bb6a003118e7db…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2023-01-03 (Tue, 03 Jan 2023)
Changed paths:
M src/spur32.cog.lowcode/cogit.h
M src/spur32.cog.lowcode/cogitARMv5.c
M src/spur32.cog.lowcode/cogitIA32.c
M src/spur32.cog.lowcode/cointerp.c
M src/spur32.cog.lowcode/cointerp.h
M src/spur32.cog.lowcode/gcc3x-cointerp.c
M src/spur32.cog/cogit.h
M src/spur32.cog/cogitARMv5.c
M src/spur32.cog/cogitIA32.c
M src/spur32.cog/cointerp.c
M src/spur32.cog/cointerp.h
M src/spur32.cog/cointerpmt.c
M src/spur32.cog/cointerpmt.h
M src/spur32.cog/gcc3x-cointerp.c
M src/spur32.cog/gcc3x-cointerpmt.c
M src/spur32.sista/cogit.h
M src/spur32.sista/cogitARMv5.c
M src/spur32.sista/cogitIA32.c
M src/spur32.sista/cointerp.c
M src/spur32.sista/cointerp.h
M src/spur32.sista/gcc3x-cointerp.c
M src/spur32.stack.lowcode/gcc3x-interp.c
M src/spur32.stack.lowcode/interp.c
M src/spur32.stack/gcc3x-interp.c
M src/spur32.stack/interp.c
M src/spur32.stack/validImage.c
M src/spur64.cog.lowcode/cogit.h
M src/spur64.cog.lowcode/cogitARMv8.c
M src/spur64.cog.lowcode/cogitX64SysV.c
M src/spur64.cog.lowcode/cogitX64WIN64.c
M src/spur64.cog.lowcode/cointerp.c
M src/spur64.cog.lowcode/cointerp.h
M src/spur64.cog.lowcode/gcc3x-cointerp.c
M src/spur64.cog/cogit.h
M src/spur64.cog/cogitARMv8.c
M src/spur64.cog/cogitX64SysV.c
M src/spur64.cog/cogitX64WIN64.c
M src/spur64.cog/cointerp.c
M src/spur64.cog/cointerp.h
M src/spur64.cog/cointerpmt.c
M src/spur64.cog/cointerpmt.h
M src/spur64.cog/gcc3x-cointerp.c
M src/spur64.cog/gcc3x-cointerpmt.c
M src/spur64.sista/cogit.h
M src/spur64.sista/cogitARMv8.c
M src/spur64.sista/cogitX64SysV.c
M src/spur64.sista/cogitX64WIN64.c
M src/spur64.sista/cointerp.c
M src/spur64.sista/cointerp.h
M src/spur64.sista/gcc3x-cointerp.c
M src/spur64.stack.lowcode/gcc3x-interp.c
M src/spur64.stack.lowcode/interp.c
M src/spur64.stack/gcc3x-interp.c
M src/spur64.stack/interp.c
M src/spur64.stack/validImage.c
M src/v3.cog/cogit.h
M src/v3.cog/cogitARMv5.c
M src/v3.cog/cogitIA32.c
M src/v3.cog/cointerp.c
M src/v3.cog/cointerp.h
M src/v3.cog/gcc3x-cointerp.c
M src/v3.stack/gcc3x-interp.c
M src/v3.stack/interp.c
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.3287
Fix become on compiled methods (for Spur only). Tim Rowledge's recent attempt
to inboard sources uncovered flaws in become with compiled methods on some
jitted platforms (specifically ARMv8 linux, which has a dual mapped code zone).
The main changes in this are to
a) never do in-place become on compiled methods on the jit
b) divorce machine code frames referring to cog methods involved in a become
c) refactor to reduce duplication and overrioding in spurPostBecomeAction:
d) fix bugs in mapping the instructionPointer when method and/or newMethod are
becommed
e) fix bugs in exception handler search that was not following forwarding
pointers and could hence possibly be confused (miss finding a handler)
by a become
Hide access to CogBlockMethod cmType behind accessors, so as to allow CMMethod
to be extended to address the above issue with become in an elegant way.
1
0
[OpenSmalltalk/opensmalltalk-vm] 7024a8: CogVM source as per VMMaker.oscog-eem.3287
by Eliot Miranda 04 Jan '23
by Eliot Miranda 04 Jan '23
04 Jan '23
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: 7024a83b249e17aed5e6ac4aa4ab4907d964b155
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/7024a83b249e17aed5…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2023-01-03 (Tue, 03 Jan 2023)
Changed paths:
M src/spur32.cog.lowcode/cogit.h
M src/spur32.cog.lowcode/cogitARMv5.c
M src/spur32.cog.lowcode/cogitIA32.c
M src/spur32.cog.lowcode/cointerp.c
M src/spur32.cog.lowcode/cointerp.h
M src/spur32.cog.lowcode/gcc3x-cointerp.c
M src/spur32.cog/cogit.h
M src/spur32.cog/cogitARMv5.c
M src/spur32.cog/cogitIA32.c
M src/spur32.cog/cointerp.c
M src/spur32.cog/cointerp.h
M src/spur32.cog/cointerpmt.c
M src/spur32.cog/cointerpmt.h
M src/spur32.cog/gcc3x-cointerp.c
M src/spur32.cog/gcc3x-cointerpmt.c
M src/spur32.sista/cogit.h
M src/spur32.sista/cogitARMv5.c
M src/spur32.sista/cogitIA32.c
M src/spur32.sista/cointerp.c
M src/spur32.sista/cointerp.h
M src/spur32.sista/gcc3x-cointerp.c
M src/spur32.stack.lowcode/gcc3x-interp.c
M src/spur32.stack.lowcode/interp.c
M src/spur32.stack/gcc3x-interp.c
M src/spur32.stack/interp.c
M src/spur32.stack/validImage.c
M src/spur64.cog.lowcode/cogit.h
M src/spur64.cog.lowcode/cogitARMv8.c
M src/spur64.cog.lowcode/cogitX64SysV.c
M src/spur64.cog.lowcode/cogitX64WIN64.c
M src/spur64.cog.lowcode/cointerp.c
M src/spur64.cog.lowcode/cointerp.h
M src/spur64.cog.lowcode/gcc3x-cointerp.c
M src/spur64.cog/cogit.h
M src/spur64.cog/cogitARMv8.c
M src/spur64.cog/cogitX64SysV.c
M src/spur64.cog/cogitX64WIN64.c
M src/spur64.cog/cointerp.c
M src/spur64.cog/cointerp.h
M src/spur64.cog/cointerpmt.c
M src/spur64.cog/cointerpmt.h
M src/spur64.cog/gcc3x-cointerp.c
M src/spur64.cog/gcc3x-cointerpmt.c
M src/spur64.sista/cogit.h
M src/spur64.sista/cogitARMv8.c
M src/spur64.sista/cogitX64SysV.c
M src/spur64.sista/cogitX64WIN64.c
M src/spur64.sista/cointerp.c
M src/spur64.sista/cointerp.h
M src/spur64.sista/gcc3x-cointerp.c
M src/spur64.stack.lowcode/gcc3x-interp.c
M src/spur64.stack.lowcode/interp.c
M src/spur64.stack/gcc3x-interp.c
M src/spur64.stack/interp.c
M src/spur64.stack/validImage.c
M src/v3.cog/cogit.h
M src/v3.cog/cogitARMv5.c
M src/v3.cog/cogitIA32.c
M src/v3.cog/cointerp.c
M src/v3.cog/cointerp.h
M src/v3.cog/gcc3x-cointerp.c
M src/v3.stack/gcc3x-interp.c
M src/v3.stack/interp.c
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.3287
Fix become on compiled methods (for Spur only). Tim Rowledge's recent attempt
to inboard sources uncovered flaws in become with compiled methods on some
jitted platforms (specifically ARMv8 linux, which has a dual mapped code zone).
The main changes in this are to
a) never do in-place become on compiled methods on the jit
b) divorce machine code frames referring to cog methods involved in a become
c) refactor to reduce duplication and overrioding in spurPostBecomeAction:
d) fix bugs in mapping the instructionPointer when method and/or newMethod are
becommed
e) fix bugs in exception handler search that was not following forwarding
pointers and could hence possibly be confused (miss finding a handler)
by a become
Hide access to CogBlockMethod cmType behind accessors, so as to allow CMMethod
to be extended to address the above issue with become in an elegant way.
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3287.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3287
Author: eem
Time: 3 January 2023, 3:01:12.250287 pm
UUID: 67af727b-9445-4a47-be3c-f12923ba6efd
Ancestors: VMMaker.oscog-eem.3286
Fix become on compiled methods (for Spur only). Tim Rowledge's recent attempt to inboard sources uncovered flaws in become with compiled methods on some jitted platforms (specifically ARMv8 linux, which has a dual mapped code zone).
The main changes in this are to
a) never do in-place become on compiled methods on the jit
b) divorce machine code frames referring to cog methods involved in a become
c) refactor to reduce duplication and overrioding in spurPostBecomeAction:
d) fix bugs in mapping the instructionPointer when method and/or newMethod are becommed
=============== Diff against VMMaker.oscog-eem.3286 ===============
Item was changed:
----- Method: CoInterpreter>>divorceAFrameIf:in: (in category 'frame access') -----
divorceAFrameIf: criterion in: aStackPage
"Divorce at most one frame in the current page (since the divorce may cause the page to be split)
and answer whether a frame was divorced."
<var: #criterion declareC: 'sqInt (*criterion)(char *fp)'>
<var: #aStackPage type: #'StackPage *'>
| theFP calleeFP theSP theContext |
theFP := aStackPage headFP.
theSP := aStackPage headSP.
theSP := theSP + objectMemory wordSize. "theSP points at hottest item on frame's stack"
[(self perform: criterion with: theFP) ifTrue:
[theContext := self ensureFrameIsMarried: theFP SP: theSP.
self externalDivorceFrame: theFP andContext: theContext.
+ theFP = framePointer ifTrue:
+ [framePointer := 0].
^true].
calleeFP := theFP.
theFP := self frameCallerFP: theFP.
theFP ~= 0] whileTrue:
["theSP points at stacked hottest item on frame's stack"
theSP := self frameCallerSP: calleeFP].
^false!
Item was added:
+ ----- Method: CoInterpreter>>ensureAllContextsWithMachineCodeMethodsFlaggedForBecomeHaveBytecodePCs (in category 'frame access') -----
+ ensureAllContextsWithMachineCodeMethodsFlaggedForBecomeHaveBytecodePCs
+ "Map all native pcs to bytecoded pcs in all contexts that have a method with a cog method flagged for become
+ See the comment in primitiveArrayBecome."
+ <inline: true>
+ objectMemory allObjectsDo:
+ [:oop| | methodHeader |
+ (objectMemory isContextNonImm: oop) ifTrue:
+ [method := objectMemory followObjField: MethodIndex ofObject: oop.
+ methodHeader := self rawHeaderOf: (objectMemory fetchPointer: MethodIndex ofObject: oop).
+ ((self isCogMethodReference: methodHeader)
+ and: [(self cCoerceSimple: methodHeader to: #'CogMethod *') isCMMethodFlaggedForBecome]) ifTrue:
+ [self widowOrForceToBytecodePC: oop]]]!
Item was added:
+ ----- Method: CoInterpreter>>flushBecommedClassesInMethodCache (in category 'object memory support') -----
+ flushBecommedClassesInMethodCache
+ "Override to also flush linked sends to inavlid classes."
+ <option: #SpurObjectMemory>
+ super flushBecommedClassesInMethodCache.
+ cogit unlinkSendsLinkedForInvalidClasses!
Item was removed:
- ----- Method: CoInterpreter>>flushBecommedClassesInMethodZone (in category 'object memory support') -----
- flushBecommedClassesInMethodZone
- <inline: true>
- cogit unlinkSendsLinkedForInvalidClasses!
Item was changed:
----- Method: CoInterpreter>>flushMethodsWithMachineCodePrimitivesAndContinueAnswering: (in category 'primitive support') -----
flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
"Arrange that any and all cog methods with machine code primitives can be and are discarded.
Hence scan contexts and map their PCs to bytecode PCs if required, and scan frames, divorcing
+ the frames of activations if required. Then continue execution answering result. THIS MUST BE
- the frames of activationsif required. Then continue execution answering result. THIS MUST BE
INVOKED IN THE CONTEXT OF A PRIMITIVE. It exists to support vmParameterAt:put:."
| activeContext theFrame thePage |
+ activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForCogMethodWithMachineCodePrim:.
- activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameWithCogMethod:.
self ensureAllContextsWithMethodMachineCodePrimitiveMethodHaveBytecodePCs.
cogit unlinkSendsToMethodsSuchThat: #cogMethodHasMachineCodePrim: AndFreeIf: true.
+ "If the top frame was divorced then continue in the interpreter."
- "If flushing led to divorce continue in the interpreter."
(self isStillMarriedContext: activeContext) ifFalse:
[self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
"pop bogus machine-code instructionPointer, arguments and receiver"
self pop: argumentCount + 2 thenPush: result.
cogit ceInvokeInterpret
"NOTREACHED"].
"If not, work out where we are and continue"
theFrame := self frameOfMarriedContext: activeContext.
thePage := stackPages stackPageFor: theFrame.
self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
self setStackPointersFromPage: thePage.
instructionPointer := self popStack.
self pop: argumentCount + 1 thenPush: result!
Item was removed:
- ----- Method: CoInterpreter>>followForwardedMethodsInMethodZone (in category 'object memory support') -----
- followForwardedMethodsInMethodZone
- <inline: true>
- cogit followForwardedMethods!
Item was changed:
----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
followForwardingPointersInStackZone: theBecomeEffectsFlags
"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
probe, since notionally objects' internals are accessed only via sending messages to them,
the exception is primitives that access the internals of the non-receiver argument(s).
To avoid a read barrier on bytecode, literal and inst var fetch and non-local return, we scan
the receivers (including the stacked receiver for non-local return) and method references
in the stack zone and follow any forwarded ones. This is of course way cheaper than
scanning all of memory as in the old become.
Override to handle machine code frames"
| theIPPtr |
<inline: false>
- (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
- [(objectMemory isForwarded: method) ifTrue:
- [theIPPtr := instructionPointer > method ifTrue: [instructionPointer - method].
- method := objectMemory followForwarded: method.
- theIPPtr ifNotNil: [instructionPointer := method + theIPPtr]].
- (objectMemory isOopForwarded: newMethod) ifTrue:
- [newMethod := objectMemory followForwarded: newMethod]].
-
stackPage ifNil: "the system must be snapshotting; nothing to do..."
[self assert: (stackPages mostRecentlyUsedPage isNil or: [stackPages mostRecentlyUsedPage isFree]).
self cCode: [] inSmalltalk: [self assert: stackPages allPagesFree].
^self].
self externalWriteBackHeadFramePointers.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP oop offset |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
theIPPtr := thePage = stackPage ifFalse: [thePage headSP asUnsignedInteger].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr isNil or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
(self isMachineCodeFrame: theFP)
ifTrue:
[oop := stackPages longAt: theFP + FoxMFReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxMFReceiver
put: (objectMemory followForwarded: oop)].
self assert: (objectMemory isForwarded: (self mframeHomeMethod: theFP) methodObject) not]
ifFalse:
[oop := stackPages longAt: theFP + FoxIFReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxIFReceiver
put: (objectMemory followForwarded: oop)].
oop := self iframeMethod: theFP.
(objectMemory isForwarded: oop) ifTrue:
[| newOop |
newOop := objectMemory followForwarded: oop.
offset := newOop - oop.
(theIPPtr notNil
and: [(stackPages longAt: theIPPtr) > oop]) ifTrue:
[stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + offset].
stackPages
longAt: theFP + FoxIFSavedIP
put: (stackPages longAt: theFP + FoxIFSavedIP) + offset.
stackPages
longAt: theFP + FoxMethod
put: (oop := newOop)]].
((self frameHasContext: theFP)
and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory followForwarded: (self frameContext: theFP))].
offset := self frameStackedReceiverOffset: theFP.
oop := stackPages longAt: theFP + offset.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + offset
put: (objectMemory followForwarded: oop)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
theFP := callerFP].
"And finally follow the saved context and the caller context."
theSP := thePage baseAddress - objectMemory wordSize.
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isForwarded: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory followForwarded: oop)].
theSP := theSP + objectMemory wordSize]]]!
Item was added:
+ ----- Method: CoInterpreter>>insulateFramesAndContextsFromCogMethodsFlaggedForBecome (in category 'object access primitives') -----
+ insulateFramesAndContextsFromCogMethodsFlaggedForBecome
+ | activeContext |
+ activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForCogMethodFlaggedForBecome:.
+ self popStack. "divorceAllFramesSuchThat: sends ensurePushedInstructionPointer, which is a side-effect we don't want here (but need elsewhere)"
+ "Mapping native pcs in contexts whose methods are flagged for become will not ensure that pcs are mapped reliably.
+ Consider this arc: a context on a method that has been jitted exists with a native pc.
+ The method is unjitted to make room for other methods to be jitted.
+ The method is becommed.
+ So the scan is only effective for methods in the jit. Slowing down become so that a rare
+ case may fail more comprehensibly, when its going to fail anyway, is a waste of effort."
+ false ifTrue:
+ [self ensureAllContextsWithMachineCodeMethodsFlaggedForBecomeHaveBytecodePCs].
+ self assert: (framePointer ~= 0) == (self isStillMarriedContext: activeContext).
+ (self isStillMarriedContext: activeContext) ifFalse:
+ [objectMemory storePointer: SuspendedContextIndex ofObject: self activeProcess withValue: activeContext]!
Item was added:
+ ----- Method: CoInterpreter>>isMachineCodeFrameForCogMethodFlaggedForBecome: (in category 'object access primitives') -----
+ isMachineCodeFrameForCogMethodFlaggedForBecome: theFP
+ <var: #theFP type: #'char *'>
+ ^(self isMachineCodeFrame: theFP)
+ and: [(self mframeHomeMethod: theFP) isCMMethodFlaggedForBecome]!
Item was added:
+ ----- Method: CoInterpreter>>isMachineCodeFrameForCogMethodWithMachineCodePrim: (in category 'plugin primitive support') -----
+ isMachineCodeFrameForCogMethodWithMachineCodePrim: theFP
+ <var: #theFP type: #'char *'>
+ ^(self isMachineCodeFrame: theFP)
+ and: [cogit cogMethodHasMachineCodePrim: (self mframeHomeMethod: theFP)]!
Item was removed:
- ----- Method: CoInterpreter>>isMachineCodeFrameWithCogMethod: (in category 'plugin primitive support') -----
- isMachineCodeFrameWithCogMethod: theFP
- <var: #theFP type: #'char *'>
- ^(self isMachineCodeFrame: theFP)
- and: [cogit cogMethodHasMachineCodePrim: (self mframeHomeMethod: theFP)]!
Item was removed:
- ----- Method: CoInterpreter>>mapVMRegisters (in category 'object memory support') -----
- mapVMRegisters
- "Map the oops in the interpreter's vm ``registers'' to their new values
- during garbage collection or a become: operation."
- "Assume: All traced variables contain valid oops.
- N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
- only during message lookup and because createActualMessageTo will not
- cause a GC these cannot change during message lookup."
- | mapInstructionPointer |
- (objectMemory shouldRemapObj: method) ifTrue:
- ["i.e. interpreter instructionPointer in method as opposed to machine code?"
- (mapInstructionPointer := instructionPointer > method) ifTrue:
- [instructionPointer := instructionPointer - method]. "*rel to method"
- method := objectMemory remapObj: method.
- mapInstructionPointer ifTrue:
- [instructionPointer := instructionPointer + method]]. "*rel to method"
- (objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
- [newMethod := objectMemory remapObj: newMethod]!
Item was changed:
----- Method: CoInterpreter>>maybeFixClonedCompiledMethod: (in category 'cog jit support') -----
maybeFixClonedCompiledMethod: objOop
+ "Make sure a cloned method doesn't reference its original's Cog method, if any."
- "Make sure a cloned method doesn't reference its originals Cog method, if any."
| rawHeader |
self assert: (objectMemory isOopCompiledMethod: objOop).
rawHeader := self rawHeaderOf: objOop.
(self isCogMethodReference: rawHeader) ifTrue:
[self
rawHeaderOf: objOop
put: (self cCoerceSimple: rawHeader to: #'CogMethod *') methodHeader]!
Item was changed:
----- Method: CoInterpreter>>postBecomeAction: (in category 'object memory support') -----
postBecomeAction: theBecomeEffectsFlags
"Clear the gcMode var and let the Cogit do its post GC checks."
super postBecomeAction: theBecomeEffectsFlags.
(objectMemory hasSpurMemoryManagerAPI)
+ ifTrue: [(theBecomeEffectsFlags anyMask: BecameJittedCompiledMethodFlag) ifTrue:
+ [cogit freeBecomeFlaggedMethods].
+ cogit followMovableLiteralsAndUpdateYoungReferrers]
- ifTrue: [cogit followMovableLiteralsAndUpdateYoungReferrers]
ifFalse: [cogit cogitPostGCAction: gcMode].
self nilUncoggableMethods.
self assert: cogit kosherYoungReferrers.
gcMode := 0!
Item was removed:
- ----- Method: CoInterpreter>>preBecomeAction (in category 'object memory support') -----
- preBecomeAction
- "Need to set gcMode var (to avoid passing the flag through a lot of the updating code)"
- super preBecomeAction.
- gcMode := GCModeBecome!
Item was added:
+ ----- Method: CoInterpreter>>preBecomeAction: (in category 'object memory support') -----
+ preBecomeAction: theBecomeEffectsFlags
+ super preBecomeAction: theBecomeEffectsFlags.
+ "see the comment in InterpreterPrimitives>>primitiveArrayBecome"
+ (theBecomeEffectsFlags anyMask: BecameJittedCompiledMethodFlag) ifTrue:
+ [self insulateFramesAndContextsFromCogMethodsFlaggedForBecome].
+ "Need to set gcMode var (to avoid passing the flag through a lot of the updating code)"
+ gcMode := GCModeBecome!
Item was added:
+ ----- Method: CoInterpreter>>primitiveBecomeReturn: (in category 'object access primitives') -----
+ primitiveBecomeReturn: ec
+ "Return from a become primitive after invoking become:with:twoWay:copyHash:.
+ If succeeding and the top frame has been divorced then continue in the interpreter.
+ See the comment in primitiveArrayBecome."
+
+ <inline: false>
+ | activeProc activeContextOrNil |
+ ec = PrimNoErr
+ ifTrue:
+ [activeProc := self activeProcess.
+ activeContextOrNil := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
+ framePointer = 0 ifTrue: "If the top frame was divorced then continue in the interpreter."
+ [self assert: (self isContext: activeContextOrNil).
+ self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
+ self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContextOrNil.
+ objectMemory
+ storePointerUnchecked: SuspendedContextIndex
+ ofObject: activeProc
+ withValue: objectMemory nilObject.
+ "pop bogus machine-code instructionPointer and any primitive arguments"
+ self pop: argumentCount + 1.
+ cogit ceInvokeInterpret
+ "NOTREACHED"].
+ "If not, check where we are and continue..."
+ activeContextOrNil = objectMemory nilObject ifFalse:
+ ["divorcing should not have disturbed the topFrame if it wasn;t divorced"
+ self assert: (self isContext: activeContextOrNil).
+ self assert: framePointer = (self frameOfMarriedContext: activeContextOrNil).
+ objectMemory
+ storePointerUnchecked: SuspendedContextIndex
+ ofObject: activeProc
+ withValue: objectMemory nilObject].
+ self methodReturnReceiver]
+ ifFalse: [self primitiveFailFor: ec]!
Item was changed:
----- Method: CoInterpreter>>printPrimLogEntryAt:hasParameter: (in category 'debug support') -----
printPrimLogEntryAt: i hasParameter: hasParameter
<inline: false>
"print the entry and answer if it takes a parameter (as the following entry)"
| entryOop className length |
entryOop := primTraceLog at: i.
hasParameter ifTrue:
[(objectMemory addressCouldBeObj: entryOop)
ifTrue: [className := self nameOfClass: entryOop lengthInto: (self addressOf: length put: [:v| length := v])]
ifFalse: [className := 'bad class'. length := 9].
'%.*s\n' f: transcript printf: { length. className }.
^false].
(objectMemory isImmediate: entryOop)
ifTrue:
[entryOop = TraceIncrementalGC ifTrue:
[self print: '**IncrementalGC**\n'. ^false].
entryOop = TraceFullGC ifTrue:
[self print: '**FullGC**\n'. ^false].
entryOop = TraceCodeCompaction ifTrue:
[self print: '**CompactCode**\n'. ^false].
entryOop = TraceStackOverflow ifTrue:
[self print: '**StackOverflow**\n'. ^false].
entryOop = TracePrimitiveFailure ifTrue:
[self print: '**PrimitiveFailure** '. ^true].
entryOop = TracePrimitiveRetry ifTrue:
[self print: '**PrimitiveRetry**\n'. ^false].
self print: '???\n']
ifFalse:
[(objectMemory addressCouldBeObj: entryOop)
ifFalse: ['%ld!!!!!!\n' f: transcript printf: i]
ifTrue:
[(objectMemory isCompiledMethod: entryOop)
ifTrue:
[| methodClass methodSel |
className := '???'. length := 3.
methodClass := self safeMethodClassOf: entryOop.
methodClass ~= objectMemory nilObject ifTrue:
[className := self nameOfClass: methodClass lengthInto: (self addressOf: length put: [:v| length := v])].
methodSel := self findSelectorOfMethod: entryOop.
methodSel = objectMemory nilObject
ifTrue:
+ ['%.*s>>(selector not found)\n'
- ['%.*s>>bad selector %p\n'
f: transcript
+ printf: { length. className }]
- printf: { length. className. methodSel }]
ifFalse:
['%.*s>>#%.*s\n'
f: transcript
printf: { length. className.
objectMemory numBytesOfBytes: methodSel. objectMemory firstIndexableField: methodSel }]]
ifFalse: [objectMemory safePrintStringOf: entryOop. self cr]]].
^false!
Item was changed:
----- Method: CogBlockMethod>>isCMMethodEtAl (in category 'testing') -----
isCMMethodEtAl
<inline: true>
+ ^self cmType >= CMMethod!
- ^self cmType = CMMethod!
Item was added:
+ ----- Method: CogBlockMethod>>isCMMethodFlaggedForBecome (in category 'testing') -----
+ isCMMethodFlaggedForBecome
+ <inline: true>
+ ^self cmType = CMMethodFlaggedForBecome!
Item was changed:
SharedPool subclass: #CogMethodConstants
instanceVariableNames: ''
+ classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMMethodFlaggedForBecome CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallIsExternalCall PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
- classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallIsExternalCall PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
poolDictionaries: ''
category: 'VMMaker-JIT'!
Item was changed:
----- Method: CogMethodSurrogate>>isCMMethodEtAl (in category 'testing') -----
isCMMethodEtAl
+ ^self cmType >= CMMethod!
- ^self cmType = CMMethod!
Item was added:
+ ----- Method: CogMethodSurrogate>>isCMMethodFlaggedForBecome (in category 'testing') -----
+ isCMMethodFlaggedForBecome
+ ^self cmType = CMMethodFlaggedForBecome!
Item was changed:
----- Method: CogMethodSurrogate>>menuPrompt (in category 'breakpoints') -----
menuPrompt
^String streamContents:
[:s|
s
nextPut: $(;
+ nextPutAll: (#(CMFree CMClosedPIC CMOpenPIC CMBlock CMMethod CMMethodFlaggedForBecome)
+ detect: [:k| (CogMethodConstants at: k) = self cmType]
+ ifNone: [self cmType printString]);
- nextPutAll: (#('CMFree ' 'CMMethod' 'CMBlock' 'CMClosedPIC' 'CMOpenPIC') at: self cmType);
space;
nextPutAll: address hex;
space.
(self isCMMethodEtAl or: [self isCMClosedPIC or: [self isCMOpenPIC]]) ifTrue:
[s nextPutAll: ((cogit objectMemory isBytes: self selector)
ifTrue: [cogit coInterpreter stringOf: self selector]
ifFalse: [self selector = cogit objectMemory nilObject
ifTrue: ['(nil)']
ifFalse: [self selector hex]])].
s nextPut: $)]!
Item was changed:
----- Method: CogMethodZone>>addToYoungReferrers: (in category 'young referers') -----
+ addToYoungReferrers: writableCogMethod
+ <var: #writableCogMethod type: #'CogMethod *'>
+ cogit assertValidDualZoneWriteAddress: writableCogMethod.
+ self assert: (self occurrencesInYoungReferrers: writableCogMethod) = 0.
+ self assert: writableCogMethod cmRefersToYoung.
- addToYoungReferrers: cogMethod
- <var: #cogMethod type: #'CogMethod *'>
- cogit assertValidDualZoneWriteAddress: cogMethod.
- self assert: (self occurrencesInYoungReferrers: cogMethod) = 0.
- self assert: cogMethod cmRefersToYoung.
self assert: (youngReferrers <= limitAddress
and: [youngReferrers >= (limitAddress - (methodCount * objectMemory wordSize))]).
(self asserta: limitAddress - (methodCount * objectMemory wordSize) >= mzFreeStart) ifFalse:
[self error: 'no room on youngReferrers list'].
youngReferrers := youngReferrers - objectMemory wordSize.
cogit
codeLongAt: youngReferrers
+ put: writableCogMethod asUnsignedInteger - cogit getCodeToDataDelta!
- put: cogMethod asUnsignedInteger - cogit getCodeToDataDelta!
Item was changed:
----- Method: CogMethodZone>>freeMethod: (in category 'compaction') -----
freeMethod: cogMethod
<var: #cogMethod type: #'CogMethod *'>
<inline: false>
| writableMethod |
self deny: cogMethod isCMFree.
self assert: (cogit cogMethodDoesntLookKosher: cogMethod) = 0.
cogit ensureWritableCodeZone.
cogMethod isCMMethodEtAl ifTrue:
+ [cogMethod isCMMethodFlaggedForBecome
- ["For non-Newspeak there should be a one-to-one mapping between bytecoded and
- cog methods. For Newspeak not necessarily, but only for anonymous accessors."
- "Only reset the original method's header if it is referring to this CogMethod."
- (coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger
ifTrue:
+ [NewspeakVM ifTrue:
+ [self removeFromUnpairedMethodList: cogMethod]]
- [coInterpreter rawHeaderOf: cogMethod methodObject put: cogMethod methodHeader.
- NewspeakVM ifTrue:
- [(objectRepresentation canPinObjects and: [cogMethod nextMethodOrIRCs > self zoneEnd]) ifTrue:
- [objectRepresentation freeIRCs: cogMethod nextMethodOrIRCs]]]
ifFalse:
+ ["For non-Newspeak there should be a one-to-one mapping between bytecoded and
+ cog methods. For Newspeak not necessarily, but only for anonymous accessors."
+ "Only reset the original method's header if it is referring to this CogMethod."
+ (coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger
+ ifTrue:
+ [coInterpreter rawHeaderOf: cogMethod methodObject put: cogMethod methodHeader.
+ NewspeakVM ifTrue:
+ [(objectRepresentation canPinObjects and: [cogMethod nextMethodOrIRCs > self zoneEnd]) ifTrue:
+ [objectRepresentation freeIRCs: cogMethod nextMethodOrIRCs]]]
+ ifFalse:
+ [self cCode: [self assert: (cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject]
+ inSmalltalk: [self assert: ((cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject
+ or: [coInterpreter isKindOf: CurrentImageCoInterpreterFacade])].
+ NewspeakVM ifTrue:
+ [self removeFromUnpairedMethodList: cogMethod]]].
- [self cCode: [self assert: (cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject]
- inSmalltalk: [self assert: ((cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject
- or: [coInterpreter isKindOf: CurrentImageCoInterpreterFacade])].
- NewspeakVM ifTrue:
- [self removeFromUnpairedMethodList: cogMethod]].
cogit maybeFreeCountersOf: cogMethod].
cogMethod isCMOpenPIC ifTrue:
[self removeFromOpenPICList: cogMethod].
writableMethod := cogit writableMethodFor: cogMethod.
writableMethod cmRefersToYoung: false.
writableMethod cmType: CMFree.
methodBytesFreedSinceLastCompaction := methodBytesFreedSinceLastCompaction
+ cogMethod blockSize!
Item was changed:
----- Method: CogMethodZone>>printCogMethodsSummarizing: (in category 'printing') -----
printCogMethodsSummarizing: summarize
<inline: true>
+ | cogMethod nm nc no nf nu nb |
- | cogMethod nm nc no nf nu |
<var: #cogMethod type: #'CogMethod *'>
+ nm := nb := nc := no := nf := nu := 0.
- nm := nc := no := nf := nu := 0.
cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
[summarize ifFalse:
[coInterpreter printCogMethod: cogMethod].
cogMethod cmType
caseOf: {
[CMFree] -> [nf := nf + 1].
[CMMethod] -> [nm := nm + 1].
+ [CMMethodFlaggedForBecome] -> [nb := nb + 1].
[CMClosedPIC] -> [nc := nc + 1].
[CMOpenPIC] -> [no:= no+ 1] }
otherwise: [nu := nu + 1].
cogMethod := self methodAfter: cogMethod].
+ coInterpreter print: 'CMMethod '; printNum: nm.
+ nb > 0 ifTrue:
+ [coInterpreter print: ' (flagged for become: '; printNum: nb; print: ')'].
+ coInterpreter print: ' CMClosedPIC '; printNum: nc; print: ' CMOpenPIC '; printNum: no; print: ' CMFree '; printNum: nf.
- coInterpreter print: 'CMMethod '; printNum: nm; print: ' CMClosedPIC '; printNum: nc; print: ' CMOpenPIC '; printNum: no; print: ' CMFree '; printNum: nf.
nu > 0 ifTrue:
[coInterpreter print: ' UNKNOWN '; printNum: nu].
+ coInterpreter print: ' total '; printNum: nm+nc+no+nf+nu+nb; cr!
- coInterpreter print: ' total '; printNum: nm+nc+no+nf+nu; cr!
Item was changed:
----- Method: Cogit class>>initializeCogMethodConstants (in category 'class initialization') -----
initializeCogMethodConstants
+ CMMethodFlaggedForBecome := 1 + (CMMethod := 1 + (CMBlock := 1 + (CMOpenPIC := 1 + (CMClosedPIC := 1 + (CMFree := 1)))))!
- CMOpenPIC := 1 + (CMClosedPIC := 1 + (CMBlock := 1 + (CMMethod := 1 + (CMFree := 1))))!
Item was changed:
+ ----- Method: Cogit>>allMachineCodeObjectReferencesValid (in category 'garbage collection & become') -----
- ----- Method: Cogit>>allMachineCodeObjectReferencesValid (in category 'garbage collection') -----
allMachineCodeObjectReferencesValid
"Check that all methods have valid selectors, and that all linked sends are to valid targets and have valid cache tags"
| ok cogMethod |
<var: #cogMethod type: #'CogMethod *'>
ok := true.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod isCMFree ifFalse:
[(self asserta: (objectRepresentation checkValidOopReference: cogMethod selector)) ifFalse:
[ok := false].
(self asserta: (self cogMethodDoesntLookKosher: cogMethod) = 0) ifFalse:
[ok := false]].
(cogMethod isCMMethodEtAl
or: [cogMethod isCMOpenPIC]) ifTrue:
[(self asserta: ((self mapFor: cogMethod
performUntil: #checkIfValidOopRefAndTarget:pc:cogMethod:
arg: cogMethod) = 0)) ifFalse:
[ok := false]].
(cogMethod isCMMethodEtAl
and: [(NewspeakVM or: [SistaVM])
and: [objectRepresentation canPinObjects]]) ifTrue:
[(SistaVM and: [cogMethod counters ~= 0]) ifTrue:
[(self asserta: (objectRepresentation checkValidDerivedObjectReference: cogMethod counters)) ifFalse:
[ok := false]].
(NewspeakVM and: [cogMethod nextMethodOrIRCs ~= 0]) ifTrue:
[(cogMethod nextMethodOrIRCs > methodZone zoneEnd) ifTrue:
[(self asserta: (objectRepresentation checkValidDerivedObjectReference: cogMethod nextMethodOrIRCs)) ifFalse:
[ok := false]]]].
cogMethod isCMClosedPIC ifTrue:
[(self asserta: (self noTargetsFreeInClosedPIC: cogMethod)) ifFalse:
[ok := false]].
cogMethod := methodZone methodAfter: cogMethod].
^ok!
Item was changed:
+ ----- Method: Cogit>>allMethodsHaveCorrectHeader (in category 'garbage collection & become') -----
- ----- Method: Cogit>>allMethodsHaveCorrectHeader (in category 'garbage collection') -----
allMethodsHaveCorrectHeader
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod isCMMethodEtAl ifTrue:
[(objectRepresentation hasValidHeaderPostGC: cogMethod) ifFalse:
[^false]].
cogMethod := methodZone methodAfter: cogMethod].
^true!
Item was changed:
+ ----- Method: Cogit>>checkIfValidOopRef:pc:cogMethod: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>checkIfValidOopRef:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidOopRef: annotation pc: mcpc cogMethod: cogMethod
"Check for a valid object reference, if any, at a map entry. Answer a code unique to each error for debugging."
<var: #mcpc type: #'char *'>
<var: #cogMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[| literal |
literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation checkValidOopReference: literal) ifFalse:
[coInterpreter print: 'object ref leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; eekcr.
^1]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache enclosingObject |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
[(objectRepresentation checkValidOopReference: nsSendCache selector) ifFalse:
[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; eekcr.
^1]].
(enclosingObject := nsSendCache enclosingObject) ~= 0 ifTrue:
[[(objectRepresentation checkValidOopReference: enclosingObject) ifFalse:
[coInterpreter print: 'enclosing object leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; eekcr.
^1]]]]].
(self isPureSendAnnotation: annotation) ifTrue:
[| entryPoint selectorOrCacheTag offset |
entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint <= methodZoneBase
ifTrue:
[offset := entryPoint]
ifFalse:
[self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:off :table| offset := off]].
selectorOrCacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
(entryPoint > methodZoneBase
and: [offset ~= cmNoCheckEntryOffset
and: [(self cCoerceSimple: entryPoint - offset to: #'CogMethod *') isCMOpenPIC not]])
ifTrue: "linked non-super send, cacheTag is a cacheTag"
[(objectRepresentation validInlineCacheTag: selectorOrCacheTag) ifFalse:
[coInterpreter print: 'cache tag leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; eekcr.
^1]]
ifFalse: "unlinked send or super send; cacheTag is a selector unless 64-bit, in which case it is an index."
[(self inlineCacheTagsAreIndexes
or: [objectRepresentation checkValidOopReference: selectorOrCacheTag]) ifFalse:
[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; eekcr.
^1]]].
^0 "keep scanning"!
Item was changed:
+ ----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidOopRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
"Check for a valid object reference, if any, at a map entry. Answer a code unique to each error for debugging."
<var: #mcpc type: #'char *'>
<var: #cogMethod type: #'CogMethod *'>
| literal entryPoint |
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(self asserta: (objectRepresentation checkValidOopReference: literal)) ifFalse:
[^1].
((objectRepresentation couldBeObject: literal)
and: [objectMemory isReallyYoungObject: literal]) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
[^2]]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache classTag enclosingObject nsTargetMethod |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
(self asserta: (objectRepresentation checkValidOopReference: nsSendCache selector)) ifFalse:
[^9].
classTag := nsSendCache classTag.
(self asserta: (classTag = 0 or: [objectRepresentation validInlineCacheTag: classTag])) ifFalse:
[^10].
enclosingObject := nsSendCache enclosingObject.
(self asserta: (enclosingObject = 0 or: [objectRepresentation checkValidOopReference: enclosingObject])) ifFalse:
[^11].
entryPoint := nsSendCache target.
entryPoint ~= 0 ifTrue: [
nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
(self asserta: (nsTargetMethod isCMMethodEtAl)) ifFalse:
[^12]]]].
(self isPureSendAnnotation: annotation) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') isCMMethodEtAl) ifFalse:
[^3].
self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPt :cacheTag :tagCouldBeObject|
entryPoint := entryPt.
tagCouldBeObject
ifTrue:
[(objectRepresentation couldBeObject: cacheTag)
ifTrue:
[(self asserta: (objectRepresentation checkValidOopReference: cacheTag)) ifFalse:
[^4]]
ifFalse:
[(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
[^5]].
((objectRepresentation couldBeObject: cacheTag)
and: [objectMemory isReallyYoungObject: cacheTag]) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
[^6]]]
ifFalse:
[(self inlineCacheTagsAreIndexes
and: [self entryPointTagIsSelector: entryPoint])
ifTrue:
[cacheTag signedIntFromLong < 0
ifTrue:
[cacheTag signedIntFromLong negated > NumSpecialSelectors ifTrue:
[^7]]
ifFalse:
[cacheTag >= (objectMemory literalCountOf: enumeratingCogMethod methodObject) ifTrue:
[^8]]]
ifFalse:
[(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
[^9]]]].
entryPoint > methodZoneBase ifTrue:
["It's a linked send; find which kind."
self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
(self asserta: (targetMethod isCMMethodEtAl
or: [targetMethod isCMClosedPIC
or: [targetMethod isCMOpenPIC]])) ifFalse:
[^10]]]].
^0 "keep scanning"!
Item was changed:
+ ----- Method: Cogit>>checkMaybeObjRefInClosedPIC: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>checkMaybeObjRefInClosedPIC: (in category 'garbage collection') -----
checkMaybeObjRefInClosedPIC: maybeObject
maybeObject = 0 ifTrue:
[^true].
(objectRepresentation couldBeObject: maybeObject) ifFalse:
[^true].
^objectRepresentation checkValidObjectReference: maybeObject!
Item was changed:
+ ----- Method: Cogit>>checkValidObjectReferencesInClosedPIC: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>checkValidObjectReferencesInClosedPIC: (in category 'garbage collection') -----
checkValidObjectReferencesInClosedPIC: cPIC
<var: #cPIC type: #'CogMethod *'>
| ok pc |
ok := true.
pc := cPIC asInteger + firstCPICCaseOffset.
"first we check the obj ref at the beginning of the CPIC"
(self checkMaybeObjRefInClosedPIC: (backEnd literalBeforeFollowingAddress: pc - backEnd jumpLongByteSize)) ifFalse:
[self print: 'object leak in CPIC '; printHex: cPIC asInteger;
print: ' @ '; printHex: pc - backEnd jumpLongByteSize; cr.
ok := false].
"Next we step over each case that is in use. We find the end address of the cPICNumCases'th case and can then just step forward by the case size thereafter"
pc := self addressOfEndOfCase: cPIC cPICNumCases inCPIC: cPIC.
"For each case we check any object reference at the end address - sizeof(conditional instruction) and then increment the end address by case size"
2 to: cPIC cPICNumCases do:
[:i|
(self inlineCacheTagsAreIndexes not
and: [objectRepresentation inlineCacheTagsMayBeObjects]) ifTrue:
[(self checkMaybeObjRefInClosedPIC: (backEnd literal32BeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize)) ifFalse:
[self print: 'object leak in CPIC '; printHex: cPIC asInteger;
print: ' @ '; printHex: pc - backEnd jumpLongConditionalByteSize - backEnd loadLiteralByteSize; cr.
ok := false]].
(self checkMaybeObjRefInClosedPIC: (backEnd literalBeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize - backEnd cmpC32RTempByteSize)) ifFalse:
[self print: 'object leak in CPIC '; printHex: cPIC asInteger;
print: ' @ '; printHex: pc - backEnd jumpLongConditionalByteSize; cr.
ok := false].
pc := pc + cPICCaseSize].
^ok!
Item was changed:
+ ----- Method: Cogit>>closedPICRefersToUnmarkedObject: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>closedPICRefersToUnmarkedObject: (in category 'garbage collection') -----
closedPICRefersToUnmarkedObject: cPIC
"Answer if the ClosedPIC refers to any unmarked objects or freed/freeable target methods,
applying markAndTraceOrFreeCogMethod:firstVisit: to those targets to determine if freed/freeable."
<var: #cPIC type: #'CogMethod *'>
| pc object |
((objectMemory isImmediate: cPIC selector)
or: [objectMemory isMarked: cPIC selector]) ifFalse:
[^true].
"First jump is unconditional; subsequent ones are conditional."
"Check the potential method oop for the first case only.
Inline cache tags for the 1st case are at the send site."
pc := self addressOfEndOfCase: 1 inCPIC: cPIC.
(objectRepresentation couldBeObject: (object := backEnd literalBeforeFollowingAddress: pc - backEnd jumpLongByteSize)) ifTrue:
[(objectMemory isMarked: object) ifFalse:
[^true]].
"Check the first target"
(self markAndTraceOrFreePICTarget: (backEnd jumpLongTargetBeforeFollowingAddress: pc) in: cPIC) ifTrue:
[^true].
2 to: cPIC cPICNumCases do:
[:i|
pc := self addressOfEndOfCase: i inCPIC: cPIC.
(self inlineCacheTagsAreIndexes not
and: [objectRepresentation inlineCacheTagsMayBeObjects
and: [objectRepresentation couldBeObject: (object := backEnd literal32BeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize)]]) ifTrue:
[(objectMemory isMarked: object) ifFalse:
[^true]].
"Check the potential method oop for subsequent cases."
(objectRepresentation couldBeObject: (object := backEnd literalBeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize - backEnd cmpC32RTempByteSize)) ifTrue:
[(objectMemory isMarked: object) ifFalse:
[^true]].
"Check subsequent targets"
(self markAndTraceOrFreePICTarget: (backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc) in: cPIC) ifTrue:
[^true]].
^false!
Item was changed:
----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
cog: aMethodObj selector: aSelectorOop
"Attempt to produce a machine code method for the bytecode method
object aMethodObj. N.B. If there is no code memory available do *NOT*
attempt to reclaim the method zone. Certain clients (e.g. ceSICMiss:)
depend on the zone remaining constant across method generation."
<api>
<returnTypeC: #'CogMethod *'>
| selector cogMethod |
<var: #cogMethod type: #'CogMethod *'>
(self exclude: aMethodObj selector: aSelectorOop) ifTrue:
[^nil].
"In Newspeak we support anonymous accessors and hence tolerate the same
method being cogged multiple times. But only if the method class association is nil."
NewspeakVM
ifTrue:
[(coInterpreter methodHasCogMethod: aMethodObj) ifTrue:
[cogMethod := coInterpreter cogMethodOf: aMethodObj.
self deny: cogMethod selector = aSelectorOop.
cogMethod selector = aSelectorOop ifTrue:
[^cogMethod].
(coInterpreter methodClassAssociationOf: aMethodObj) ~= objectMemory nilObject ifTrue:
[self cCode: 'extern void *firstIndexableField(sqInt)'. "Slang, au natural"
self warnMultiple: cogMethod selectors: aSelectorOop.
^nil]]]
ifFalse: [self deny: (coInterpreter methodHasCogMethod: aMethodObj)].
- self deny: (objectMemory isOopCompiledMethod: (coInterpreter ultimateLiteralOf: aMethodObj)).
selector := aSelectorOop = objectMemory nilObject
ifTrue: [coInterpreter maybeSelectorOfMethod: aMethodObj]
ifFalse: [aSelectorOop].
"coInterpreter stringOf: selector"
selector ifNotNil:
[coInterpreter compilationBreakpoint: selector isMNUCase: false].
aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
NewspeakVM ifTrue:
[cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
cogMethod ifNotNil:
[(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
[self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
cogMethod methodObject: aMethodObj.
coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
^cogMethod]].
+ objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
"If the generators for the alternate bytecode set are missing then interpret."
(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
ifTrue:
[(self numElementsIn: generatorTable) <= 256 ifTrue:
[^nil].
bytecodeSetOffset := 256]
ifFalse:
[bytecodeSetOffset := 0].
+ self deny: (objectMemory isOopCompiledMethod: (coInterpreter ultimateLiteralOf: aMethodObj)).
- objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
methodObj := aMethodObj.
methodHeader := objectMemory methodHeaderOf: aMethodObj.
receiverTags := -1. "lazy initialization"
cogMethod := self compileCogMethod: aSelectorOop.
(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
[cogMethod asInteger = InsufficientCodeSpace ifTrue:
[coInterpreter callForCogCompiledCodeCompaction].
self maybeFreeCounters.
"Right now no errors should be reported, so nothing more to do."
"self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
^nil].
"self cCode: ''
inSmalltalk:
[coInterpreter printCogMethod: cogMethod.
""coInterpreter symbolicMethod: aMethodObj.""
self assertValidMethodMap: cogMethod."
"self disassembleMethod: cogMethod."
"printInstructions := clickConfirm := true""]."
^cogMethod!
Item was changed:
----- Method: Cogit>>cogFullBlockMethod:numCopied: (in category 'jit - api') -----
cogFullBlockMethod: aMethodObj numCopied: numCopied
"Attempt to produce a machine code method for the bytecode method
object aMethodObj. N.B. If there is no code memory available do *NOT*
attempt to reclaim the method zone. Certain clients (e.g. ceSICMiss:)
depend on the zone remaining constant across method generation."
<api>
<option: #SistaV1BytecodeSet>
<returnTypeC: #'CogMethod *'>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
(self exclude: aMethodObj) ifTrue:
[^nil].
self deny: (coInterpreter methodHasCogMethod: aMethodObj).
- self assert: (objectMemory isOopCompiledMethod: (coInterpreter ultimateLiteralOf: aMethodObj)).
aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
+ objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
"If the generators for the alternate bytecode set are missing then interpret."
(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
ifTrue:
[(self numElementsIn: generatorTable) <= 256 ifTrue:
[^nil].
bytecodeSetOffset := 256]
ifFalse:
[bytecodeSetOffset := 0].
+ self assert: (objectMemory isOopCompiledMethod: (coInterpreter ultimateLiteralOf: aMethodObj)).
- objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
methodObj := aMethodObj.
methodHeader := objectMemory methodHeaderOf: aMethodObj.
receiverTags := -1. "lazy initialization"
cogMethod := self compileCogFullBlockMethod: numCopied.
(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
[cogMethod asInteger = InsufficientCodeSpace ifTrue:
[coInterpreter callForCogCompiledCodeCompaction].
self maybeFreeCounters.
"Right now no errors should be reported, so nothing more to do."
"self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
^nil].
"self cCode: ''
inSmalltalk:
[coInterpreter printCogMethod: cogMethod.
""coInterpreter symbolicMethod: aMethodObj.""
self assertValidMethodMap: cogMethod."
"self disassembleMethod: cogMethod."
"printInstructions := clickConfirm := true""]."
^cogMethod!
Item was changed:
----- Method: Cogit>>fillInMethodHeader:size:selector: (in category 'generate machine code') -----
fillInMethodHeader: method size: size selector: selector
+ "Fill in the header for theCogMethod method. This may be located at the writable mapping."
- "Fill in the header for theCogMehtod method. This may be located at the writable mapping."
<var: #method type: #'CogMethod *'>
| originalMethod rawHeader actualMethodLocation |
<var: #originalMethod type: #'CogMethod *'>
actualMethodLocation := method asUnsignedInteger - codeToDataDelta.
method cmType: CMMethod.
method objectHeader: objectMemory nullHeaderForMachineCodeMethod.
method blockSize: size.
method methodObject: methodObj.
rawHeader := coInterpreter rawHeaderOf: methodObj.
"If the method has already been cogged (e.g. Newspeak accessors) then
leave the original method attached to its cog method, but get the right header."
(coInterpreter isCogMethodReference: rawHeader)
ifTrue:
[originalMethod := self cCoerceSimple: rawHeader to: #'CogMethod *'.
self assert: originalMethod blockSize = size.
self assert: methodHeader = originalMethod methodHeader.
NewspeakVM ifTrue:
[methodZone addToUnpairedMethodList: method]]
ifFalse:
[coInterpreter rawHeaderOf: methodObj put: actualMethodLocation.
NewspeakVM ifTrue:
[method nextMethodOrIRCs: theIRCs]].
method methodHeader: methodHeader.
method selector: selector.
method cmNumArgs: (coInterpreter argumentCountOfMethodHeader: methodHeader).
method cmHasMovableLiteral: hasMovableLiteral.
(method cmRefersToYoung: hasYoungReferent) ifTrue:
[methodZone addToYoungReferrers: method].
method cmUsageCount: self initialMethodUsageCount.
method cpicHasMNUCase: false.
method cmUsesPenultimateLit: maxLitIndex >= ((objectMemory literalCountOfMethodHeader: methodHeader) - 2).
method blockEntryOffset: (blockEntryLabel notNil
ifTrue: [blockEntryLabel address - actualMethodLocation]
ifFalse: [0]).
"This can be an error check since a large stackCheckOffset is caused by compiling
a machine-code primitive, and hence depends on the Cogit, not the input method."
needsFrame ifTrue:
[stackCheckLabel address - actualMethodLocation <= MaxStackCheckOffset ifFalse:
[self error: 'too much code for stack check offset']].
method stackCheckOffset: (needsFrame
ifTrue: [stackCheckLabel address - actualMethodLocation]
ifFalse: [0]).
self assert: (backEnd callTargetFromReturnAddress: actualMethodLocation + missOffset)
= (self methodAbortTrampolineFor: method cmNumArgs).
self assert: size = (methodZone roundUpLength: size).
self assertValidDualZoneFrom: actualMethodLocation to: actualMethodLocation + size.
self maybeEnableSingleStep!
Item was added:
+ ----- Method: Cogit>>flagCogMethodForBecome: (in category 'garbage collection & become') -----
+ flagCogMethodForBecome: cogMethod
+ <api>
+ <var: 'cogMethod' type: #'CogMethod *'>
+ self assert: cogMethod isCMMethodEtAl.
+ self ensureWritableCodeZone.
+ (self writableMethodFor: cogMethod) cmType: CMMethodFlaggedForBecome!
Item was changed:
+ ----- Method: Cogit>>followForwardedLiteralsImplementationIn: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>followForwardedLiteralsImplementationIn: (in category 'garbage collection') -----
followForwardedLiteralsImplementationIn: cogMethod
<option: #SpurObjectMemory>
<var: #cogMethod type: #'CogMethod *'>
| writableCogMethod hasYoungObj hasYoungObjPtr |
self assert: (cogMethod isCMMethodEtAl not or: [(objectMemory isForwarded: cogMethod methodObject) not]).
writableCogMethod := self writableMethodFor: cogMethod.
hasYoungObj := objectMemory isYoung: cogMethod methodObject.
(objectMemory shouldRemapOop: cogMethod selector) ifTrue:
[writableCogMethod selector: (objectMemory remapObj: cogMethod selector).
(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true]].
hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
self mapFor: cogMethod
performUntil: #remapIfObjectRef:pc:hasYoung:
arg: hasYoungObjPtr asVoidPointer.
hasYoungObj
ifTrue: [methodZone ensureInYoungReferrers: cogMethod]
ifFalse: [writableCogMethod cmRefersToYoung: false]!
Item was changed:
+ ----- Method: Cogit>>followForwardedLiteralsIn: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>followForwardedLiteralsIn: (in category 'garbage collection') -----
followForwardedLiteralsIn: cogMethod
<api>
<option: #SpurObjectMemory>
<var: #cogMethod type: #'CogMethod *'>
| wasInYoungReferrers |
self ensureWritableCodeZone.
wasInYoungReferrers := cogMethod cmRefersToYoung.
self followForwardedLiteralsImplementationIn: cogMethod.
(wasInYoungReferrers and: [cogMethod cmRefersToYoung not]) ifTrue:
[self pruneYoungReferrers].
self ensureExecutableCodeZone!
Item was changed:
+ ----- Method: Cogit>>followForwardedMethods (in category 'garbage collection & become') -----
- ----- Method: Cogit>>followForwardedMethods (in category 'garbage collection') -----
followForwardedMethods
<api>
<option: #SpurObjectMemory>
| cogMethod freedPIC |
self ensureWritableCodeZone.
freedPIC := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod isCMMethodEtAl ifTrue:
[(objectMemory isForwarded: cogMethod methodObject) ifTrue:
[cogMethod methodObject: (objectMemory followForwarded: cogMethod methodObject).
(objectMemory isYoungObject: cogMethod methodObject) ifTrue:
[methodZone ensureInYoungReferrers: cogMethod]]].
cogMethod isCMClosedPIC ifTrue:
[(self followMethodReferencesInClosedPIC: cogMethod) ifTrue:
[freedPIC := true.
methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod].
freedPIC ifTrue:
[self unlinkSendsToFree].
self ensureExecutableCodeZone!
Item was changed:
+ ----- Method: Cogit>>followMaybeObjRefInClosedPICAt: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>followMaybeObjRefInClosedPICAt: (in category 'garbage collection') -----
followMaybeObjRefInClosedPICAt: mcpc
"Follow a potential object reference from a closed PIC.
This may be a method reference or null.
Answer if the followed literal is young.
'mcpc' refers to the jump/branch instruction at the end of
each cpic case"
| object subject |
object := backEnd literalBeforeFollowingAddress: mcpc.
(objectRepresentation couldBeObject: object) ifFalse:
[^false].
(objectMemory isForwarded: object) ifFalse:
[^objectMemory isYoungObject: object].
subject := objectMemory followForwarded: object.
self setCodeModified.
backEnd storeLiteral: subject beforeFollowingAddress: mcpc.
^objectMemory isYoungObject: subject!
Item was changed:
+ ----- Method: Cogit>>followMethodReferencesInClosedPIC: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>followMethodReferencesInClosedPIC: (in category 'garbage collection') -----
followMethodReferencesInClosedPIC: cPIC
"Remap all object references in the closed PIC. Answer if any references are young.
Set codeModified if any modifications are made."
<var: #cPIC type: #'CogMethod *'>
| pc refersToYoung |
pc := self addressOfEndOfCase: 1 inCPIC: cPIC.
"first we check the potential method oop load at the beginning of the CPIC"
refersToYoung := self followMaybeObjRefInClosedPICAt: pc - backEnd jumpLongByteSize.
"We find the end address of the cPICNumCases'th case and can then just step forward by the case size thereafter"
pc := self addressOfEndOfCase: cPIC cPICNumCases inCPIC: cPIC.
"Next we check the potential potential method oop load for each case."
2 to: cPIC cPICNumCases do:
[:i|
(self followMaybeObjRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize - backEnd cmpC32RTempByteSize) ifTrue:
[refersToYoung := true].
pc := pc + cPICCaseSize].
^refersToYoung!
Item was changed:
+ ----- Method: Cogit>>followMovableLiteralsAndUpdateYoungReferrers (in category 'garbage collection & become') -----
- ----- Method: Cogit>>followMovableLiteralsAndUpdateYoungReferrers (in category 'garbage collection') -----
followMovableLiteralsAndUpdateYoungReferrers
"To avoid runtime checks on literal variable and literal accesses in == and ~~,
we follow literals in methods having movable literals in the postBecome action.
To avoid scanning every method, we annotate cogMethods with the
cmHasMovableLiteral flag."
<option: #SpurObjectMemory>
<api>
<returnTypeC: #void>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
self assert: methodZone kosherYoungReferrers.
"methodZone firstBogusYoungReferrer"
"methodZone occurrencesInYoungReferrers: methodZone firstBogusYoungReferrer"
codeModified := false.
self ensureWritableCodeZone.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod isCMFree or: [cogMethod isCMMethodFlaggedForBecome]) ifFalse:
- [cogMethod isCMFree not ifTrue:
[cogMethod cmHasMovableLiteral ifTrue:
[self followForwardedLiteralsImplementationIn: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod].
methodZone pruneYoungReferrers.
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone freeStart].
"And ensure code zone is executable. May have pruned young referrers..."
self ensureExecutableCodeZone!
Item was added:
+ ----- Method: Cogit>>freeBecomeFlaggedMethods (in category 'garbage collection & become') -----
+ freeBecomeFlaggedMethods
+ <api>
+ "N.B. because becomeEffectFlags indicates whether jitted methods were
+ becommed or not, if this method is called flagged methods exist, will be
+ freed, and so on. So there is no need to check. Just do it."
+ | cogMethod |
+ self ensureWritableCodeZone.
+
+ cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
+ [cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodFlaggedForBecome ifTrue:
+ [self freeMethod: cogMethod].
+ cogMethod := methodZone methodAfter: cogMethod].
+
+ self unlinkSendsToFree.
+
+ self ensureExecutableCodeZone!
Item was changed:
+ ----- Method: Cogit>>mapObjectReferencesInClosedPIC: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>mapObjectReferencesInClosedPIC: (in category 'garbage collection') -----
mapObjectReferencesInClosedPIC: cPIC
"Remap all object references in the closed PIC. Answer if any references are young.
Set codeModified if any modifications are made."
<var: #cPIC type: #'CogMethod *'>
| pc refersToYoung |
pc := self addressOfEndOfCase:1 inCPIC:cPIC.
"first we check the potential method oop load at the beginning of the CPIC"
refersToYoung := self remapMaybeObjRefInClosedPICAt: pc - backEnd jumpLongByteSize.
"We find the end address of the cPICNumCases'th case and can then just step forward by the case size thereafter"
pc := self addressOfEndOfCase: cPIC cPICNumCases inCPIC: cPIC.
"Next we check the potential class ref in the compare instruction, and the potential method oop load for each case."
2 to: cPIC cPICNumCases do:
[:i|
(self inlineCacheTagsAreIndexes not
and: [objectRepresentation inlineCacheTagsMayBeObjects]) ifTrue:
[(self remapMaybeObjRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize) ifTrue:
[refersToYoung := true]].
(self remapMaybeObjRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize - backEnd cmpC32RTempByteSize) ifTrue:
[refersToYoung := true].
pc := pc + cPICCaseSize].
^refersToYoung!
Item was changed:
+ ----- Method: Cogit>>mapObjectReferencesInGeneratedRuntime (in category 'garbage collection & become') -----
- ----- Method: Cogit>>mapObjectReferencesInGeneratedRuntime (in category 'garbage collection') -----
mapObjectReferencesInGeneratedRuntime
"Update all references to objects in the generated runtime."
0 to: runtimeObjectRefIndex - 1 do:
[:i| | mcpc literal mappedLiteral |
mcpc := objectReferencesInRuntime at: i.
literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc using: backEnd.
mappedLiteral := objectRepresentation remapObject: literal.
mappedLiteral ~= literal ifTrue:
[self setCodeModified.
literalsManager storeLiteral: mappedLiteral atAnnotatedAddress: mcpc using: backEnd]]!
Item was changed:
+ ----- Method: Cogit>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection & become') -----
- ----- Method: Cogit>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForBecome
"Update all references to objects in machine code for a become.
Unlike incrementalGC or fullGC a method that does not refer to young may
refer to young as a result of the become operation. Unlike incrementalGC
or fullGC the reference from a Cog method to its methodObject *must not*
change since the two are two halves of the same object."
| cogMethod writableCogMethod hasYoungObj hasYoungObjPtr freedPIC |
hasYoungObj := false.
hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
codeModified := freedPIC := false.
self mapObjectReferencesInGeneratedRuntime.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[self assert: hasYoungObj not.
cogMethod isCMFree ifFalse:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
writableCogMethod := self writableMethodFor: cogMethod.
writableCogMethod selector: (objectRepresentation remapOop: cogMethod selector).
cogMethod isCMClosedPIC
ifTrue:
[((objectMemory isYoung: cogMethod selector)
or: [self mapObjectReferencesInClosedPIC: cogMethod]) ifTrue:
[freedPIC := true.
methodZone freeMethod: cogMethod]]
ifFalse:
[(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true].
cogMethod isCMMethodEtAl ifTrue:
[| remappedMethod |
self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
remappedMethod := objectRepresentation remapOop: cogMethod methodObject.
remappedMethod ~= cogMethod methodObject ifTrue:
[(coInterpreter methodHasCogMethod: remappedMethod) ifTrue:
[self error: 'attempt to become two cogged methods'].
(objectMemory
withoutForwardingOn: cogMethod methodObject
and: remappedMethod
with: cogMethod cmUsesPenultimateLit
sendToCogit: #method:hasSameCodeAs:checkPenultimate:) ifFalse:
[self error: 'attempt to become cogged method into different method'].
"For non-Newspeak there should ne a one-to-one mapping between bytecoded and
cog methods. For Newspeak not necessarily, but only for anonymous accessors."
"Only reset the method object's header if it is referring to this CogMethod."
(coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
ifTrue:
[coInterpreter
rawHeaderOf: cogMethod methodObject
put: cogMethod methodHeader.
writableCogMethod
methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
methodObject: remappedMethod.
coInterpreter
rawHeaderOf: remappedMethod
put: cogMethod asInteger]
ifFalse:
[self assert: (self noAssertMethodClassAssociationOf: cogMethod methodObject)
= objectMemory nilObject.
writableCogMethod
methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
methodObject: remappedMethod]].
(objectMemory isYoung: cogMethod methodObject) ifTrue:
[hasYoungObj := true]].
self mapFor: cogMethod
performUntil: #remapIfObjectRef:pc:hasYoung:
arg: hasYoungObjPtr.
hasYoungObj
ifTrue:
[methodZone ensureInYoungReferrers: cogMethod.
hasYoungObj := false]
ifFalse:
[cogMethod cmRefersToYoung: false]]].
cogMethod := methodZone methodAfter: cogMethod].
"we /must/ prune youngReferrers here because a) the [cogMethod cmRefersToYoung: false]
block could have removed a method and subsequently it could be added back, and b) we
can not tolerate duplicates in the youngReferrers list."
methodZone pruneYoungReferrers.
freedPIC ifTrue:
[self unlinkSendsToFree].
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone freeStart]!
Item was changed:
+ ----- Method: Cogit>>mapObjectReferencesInMachineCodeForFullGC (in category 'garbage collection & become') -----
- ----- Method: Cogit>>mapObjectReferencesInMachineCodeForFullGC (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForFullGC
"Update all references to objects in machine code for a full gc. Since
the current (New)ObjectMemory GC makes everything old in a full GC
a method not referring to young will not refer to young afterwards"
| cogMethod writableCogMethod |
codeModified := false.
self mapObjectReferencesInGeneratedRuntime.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod isCMFree ifFalse:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
writableCogMethod := self writableMethodFor: cogMethod.
writableCogMethod selector: (objectRepresentation remapOop: cogMethod selector).
cogMethod isCMClosedPIC
ifTrue:
[self assert: cogMethod cmRefersToYoung not.
self mapObjectReferencesInClosedPIC: cogMethod]
ifFalse:
[cogMethod isCMMethodEtAl ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
writableCogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject)].
self mapFor: cogMethod
performUntil: #remapIfObjectRef:pc:hasYoung:
arg: 0.
(cogMethod cmRefersToYoung
and: [objectRepresentation allYoungObjectsAgeInFullGC]) ifTrue:
[writableCogMethod cmRefersToYoung: false]]].
cogMethod := methodZone methodAfter: cogMethod].
methodZone pruneYoungReferrers.
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone freeStart]!
Item was changed:
+ ----- Method: Cogit>>mapObjectReferencesInMachineCodeForYoungGC (in category 'garbage collection & become') -----
- ----- Method: Cogit>>mapObjectReferencesInMachineCodeForYoungGC (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForYoungGC
"Update all references to objects in machine code for either a Spur scavenging gc
or a Squeak V3 incremental GC. Avoid scanning all code by using the youngReferrers
list. In a young gc a method referring to young may no longer refer to young, but a
method not referring to young cannot and will not refer to young afterwards."
| pointer cogMethod hasYoungObj hasYoungObjPtr zoneIsWritable |
codeModified := zoneIsWritable := hasYoungObj := false.
hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
pointer := methodZone youngReferrers.
[pointer < methodZone zoneEnd] whileTrue:
[self assert: hasYoungObj not.
cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
cogMethod isCMFree
ifTrue: [self assert: cogMethod cmRefersToYoung not]
ifFalse:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
cogMethod cmRefersToYoung ifTrue:
[| writableCogMethod |
self assert: (cogMethod isCMMethodEtAl
or: [cogMethod isCMOpenPIC]).
zoneIsWritable ifFalse:
[self ensureWritableCodeZone.
zoneIsWritable := true].
writableCogMethod := self writableMethodFor: cogMethod.
writableCogMethod selector: (objectRepresentation remapOop: cogMethod selector).
(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true].
cogMethod isCMMethodEtAl ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
writableCogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
(objectMemory isYoung: cogMethod methodObject) ifTrue:
[hasYoungObj := true]].
self mapFor: cogMethod
performUntil: #remapIfObjectRef:pc:hasYoung:
arg: hasYoungObjPtr asVoidPointer.
hasYoungObj
ifTrue: [hasYoungObj := false]
ifFalse: [writableCogMethod cmRefersToYoung: false]]].
pointer := pointer + objectMemory wordSize].
methodZone pruneYoungReferrers.
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
Item was changed:
+ ----- Method: Cogit>>markAndTraceLiteralsIn: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markAndTraceLiteralsIn: (in category 'garbage collection') -----
markAndTraceLiteralsIn: cogMethod
<option: #SpurObjectMemory>
"Unlink sends that have unmarked classes in inline caches or freed/freeable targets.
Nil-out inline caches linked to open PICs.
Assert that any selectors are marked. We can do this since
this is only run on marked methods and thus any selectors they
reference should already be marked."
<var: #cogMethod type: #'CogMethod *'>
<inline: true>
self assert: ((cogMethod isCMMethodEtAl
and: [objectMemory isMarked: cogMethod methodObject])
or: [cogMethod isCMOpenPIC
and: [(objectMemory isImmediate: cogMethod selector)
or: [objectMemory isMarked: cogMethod selector]]]).
objectRepresentation
markAndTraceLiteral: cogMethod selector
in: cogMethod
at: (self addressOf: cogMethod selector put: [:val| cogMethod selector: val]).
self maybeMarkCountersIn: cogMethod.
self maybeMarkIRCsIn: cogMethod.
self mapFor: cogMethod
performUntil: #markLiterals:pc:method:
arg: cogMethod!
Item was changed:
+ ----- Method: Cogit>>markAndTraceOrFreeCogMethod:firstVisit: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markAndTraceOrFreeCogMethod:firstVisit: (in category 'garbage collection') -----
markAndTraceOrFreeCogMethod: cogMethod firstVisit: firstVisit
"Mark and trace objects in the argument and free if it is appropriate.
Answer if the method has been freed. firstVisit is a hint used to avoid
scanning methods we've already seen. False positives are fine.
For a CMMethod this
frees if the bytecode method isnt marked,
marks and traces object literals and selectors,
unlinks sends to targets that should be freed.
For a CMClosedPIC this
frees if it refers to anything that should be freed or isn't marked.
For a CMOpenPIC this
frees if the selector isn't marked."
<var: #cogMethod type: #'CogMethod *'>
<inline: false> "this recurses at most one level down"
cogMethod isCMFree ifTrue:
[^true].
self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
cogMethod isCMMethodEtAl ifTrue:
[(objectMemory isMarked: cogMethod methodObject) ifFalse:
[self ensureWritableCodeZone.
methodZone freeMethod: cogMethod.
^true].
firstVisit ifTrue:
[self markLiteralsAndUnlinkUnmarkedSendsIn: cogMethod].
^false].
cogMethod isCMClosedPIC ifTrue:
[(self closedPICRefersToUnmarkedObject: cogMethod) ifFalse:
[^false].
self ensureWritableCodeZone.
methodZone freeMethod: cogMethod.
^true].
cogMethod isCMOpenPIC ifTrue:
[(objectMemory isMarked: cogMethod selector) ifTrue:
[^false].
self ensureWritableCodeZone.
methodZone freeMethod: cogMethod.
^true].
self assert: (cogMethod isCMMethodEtAl
or: [cogMethod isCMClosedPIC
or: [cogMethod isCMOpenPIC]]).
^false!
Item was changed:
+ ----- Method: Cogit>>markAndTraceOrFreePICTarget:in: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markAndTraceOrFreePICTarget:in: (in category 'garbage collection') -----
markAndTraceOrFreePICTarget: entryPoint in: cPIC
"If entryPoint is that of some method, then mark and trace objects in it and free if it is appropriate.
Answer if the method has been freed."
<var: #cPIC type: #'CogMethod *'>
| targetMethod |
<var: #targetMethod type: #'CogMethod *'>
self assert: (entryPoint > methodZoneBase and: [entryPoint < methodZone freeStart]).
(cPIC containsAddress: entryPoint) ifTrue:
[^false].
targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
self assert: (targetMethod isCMMethodEtAl or: [targetMethod isCMFree]).
^self markAndTraceOrFreeCogMethod: targetMethod
firstVisit: targetMethod asUnsignedInteger > cPIC asUnsignedInteger!
Item was changed:
+ ----- Method: Cogit>>markLiterals:pc:method: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markLiterals:pc:method: (in category 'garbage collection') -----
markLiterals: annotation pc: mcpc method: cogMethod
"Mark and trace literals.
Additionally in Newspeak, void push implicits that have unmarked classes."
<var: #mcpc type: #'char *'>
<var: #cogMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
| literal |
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation markAndTraceLiteral: literal in: cogMethod atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache sel eo |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
sel := nsSendCache selector.
(objectMemory isForwarded: sel)
ifFalse: [objectMemory markAndTrace: sel]
ifTrue: [sel := objectMemory followForwarded: literal.
nsSendCache selector: sel.
self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
eo := nsSendCache enclosingObject.
eo ~= 0 ifTrue:
[(objectMemory isForwarded: eo)
ifFalse: [objectMemory markAndTrace: eo]
ifTrue: [eo := objectMemory followForwarded: literal.
nsSendCache enclosingObject: eo.
self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
(self isPureSendAnnotation: annotation) ifTrue:
[self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj |
(tagCouldBeObj
and: [objectRepresentation markAndTraceCacheTagLiteral: cacheTag in: cogMethod atpc: mcpc asUnsignedInteger]) ifTrue:
["cacheTag is selector" codeModified := true]]].
^0 "keep scanning"!
Item was changed:
+ ----- Method: Cogit>>markLiteralsAndUnlinkIfUnmarkedSend:pc:method: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markLiteralsAndUnlinkIfUnmarkedSend:pc:method: (in category 'garbage collection') -----
markLiteralsAndUnlinkIfUnmarkedSend: annotation pc: mcpc method: cogMethod
"Mark and trace literals. Unlink sends that have unmarked cache tags or targets."
<var: #mcpc type: #'char *'>
<var: #cogMethod type: #'CogMethod *'>
| literal |
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation
markAndTraceLiteral: literal
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache entryPoint targetMethod sel eo |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
entryPoint := nsSendCache target.
entryPoint ~= 0 ifTrue: "Send is linked"
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
(self markAndTraceOrFreeCogMethod: targetMethod
firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:
[self voidNSSendCache: nsSendCache]].
sel := nsSendCache selector.
(objectMemory isForwarded: sel)
ifFalse: [objectMemory markAndTrace: sel]
ifTrue: [sel := objectMemory followForwarded: literal.
nsSendCache selector: sel.
self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
eo := nsSendCache enclosingObject.
eo ~= 0 ifTrue:
[(objectMemory isForwarded: eo)
ifFalse: [objectMemory markAndTrace: eo]
ifTrue: [eo := objectMemory followForwarded: literal.
nsSendCache enclosingObject: eo.
self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
(self isPureSendAnnotation: annotation) ifTrue:
[self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
(cacheTagMarked not
or: [self markAndTraceOrFreeCogMethod: targetMethod
firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger]) ifTrue:
["Either the cacheTag is unmarked (e.g. new class) or the target
has been freed (because it is unmarked), so unlink the send."
self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable.
objectRepresentation
markAndTraceLiteral: targetMethod selector
in: targetMethod
at: (self addressOf: targetMethod selector put: [:val| targetMethod selector: val])]]]
ifFalse: "cacheTag is selector"
[(objectRepresentation
markAndTraceCacheTagLiteral: cacheTag
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]]]].
^0 "keep scanning"!
Item was changed:
+ ----- Method: Cogit>>markLiteralsAndUnlinkUnmarkedSendsIn: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markLiteralsAndUnlinkUnmarkedSendsIn: (in category 'garbage collection') -----
markLiteralsAndUnlinkUnmarkedSendsIn: cogMethod
"Unlink sends that have unmarked classes in inline caches or freed/freeable targets.
Nil-out inline caches linked to open PICs.
Assert that any selectors are marked. We can do this since
this is only run on marked methods and thus any selectors they
reference should already be marked."
<var: #cogMethod type: #'CogMethod *'>
<inline: true>
self assert: cogMethod isCMMethodEtAl.
self assert: (objectMemory isMarked: cogMethod methodObject).
objectRepresentation
markAndTraceLiteral: cogMethod selector
in: cogMethod
at: (self addressOf: cogMethod selector put: [:val| cogMethod selector: val]).
self maybeMarkCountersIn: cogMethod.
self maybeMarkIRCsIn: cogMethod.
self mapFor: cogMethod
performUntil: #markLiteralsAndUnlinkIfUnmarkedSend:pc:method:
arg: cogMethod!
Item was changed:
+ ----- Method: Cogit>>markYoungObjects:pc:method: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markYoungObjects:pc:method: (in category 'garbage collection') -----
markYoungObjects: annotation pc: mcpc method: cogMethod
"Mark and trace young literals."
<var: #mcpc type: #'char *'>
<var: #cogMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
| literal |
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
objectRepresentation markAndTraceLiteralIfYoung: literal].
NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
[| nsSendCache |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
objectRepresentation markAndTraceLiteralIfYoung: nsSendCache selector.
nsSendCache enclosingObject ~= 0 ifTrue:
[objectRepresentation markAndTraceLiteralIfYoung: nsSendCache enclosingObject]]].
(self isPureSendAnnotation: annotation) ifTrue:
[self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj |
tagCouldBeObj ifTrue:
[objectRepresentation markAndTraceLiteralIfYoung: cacheTag]]].
^0 "keep scanning"!
Item was changed:
+ ----- Method: Cogit>>markYoungObjectsIn: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>markYoungObjectsIn: (in category 'garbage collection') -----
markYoungObjectsIn: cogMethod
"Mark young literals in the method."
<var: #cogMethod type: #'CogMethod *'>
<inline: true>
self assert: (cogMethod isCMMethodEtAl
or: [cogMethod isCMOpenPIC]).
(objectMemory isYoung: cogMethod selector) ifTrue:
[objectMemory markAndTrace: cogMethod selector].
(cogMethod isCMMethodEtAl
and: [objectMemory isYoung: cogMethod methodObject]) ifTrue:
[objectMemory markAndTrace: cogMethod methodObject].
self mapFor: cogMethod
performUntil: #markYoungObjects:pc:method:
arg: cogMethod!
Item was changed:
+ ----- Method: Cogit>>maybeMarkCountersIn: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>maybeMarkCountersIn: (in category 'garbage collection') -----
maybeMarkCountersIn: cogMethod
"In SIsta Spur counters are held on the heap in pinned objects which must be marked
to avoid them being garbage collected. This is the hook through which that happens."
<var: #cogMethod type: #'CogMethod *'>!
Item was changed:
+ ----- Method: Cogit>>method:hasSameCodeAs:checkPenultimate: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>method:hasSameCodeAs:checkPenultimate: (in category 'garbage collection') -----
method: methodA hasSameCodeAs: methodB checkPenultimate: comparePenultimateLiteral
"For the purposes of become: see if the two methods are similar, i.e. can be safely becommed.
This is pretty strict. All literals and bytecodes must be identical. Only trailer bytes and header
flags can differ."
<inline: false>
| headerA headerB numLitsA endPCA |
headerA := objectMemory methodHeaderOf: methodA.
headerB := objectMemory methodHeaderOf: methodB.
numLitsA := objectMemory literalCountOfMethodHeader: headerA.
endPCA := self endPCOf: methodA.
((coInterpreter argumentCountOfMethodHeader: headerA) ~= (coInterpreter argumentCountOfMethodHeader: headerB)
or: [(coInterpreter temporaryCountOfMethodHeader: headerA) ~= (coInterpreter temporaryCountOfMethodHeader: headerB)
or: [(coInterpreter primitiveIndexOfMethod: methodA header: headerA) ~= (coInterpreter primitiveIndexOfMethod: methodB header: headerB)
or: [numLitsA ~= (objectMemory literalCountOfMethodHeader: headerB)
or: [endPCA > (objectMemory numBytesOf: methodB)]]]]) ifTrue:
[^false].
1 to: numLitsA - 1 do:
[:li|
(objectMemory fetchPointer: li ofObject: methodA) ~= (objectMemory fetchPointer: li ofObject: methodB) ifTrue:
[(li < (numLitsA - 1) "If the method doesn't use the penultimate literal then don't fail the comparison."
or: [comparePenultimateLiteral]) ifTrue:
[^false]]].
(coInterpreter startPCOfMethodHeader: headerA) to: endPCA do:
[:bi|
(objectMemory fetchByte: bi ofObject: methodA) ~= (objectMemory fetchByte: bi ofObject: methodB) ifTrue:
[^false]].
^true!
Item was changed:
+ ----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
remapIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
<var: #mcpc type: #'char *'>
<var: #hasYoungPtr type: #'CogMethod *'> "to placate the C static type system..."
<var: #targetMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[| literal mappedLiteral |
literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation couldBeObject: literal) ifTrue:
[mappedLiteral := objectRepresentation remapObject: literal.
literal ~= mappedLiteral ifTrue:
[self setCodeModified.
literalsManager storeLiteral: mappedLiteral atAnnotatedAddress: mcpc asUnsignedInteger using: backEnd].
(hasYoungPtr ~= 0
and: [objectMemory isYoung: mappedLiteral]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
[| nsSendCache oop mappedOop |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc.
oop := nsSendCache selector.
mappedOop := objectRepresentation remapObject: oop.
oop ~= mappedOop ifTrue:
[nsSendCache selector: mappedOop.
(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
oop := nsSendCache enclosingObject.
oop ~= 0 ifTrue: [
mappedOop := objectRepresentation remapObject: oop.
oop ~= mappedOop ifTrue:
[nsSendCache enclosingObject: mappedOop.
(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
^0 "keep scanning"]].
(self isPureSendAnnotation: annotation) ifTrue:
[self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj | | mappedCacheTag |
(tagCouldBeObj
and: [objectRepresentation couldBeObject: cacheTag]) ifTrue:
[mappedCacheTag := objectRepresentation remapObject: cacheTag.
cacheTag ~= mappedCacheTag ifTrue:
[self setCodeModified.
backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asUnsignedInteger].
(hasYoungPtr ~= 0
and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
hasYoungPtr ~= 0 ifTrue:
["Since the unlinking routines may rewrite the cacheTag to the send's selector, and
since they don't have the cogMethod to hand and can't add it to youngReferrers,
the method must remain in youngReferrers if the targetMethod's selector is young."
entryPoint > methodZoneBase ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :ignored|
(objectMemory isYoung: targetMethod selector) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]]].
^0 "keep scanning"!
Item was changed:
+ ----- Method: Cogit>>remapMaybeObjRefInClosedPICAt: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>remapMaybeObjRefInClosedPICAt: (in category 'garbage collection') -----
remapMaybeObjRefInClosedPICAt: mcpc
"Remap a potential object reference from a closed PIC.
This may be an object reference, an inline cache tag or null.
Answer if the updated literal is young.
mcpc is the address of the next instruction following either
the load of the method literal or the compare of the class tag."
| object subject |
object := backEnd literalBeforeFollowingAddress: mcpc.
(objectRepresentation couldBeObject: object) ifFalse:
[^false].
subject := objectRepresentation remapOop: object.
object ~= subject ifTrue:
[self setCodeModified.
backEnd storeLiteral: subject beforeFollowingAddress: mcpc].
^objectMemory isYoungObject: subject!
Item was added:
+ ----- Method: Cogit>>unflagBecomeFlaggedMethods (in category 'garbage collection & become') -----
+ unflagBecomeFlaggedMethods
+ <api>
+ | cogMethod |
+ cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
+ [cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodFlaggedForBecome ifTrue:
+ [(self writableMethodFor: cogMethod) cmType: CMMethod].
+ cogMethod := methodZone methodAfter: cogMethod]!
Item was added:
+ ----- Method: Cogit>>whereIs: (in category 'debugging') -----
+ whereIs: aValue
+ <doNotGenerate>
+ ^coInterpreter whereIs: aValue!
Item was changed:
+ ----- Method: Cogit>>withAnnotation:pc:evaluate: (in category 'garbage collection & become') -----
- ----- Method: Cogit>>withAnnotation:pc:evaluate: (in category 'garbage collection') -----
withAnnotation: annotation pc: mcpc evaluate: aBinaryBlock
<doNotGenerate>
^(aBinaryBlock value: annotation value: mcpc) ifTrue: [1] ifFalse: [0]!
Item was removed:
- ----- Method: ImageLeakChecker>>preBecomeAction (in category 'no-op overrides') -----
- preBecomeAction!
Item was added:
+ ----- Method: ImageLeakChecker>>preBecomeAction: (in category 'no-op overrides') -----
+ preBecomeAction: theBecomeEffectsFlags!
Item was removed:
- ----- Method: Interpreter class>>wantsLabels (in category 'translation') -----
- wantsLabels
- "Only label the VM, not plugins (internal or external). This to cut down the scope
- of problems with labels being duplicated by C compiler optimizer inlining and
- loop unrolling. We use the asmLabel: directive to control labelling in the
- interpreter proper. But it is too much work doing that for plugins too."
- ^true!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArrayBecome (in category 'object access primitives') -----
primitiveArrayBecome
+ "Invoke the two-way become primitive.
+ We must at least flush the method cache here, to eliminate stale references to mutated classes and/or selectors.
- "We must flush the method cache here, to eliminate stale references
- to mutated classes and/or selectors."
+ If in the CoInterpreter, we must deal with jitted methods being becommed. In the conception of the abstract VM,
+ unless a CompiledMethod is becommed to one with equivalent bytecode contexts referring to the becommed
+ method will likely fetch invalid bytecodes on resumption. The responsibility for validity here lies with the user of
+ the become primitive, not the VM. So one could imagine checking for methods becomming equivalent methods
+ and updating Cog methods to refer to their becommed duals. But that requires machinery to compare two
+ compiled methods to check if their code is equivalent. A much simpler approach, which also gets the VM to fail
+ in a less confusing place if it is going to fail because the programmer has not ensured compiled code validity
+ across become, is to simply divorce all frames and map context pcs back to bytecode pcs when becomming
+ jitted methods. However, mapping native pcs in contexts whose methods are flagged for become will not ensure
+ that pcs are mapped reliably. Consider this arc: a context on a method that has been jitted exists with a native pc.
+ The method is unjitted to make room for other methods to be jitted. The method is becommed. So the scan is only
+ effective for methods in the jit. Slowing down become so that a rare case may fail more comprehensibly, when its
+ going to fail anyway, is a waste of effort. So we do divorce frames (since machine code frames refer to CogMethods,
+ not methods), but don't scan the entire heap looking for native pcs in contexts. Hence the primitive must be
+ prepared to have its calling frame divorced. We store the context for the top frame in activeProcess.
+ BTW, as of late '22/early '23 this is only done for Spur.
+ See preBecomeAction: and postBecomeAction:"
+
| arg rcvr ec |
arg := self stackTop.
rcvr := self stackValue: 1.
ec := objectMemory become: rcvr with: arg twoWay: true copyHash: false.
+ self primitiveBecomeReturn: ec!
- ec = PrimNoErr
- ifTrue: [self pop: 1]
- ifFalse: [self primitiveFailFor: ec]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArrayBecomeOneWay (in category 'object access primitives') -----
primitiveArrayBecomeOneWay
+ "Invoke the one-way become primitive.
+ See the comment in primitiveArrayBecome for handling pervasive effects on method cacheing and jitting."
- "We must flush the method cache here, to eliminate stale references
- to mutated classes and/or selectors."
| arg rcvr ec |
arg := self stackTop.
rcvr := self stackValue: 1.
ec := objectMemory become: rcvr with: arg twoWay: false copyHash: true.
+ self primitiveBecomeReturn: ec!
- ec = PrimNoErr
- ifTrue: [self pop: 1]
- ifFalse: [self primitiveFailFor: ec]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArrayBecomeOneWayCopyHashArg (in category 'object access primitives') -----
primitiveArrayBecomeOneWayCopyHashArg
"Similar to primitiveArrayBecomeOneWay but accepts a third argument deciding whether to
+ copy the receiver's elements identity hashes over the argument's elements identity hashes.
+ See the comment in primitiveArrayBecome for handling pervasive effects on method cacheing and jitting."
- copy the receiver's elements identity hashes over the argument's elements identity hashes."
| copyHashFlag ec |
self stackTop = objectMemory trueObject
ifTrue: [copyHashFlag := true]
ifFalse:
[self stackTop = objectMemory falseObject
ifTrue: [copyHashFlag := false]
ifFalse:
[self primitiveFailFor: PrimErrBadArgument.
^nil]].
ec := objectMemory
become: (self stackValue: 2)
with: (self stackValue: 1)
twoWay: false
copyHash: copyHashFlag.
+ self primitiveBecomeReturn: ec!
- ec = PrimNoErr
- ifTrue: [self pop: argumentCount]
- ifFalse: [self primitiveFailFor: ec]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArrayBecomeOneWayNoCopyHash (in category 'object access primitives') -----
primitiveArrayBecomeOneWayNoCopyHash
"Similar to primitiveArrayBecomeOneWay but does /not/ copy the receiver's
+ elements identity hashes over the argument's elements identity hashes.
+ See the comment in primitiveArrayBecome for handling pervasive effects on method cacheing and jitting."
- elements identity hashes over the argument's elements identity hashes."
| arg rcvr ec |
arg := self stackTop.
rcvr := self stackValue: 1.
ec := objectMemory become: rcvr with: arg twoWay: false copyHash: false.
+ self primitiveBecomeReturn: ec!
- ec = PrimNoErr
- ifTrue: [self pop: 1]
- ifFalse: [self primitiveFailFor: ec]!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveBecomeReturn: (in category 'object access primitives') -----
+ primitiveBecomeReturn: ec
+ "Return from a become primitive after invoking become:with:twoWay:copyHash:.
+ This is a hook to allow the CoInterpreter to deal with potential divorce of the calling frame.
+ See the comment in primitiveArrayBecome."
+
+ <inline: #always>
+ ec = PrimNoErr
+ ifTrue: [self methodReturnReceiver]
+ ifFalse: [self primitiveFailFor: ec]!
Item was changed:
----- Method: NewObjectMemory>>become:with:twoWay:copyHash: (in category 'become') -----
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.
Returns PrimNoErr if the primitive succeeds."
"Implementation: Uses forwarding blocks to update references as done in compaction."
| start |
self runLeakCheckerFor: GCModeBecome.
(self isArray: array1) ifFalse:
[^PrimErrBadReceiver].
((self isArray: array2)
and: [(self lastPointerOf: array1) = (self lastPointerOf: array2)]) ifFalse:
[^PrimErrBadArgument].
(twoWayFlag or: [copyHashFlag])
ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]]
ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]].
(self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse:
[^PrimErrNoMemory]. "fail; not enough space for forwarding table"
(self allYoung: array1 and: array2)
ifTrue: [start := youngStart"sweep only the young objects plus the roots"]
ifFalse: [start := self startOfMemory"sweep all objects"].
+ coInterpreter preBecomeAction: 0.
- coInterpreter preBecomeAction.
self mapPointersInObjectsFrom: start to: freeStart.
twoWayFlag
ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2]
ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag].
coInterpreter postBecomeAction: 0.
self initializeMemoryFirstFree: freeStart. "re-initialize memory used for forwarding table"
self runLeakCheckerFor: GCModeBecome.
^PrimNoErr "success"!
Item was added:
+ ----- Method: NewObjectMemory>>sizeBitsOfAny: (in category 'object access') -----
+ sizeBitsOfAny: objOop
+ "Answer the number of bytes in the given object, including its base header, rounded up to an integral number of words."
+ "Note: byte indexable objects need to have low bits subtracted from this size."
+ <inline: #always>
+ ^self sizeBitsOf: objOop!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager class>>initializeSpurObjectRepresentationConstants (in category 'class initialization') -----
+ initializeSpurObjectRepresentationConstants
+ "SpurMemoryManager initializeSpurObjectRepresentationConstants"
+ super initializeSpurObjectRepresentationConstants.
+ BecameJittedCompiledMethodFlag := 16!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>becomeEffectFlagsFor: (in category 'become implementation') -----
+ becomeEffectFlagsFor: objOop
+ "Answer the appropriate become effect flags for objOop, or 0 if none.
+ The effect flags determine how much work is done after the become in following forwarding pointers,
+ voiding method caches, etc. Flag jitted methods because these will have to be freed after divorcing
+ frames and mapping native pcs to bytecode pcs in contexts using them.
+ See the comment in InterpreterPrimitives>>#primitiveArrayBecome"
+ <inline: false>
+ (self isPointersNonImm: objOop) ifTrue:
+ [| hash |
+ ((hash := self rawHashBitsOf: objOop) ~= 0
+ and: [(self classAtIndex: hash) = objOop]) ifTrue:
+ [^BecamePointerObjectFlag + BecameActiveClassFlag].
+ ^BecamePointerObjectFlag].
+ (self isCompiledMethod: objOop) ifTrue:
+ [| methodHeader |
+ methodHeader := coInterpreter rawHeaderOf: objOop.
+ (coInterpreter isCogMethodReference: methodHeader) ifTrue:
+ [cogit flagCogMethodForBecome: (self cCoerceSimple: methodHeader to: #'CogMethod *').
+ ^BecameCompiledMethodFlag + BecameJittedCompiledMethodFlag].
+ ^BecameCompiledMethodFlag].
+ ^0!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>doBecome:and:copyHash: (in category 'become implementation') -----
+ doBecome: obj1 and: obj2 copyHash: copyHashFlag
+ "Inner dispatch for two-way become.
+ Override to never do in-place become on CompiledCode objects.
+ N.B. At least in current two-way become use copyHashFlag is false."
+ | o1ClassIndex o2ClassIndex |
+ "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].
+
+ "Refuse to do an in-place become on classes since their being
+ forwarded is used in the flush method cache implementations.
+ Refuse to do an in-place become on compiled code because
+ doing so breaks the unmapping of methods from cog methods."
+ ((self numSlotsOf: obj1) = (self numSlotsOf: obj2)
+ and: [o1ClassIndex + o2ClassIndex = 0
+ and: [(self isCompiledMethod: obj1) not
+ and: [(self isCompiledMethod: obj2) not]]]) ifTrue:
+ [self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag.
+ ^self].
+ 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.
+ We leave the following until postBecomeScanClassTable:, but must
+ swap the forwarders if two active classes have been becommed,
+ and assign hashes if not."
+ o1ClassIndex ~= 0
+ ifTrue:
+ [o2ClassIndex ~= 0
+ ifTrue:
+ [self classAtIndex: o1ClassIndex put: obj2.
+ self classAtIndex: o2ClassIndex put: obj1]
+ ifFalse: "o2 wasn't in the table; set its hash"
+ [| newObj2 |
+ newObj2 := self followForwarded: obj1.
+ self assert: (self rawHashBitsOf: newObj2) = 0.
+ self setHashBitsOf: newObj2 to: o1ClassIndex]]
+ ifFalse:
+ [o2ClassIndex ~= 0 ifTrue: "o1 wasn't in the table; set its hash"
+ [| newObj1 |
+ newObj1 := self followForwarded: obj2.
+ self assert: (self rawHashBitsOf: newObj1) = 0.
+ self setHashBitsOf: newObj1 to: o2ClassIndex]]!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>validPostBecomeArrayContents: (in category 'become implementation') -----
+ validPostBecomeArrayContents: anArray
+ "Check that all compiled methods in anArray have valid headers; i.e. none are paired with CogMethods."
+
+ 0 to: (self numSlotsOf: anArray) - 1 do:
+ [:i| | objOop |
+ objOop := self fetchPointer: i ofObject: anArray.
+ ((self isOopCompiledMethod: objOop)
+ and: [coInterpreter methodHasCogMethod: objOop]) ifTrue:
+ [^false]].
+ ^true!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>zeroBecomeEffectFlagsOnFailure (in category 'become implementation') -----
+ zeroBecomeEffectFlagsOnFailure
+ "Set becomeEffectsFlags back to zero when containsOnlyValidBecomeObjects:and:twoWay:copyHash: answers failure.
+ Also unflag any jitted methods flagged for become if required."
+ <inline: #always>
+ (becomeEffectsFlags anyMask: BecameJittedCompiledMethodFlag) ifTrue:
+ [cogit unflagBecomeFlaggedMethods].
+ becomeEffectsFlags := 0!
Item was added:
+ ----- Method: Spur64BitCoMemoryManager class>>initializeSpurObjectRepresentationConstants (in category 'class initialization') -----
+ initializeSpurObjectRepresentationConstants
+ "SpurMemoryManager initializeSpurObjectRepresentationConstants"
+ super initializeSpurObjectRepresentationConstants.
+ BecameJittedCompiledMethodFlag := 16!
Item was added:
+ ----- Method: Spur64BitCoMemoryManager>>becomeEffectFlagsFor: (in category 'become implementation') -----
+ becomeEffectFlagsFor: objOop
+ "Answer the appropriate become effect flags for objOop, or 0 if none.
+ The effect flags determine how much work is done after the become in following forwarding pointers,
+ voiding method caches, etc. Flag jitted methods because these will have to be freed after divorcing
+ frames and mapping native pcs to bytecode pcs in contexts using them.
+ See the comment in InterpreterPrimitives>>#primitiveArrayBecome"
+ <inline: false>
+ (self isPointersNonImm: objOop) ifTrue:
+ [| hash |
+ ((hash := self rawHashBitsOf: objOop) ~= 0
+ and: [(self classAtIndex: hash) = objOop]) ifTrue:
+ [^BecamePointerObjectFlag + BecameActiveClassFlag].
+ ^BecamePointerObjectFlag].
+ (self isCompiledMethod: objOop) ifTrue:
+ [| methodHeader |
+ methodHeader := coInterpreter rawHeaderOf: objOop.
+ (coInterpreter isCogMethodReference: methodHeader) ifTrue:
+ [cogit flagCogMethodForBecome: (coInterpreter cCoerceSimple: methodHeader to: #'CogMethod *').
+ ^BecameCompiledMethodFlag + BecameJittedCompiledMethodFlag].
+ ^BecameCompiledMethodFlag].
+ ^0!
Item was added:
+ ----- Method: Spur64BitCoMemoryManager>>doBecome:and:copyHash: (in category 'become implementation') -----
+ doBecome: obj1 and: obj2 copyHash: copyHashFlag
+ "Inner dispatch for two-way become.
+ Override to never do in-place become on CompiledCode objects.
+ N.B. At least in current two-way become use copyHashFlag is false."
+ | o1Header o2Header o1ClassIndex o2ClassIndex |
+ "in-lined
+ classIndex := (self isInClassTable: obj) ifTrue: [self rawHashBitsOf: obj] ifFalse: [0]
+ for speed."
+ o1Header := self baseHeader: obj1.
+ o1ClassIndex := self rawHashBitsOfHeader: obj1.
+ (o1ClassIndex ~= 0 and: [(self classAtIndex: o1ClassIndex) ~= obj1]) ifTrue:
+ [o1ClassIndex := 0].
+ o2Header := self baseHeader: obj2.
+ o2ClassIndex := self rawHashBitsOfHeader: obj2.
+ (o2ClassIndex ~= 0 and: [(self classAtIndex: o2ClassIndex) ~= obj2]) ifTrue:
+ [o2ClassIndex := 0].
+
+ "Refuse to do an in-place become on classes since their being
+ forwarded is used in the flush method cache implementations.
+ Refuse to do an in-place become on compiled code because
+ doing so breaks the unmapping of methods from cog methods."
+ ((self numSlotsOf: obj1) = (self numSlotsOf: obj2)
+ and: [o1ClassIndex + o2ClassIndex = 0
+ and: [(self isCompiledMethodFormat: (self formatOfHeader: o1Header)) not
+ and: [(self isCompiledMethodFormat: (self formatOfHeader: o2Header)) not]]]) ifTrue:
+ [self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag.
+ ^self].
+ 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.
+ We leave the following until postBecomeScanClassTable:, but must
+ swap the forwarders if two active classes have been becommed,
+ and assign hashes if not."
+ o1ClassIndex ~= 0
+ ifTrue:
+ [o2ClassIndex ~= 0
+ ifTrue:
+ [self classAtIndex: o1ClassIndex put: obj2.
+ self classAtIndex: o2ClassIndex put: obj1]
+ ifFalse: "o2 wasn't in the table; set its hash"
+ [| newObj2 |
+ newObj2 := self followForwarded: obj1.
+ self assert: (self rawHashBitsOf: newObj2) = 0.
+ self setHashBitsOf: newObj2 to: o1ClassIndex]]
+ ifFalse:
+ [o2ClassIndex ~= 0 ifTrue: "o1 wasn't in the table; set its hash"
+ [| newObj1 |
+ newObj1 := self followForwarded: obj2.
+ self assert: (self rawHashBitsOf: newObj1) = 0.
+ self setHashBitsOf: newObj1 to: o2ClassIndex]]!
Item was added:
+ ----- Method: Spur64BitCoMemoryManager>>zeroBecomeEffectFlagsOnFailure (in category 'become implementation') -----
+ zeroBecomeEffectFlagsOnFailure
+ "Set becomeEffectsFlags back to zero when containsOnlyValidBecomeObjects:and:twoWay:copyHash: answers failure.
+ Also unflag any jitted methods flagged for become if required."
+ <inline: #always>
+ (becomeEffectsFlags anyMask: BecameJittedCompiledMethodFlag) ifTrue:
+ [cogit unflagBecomeFlaggedMethods].
+ becomeEffectsFlags := 0!
Item was changed:
----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
allInstancesOf: aClass
"Attempt to answer an array of all objects, excluding those that may
be garbage collected as a side effect of allocating the result array.
If no memory is available answer the number of instances as a SmallInteger.
Since objects are at least 16 bytes big, and the largest SmallInteger covers
1/4 of the address space, the count can never overflow."
| classIndex freeChunk ptr start limit count bytes |
classIndex := self rawHashBitsOf: aClass.
classIndex = 0 ifTrue:
[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
^freeChunk].
MarkObjectsForEnumerationPrimitives ifTrue:
[self markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
(self isClassAtUniqueIndex: aClass)
ifTrue:
[self uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]]
ifFalse:
[self ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]].
self assert: (self isEmptyObjStack: markStack).
MarkObjectsForEnumerationPrimitives
ifTrue:
[self assert: self allObjectsUnmarked.
self emptyObjStack: weaklingStack]
ifFalse:
[self assert: (self isEmptyObjStack: weaklingStack)].
(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 bytesInBody: freeChunk) at: (self startOfObject: freeChunk). "N.B. Does /not/ update totalFreeOldSpace"
+ self checkFreeSpace: GCModeFull.
- [self freeObject: freeChunk.
^self integerObjectOf: count].
count < self numSlotsMask ifTrue:
[| smallObj |
smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
0 to: count - 1 do:
[:i|
self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofFreeChunk: freeChunk)].
+ self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk). "N.B. Does /not/ update totalFreeOldSpace"
- self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
self beRootIfOld: smallObj.
self checkFreeSpace: GCModeFull.
^smallObj].
bytes := self largeObjectBytesForSlots: count.
start := self startOfObject: freeChunk.
self freeChunkWithBytes: limit - start - bytes at: start + bytes.
totalFreeOldSpace := totalFreeOldSpace - bytes.
self rawOverflowSlotsOf: freeChunk put: count.
self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
self possibleRootStoreInto: freeChunk.
self checkFreeSpace: GCModeFull.
self runLeakCheckerFor: GCModeFull.
^freeChunk!
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."
<inline: false>
| ec |
self assert: becomeEffectsFlags = 0.
self runLeakCheckerFor: GCModeBecome.
(self isArray: array1) ifFalse:
[^PrimErrBadReceiver].
((self isArray: array2)
and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) ifFalse:
[^PrimErrBadArgument].
ec := self containsOnlyValidBecomeObjects: array1 and: array2 twoWay: twoWayFlag copyHash: copyHashFlag.
ec ~= 0 ifTrue:
+ [self zeroBecomeEffectFlagsOnFailure.
- [becomeEffectsFlags := 0.
^ec].
+ coInterpreter preBecomeAction: becomeEffectsFlags.
- coInterpreter preBecomeAction.
twoWayFlag
+ ifTrue: [self innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag]
+ ifFalse: [self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
- ifTrue:
- [self innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag]
- ifFalse:
- [self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
self followSpecialObjectsOop.
"N.B. perform coInterpreter's postBecomeAction: *before* postBecomeScanClassTable:
to allow the coInterpreter to void method cache entries by spotting classIndices that
refer to forwarded objects. postBecomeScanClassTable: follows forwarders in the table."
coInterpreter postBecomeAction: becomeEffectsFlags.
self postBecomeScanClassTable: becomeEffectsFlags.
- becomeEffectsFlags := 0.
+ twoWayFlag
+ ifTrue:
+ [self assert: (self validPostBecomeArrayContents: array1).
+ self assert: (self validPostBecomeArrayContents: array2)]
+ ifFalse:
+ [self assert: (self validPostBecomeArrayContents: array2)].
+
self assert: self validClassTableHashes.
self runLeakCheckerFor: GCModeBecome.
+ self zeroBecomeEffectFlagsOnSuccess.
+
^PrimNoErr "success"!
Item was changed:
----- Method: SpurMemoryManager>>bytesLeft: (in category 'free space') -----
bytesLeft: includeSwapSpace
"Answer the amount of available free space. If includeSwapSpace is true, include
possibly available swap space. If includeSwapSpace is false, include possibly available
physical memory. N.B. includeSwapSpace is ignored; answer total heap free space
+ minus the reserve available for flushing the stack zone."
- minus the reserve available for flushing the tsack zone."
^totalFreeOldSpace
+ + (scavengeThreshold - freeStart)
+ - coInterpreter interpreterAllocationReserveBytes max: 0!
- + (scavenger eden limit - freeStart)
- + (scavenger pastSpace limit - pastSpaceStart)
- + (scavenger futureSpace limit - scavenger futureSpace limit)
- - coInterpreter interpreterAllocationReserveBytes!
Item was changed:
----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects:and:twoWay:copyHash: (in category 'become implementation') -----
containsOnlyValidBecomeObjects: array1 and: array2 twoWay: isTwoWay copyHash: copyHash
"Answer 0 if neither array contains an object inappropriate for the become operation.
Otherwise answer an informative error code for the first offending object found:
Can't become: immediates => PrimErrInappropriate
Shouldn't become pinned objects => PrimErrObjectIsPinned.
Shouldn't become immutable objects => PrimErrNoModification.
Can't copy hash into immediates => PrimErrInappropriate.
Two-way become may require memory to create copies => PrimErrNoMemory.
As a side-effect unforward any forwarders in the two arrays if answering 0."
<inline: true>
+ | fieldOffset oop1 oop2 size |
- | fieldOffset effectsFlags oop1 oop2 size |
fieldOffset := self lastPointerOf: array1.
+ size := 0.
- effectsFlags := size := 0.
"array1 is known to be the same size as array2"
[fieldOffset >= self baseHeaderSize] whileTrue:
[oop1 := self longAt: array1 + fieldOffset.
(self isOopForwarded: oop1) ifTrue:
[oop1 := self followForwarded: oop1.
self longAt: array1 + fieldOffset put: oop1].
self ifOopInvalidForBecome: oop1 errorCodeInto: [:errCode| ^errCode].
oop2 := self longAt: array2 + fieldOffset.
(self isOopForwarded: oop2) ifTrue:
[oop2 := self followForwarded: oop2.
self longAt: array2 + fieldOffset put: oop2].
oop1 ~= oop2 ifTrue:
[isTwoWay
ifTrue:
[self ifOopInvalidForBecome: oop2 errorCodeInto: [:errCode| ^errCode].
size := size + (self bytesInBody: oop1) + (self bytesInBody: oop2).
+ becomeEffectsFlags := (becomeEffectsFlags
+ bitOr: (self becomeEffectFlagsFor: oop1))
+ bitOr: (self becomeEffectFlagsFor: oop2)]
- effectsFlags := (effectsFlags
- bitOr: (self becomeEffectFlagsFor: oop1))
- bitOr: (self becomeEffectFlagsFor: oop2)]
ifFalse:
[copyHash ifTrue:
[(self isImmediate: oop2) ifTrue:
[^PrimErrInappropriate].
(self isObjImmutable: oop2) ifTrue:
[^PrimErrNoModification]].
+ becomeEffectsFlags := becomeEffectsFlags bitOr: (self becomeEffectFlagsFor: oop1)]].
- effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop1)]].
fieldOffset := fieldOffset - self bytesPerOop].
size >= (totalFreeOldSpace + (scavengeThreshold - freeStart)) ifTrue:
+ [^PrimErrNoMemory halt].
- [^PrimErrNoMemory].
- "only set flags after checking all args."
- becomeEffectsFlags := effectsFlags.
^0!
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."
| o1ClassIndex o2ClassIndex |
"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].
"Refuse to do an in-place become on classes since their being
forwarded is used in the flush method cache implementations."
((self numSlotsOf: obj1) = (self numSlotsOf: obj2)
+ and: [o1ClassIndex + o2ClassIndex = 0]) ifTrue:
- and: [o1ClassIndex = 0
- and: [o2ClassIndex = 0]]) ifTrue:
[self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag.
^self].
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.
We leave the following until postBecomeScanClassTable:, but must
swap the forwarders if two active classes have been becommed,
and assign hashes if not."
o1ClassIndex ~= 0
ifTrue:
[o2ClassIndex ~= 0
ifTrue:
[self classAtIndex: o1ClassIndex put: obj2.
self classAtIndex: o2ClassIndex put: obj1]
ifFalse: "o2 wasn't in the table; set its hash"
[| newObj2 |
newObj2 := self followForwarded: obj1.
self assert: (self rawHashBitsOf: newObj2) = 0.
self setHashBitsOf: newObj2 to: o1ClassIndex]]
ifFalse:
[o2ClassIndex ~= 0 ifTrue: "o1 wasn't in the table; set its hash"
[| newObj1 |
newObj1 := self followForwarded: obj2.
self assert: (self rawHashBitsOf: newObj1) = 0.
self setHashBitsOf: newObj1 to: o2ClassIndex]]!
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 halt].
- [^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).
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>>formatOfHeader: (in category 'header access') -----
- ----- Method: SpurMemoryManager>>formatOfHeader: (in category 'object access') -----
formatOfHeader: header
"0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 unused, reserved for exotic pointer objects?
7 Forwarded Object, 1st field is pointer, rest of fields are ignored
8 unused, reserved for exotic non-pointer objects?
9 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
<var: 'header' type: #usqLong>
^header >> self formatShift bitAnd: self formatMask!
Item was added:
+ ----- Method: SpurMemoryManager>>rawHashBitsOfHeader: (in category 'header access') -----
+ rawHashBitsOfHeader: header
+ <var: 'header' type: #usqLong>
+ ^header >> self identityHashFullWordShift bitAnd: self identityHashHalfWordMask!
Item was changed:
+ ----- Method: SpurMemoryManager>>rawNumSlotsOf: (in category 'header access') -----
- ----- Method: SpurMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
rawNumSlotsOf: objOop
<returnTypeC: #usqInt>
<inline: true>
self flag: #endian.
^self byteAt: objOop + 7!
Item was changed:
+ ----- Method: SpurMemoryManager>>rawNumSlotsOf:put: (in category 'header access') -----
- ----- Method: SpurMemoryManager>>rawNumSlotsOf:put: (in category 'object access') -----
rawNumSlotsOf: objOop put: aByte
<returnTypeC: #usqInt>
<inline: true>
self flag: #endian.
^self byteAt: objOop + 7 put: aByte!
Item was added:
+ ----- Method: SpurMemoryManager>>sizeBitsOfAny: (in category 'object access') -----
+ sizeBitsOfAny: objOop
+ "Answer the number of bytes in the given object, including its base header, rounded up to an integral number of words.
+ Unlike sizeBitsOf:, accept forwarded objects."
+ "Note: byte indexable objects need to have low bits subtracted from this size to find the address beyond the last byte."
+ ^(self numSlotsOfAny: objOop) << self shiftForWord + self baseHeaderSize!
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: GCCheckImageSegment.
"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].
"If objectsReachableFromRoots: answers an integer there is not enough continuous free space in which to allocate the
reachable objects. If there is sufficient free space then answer an error code to prompt a compacting GC and a retry."
(self isIntegerObject: arrayOfObjects) ifTrue:
[totalFreeOldSpace - self allocationUnit >= (self integerValueOf: arrayOfObjects) ifTrue:
[^PrimErrNeedCompaction].
+ ^PrimErrNoMemory halt].
- ^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 noInlineAllocateSlots: (self numSlotsOf: arrayOfObjects)
format: self wordIndexableFormat
classIndex: self wordSizeClassIndexPun.
savedOutHashes := self noInlineAllocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4)
format: self firstLongFormat
classIndex: self thirtyTwoBitLongsClassIndexPun.
(savedFirstFields isNil or: [savedOutHashes isNil]) ifTrue:
[self freeObject: arrayOfObjects.
(savedFirstFields notNil and: [self isInOldSpace: savedFirstFields]) ifTrue:
[self freeObject: savedFirstFields].
(savedOutHashes notNil and: [self isInOldSpace: savedOutHashes]) ifTrue:
[self freeObject: savedOutHashes].
+ ^PrimErrNoMemory halt].
- ^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 addressable. 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
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>>validPostBecomeArrayContents: (in category 'become implementation') -----
+ validPostBecomeArrayContents: anArray
+ "This is a hook for the CoMemoryManagers to check for valid compiled code.
+ It is a noop here."
+
+ ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>zeroBecomeEffectFlagsOnFailure (in category 'become implementation') -----
+ zeroBecomeEffectFlagsOnFailure
+ "Set becomeEffectsFlags back to zero when containsOnlyValidBecomeObjects:and:twoWay:copyHash: answers failure.
+ This is a hook that allows the CoMemoryManagers to reset cog methods that have been flagged as CMMethodFlaggedForBecome."
+ <inline: #always>
+ becomeEffectsFlags := 0!
Item was added:
+ ----- Method: SpurMemoryManager>>zeroBecomeEffectFlagsOnSuccess (in category 'become implementation') -----
+ zeroBecomeEffectFlagsOnSuccess
+ "Set becomeEffectsFlags back to zero at the end of a become."
+ <inline: #always>
+ becomeEffectsFlags := 0!
Item was removed:
- ----- Method: StackInterpreter class>>macroBenchmark (in category 'benchmarks') -----
- macroBenchmark "StackInterpreter macroBenchmark"
- | dir |
- dir := 'benchmark2.dir'.
- (FileDirectory default directoryExists: dir)
- ifTrue: [(FileDirectory default directoryNamed: dir) recursiveDeleteContents]
- ifFalse: [(FileDirectory default directoryNamed: dir) assureExistence].
- ([VMMaker
- makerFor: StackInterpreter
- and: nil
- with: #()
- to: (FileDirectory default pathFromURI: dir)
- platformDir: 'none'
- excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])]
- on: VMMakerException "suppress bleats about non-existent platforms dir"
- do: [:ex| ex resume: nil])
- generateInterpreterFile.
- (FileDirectory default directoryNamed: dir) recursiveDeleteContents; recursiveDelete!
Item was removed:
- ----- Method: StackInterpreter class>>patchInterpGCCPPC: (in category 'translation') -----
- patchInterpGCCPPC: fileName
- "Interpreter patchInterpGCCPPC: 'Squeak copy 1'"
- "This will patch out the unneccesary range check (a compare
- and branch) in the inner interpreter dispatch loop. for the PPC version of the GCC compiled
- version of Squeak under MPW"
- "NOTE: You must edit in the Interpeter file name"
-
- | delta f code len remnant i |
- delta := 7.
- f := FileStream fileNamed: fileName.
- f binary.
- code := Bitmap new: (len := f size) // 4.
- f nextInto: code.
- remnant := f next: len - (code size * 4).
- i := 0.
- ["Look for a BCTR instruction"
- (i := code indexOf: 16r4E800420 startingAt: i + 1 ifAbsent: [0]) > 0] whileTrue:
- ["Look for a CMPLWI cr1,rxx,FF, 7 instrs back"
- ((code at: i - delta) bitAnd: 16rFFE0FFFF) = 16r288000FF ifTrue:
- ["Copy dispatch instrs back over the compare"
- self inform: 'Patching at ', i hex.
- 0 to: delta - 2 do: [ :j |
- code at: (i - delta) + j put: (code at: (i - delta) + j + 2)]]].
- f position: 0; nextPutAll: code; nextPutAll: remnant.
- f close!
Item was removed:
- ----- Method: StackInterpreter class>>wantsLabels (in category 'translation') -----
- wantsLabels
- "Only label the VM, not plugins (internal or external). This to cut down the scope
- of problems with labels being duplicated by C compiler optimizer inlining and
- loop unrolling. We use the asmLabel: directive to control labelling in the
- interpreter proper. But it is too much work doing that for plugins too."
- ^true!
Item was changed:
----- Method: StackInterpreter>>findMethodWithPrimitive:FromContext:UpToContext: (in category 'handler search') -----
findMethodWithPrimitive: primitive FromContext: senderContext UpToContext: homeContext
"See findUnwindThroughContext:. Alas this is mutually recursive with
findMethodWithPrimitive:FromFP:SP:ThroughContext: instead of iterative.
We're doing the simplest thing that could possibly work. Niceties can wait."
<inline: false>
<returnTypeC: #sqInt> "Being mutually-recursive with findMethodWithPrimitive:FromFP:UpToContext: gives the author's type inference algorithm headaches. Wimp out by declaring the return type."
| theContext theMethod |
self assert: (senderContext = objectMemory nilObject or: [objectMemory isContext: senderContext]).
self assert: (homeContext = objectMemory nilObject or: [objectMemory isContext: homeContext]).
theContext := senderContext.
[theContext = objectMemory nilObject ifTrue:
[^theContext].
self isMarriedOrWidowedContext: theContext] whileFalse:
[theContext = homeContext ifTrue: [^0].
(primitive = 0
or: [(objectMemory fetchPointer: ClosureIndex ofObject: theContext) ~= objectMemory nilObject]) ifFalse:
+ [theMethod := objectMemory followObjField: MethodIndex ofObject: theContext.
- [theMethod := objectMemory fetchPointer: MethodIndex ofObject: theContext.
(self primitiveIndexOf: theMethod) = primitive ifTrue:
[^theContext]].
+ theContext := objectMemory followObjField: SenderIndex ofObject: theContext].
- theContext := objectMemory fetchPointer: SenderIndex ofObject: theContext].
(self isWidowedContext: theContext) ifTrue:
[^objectMemory nilObject].
^self
findMethodWithPrimitive: primitive
FromFP: (self frameOfMarriedContext: theContext)
UpToContext: homeContext!
Item was changed:
----- Method: StackInterpreter>>findSelectorOfMethod: (in category 'debug support') -----
findSelectorOfMethod: meth
| classObj classDict classDictSize methodArray i |
(objectMemory addressCouldBeObj: meth) ifFalse:
[^objectMemory nilObject].
(objectMemory isForwarded: meth) ifTrue:
[^self findSelectorOfMethod: (objectMemory followForwarded: meth)].
(objectMemory isOopCompiledMethod: meth) ifFalse:
[^objectMemory nilObject].
(self maybeSelectorOfMethod: meth) ifNotNil:
[:selector| ^selector].
classObj := self safeMethodClassOf: meth.
(self addressCouldBeClassObj: classObj) ifTrue:
+ [classDict := objectMemory noFixupFollowField: MethodDictionaryIndex ofObject: classObj.
- [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: classObj.
classDictSize := objectMemory numSlotsOf: classDict.
classDictSize > MethodArrayIndex ifTrue:
+ [methodArray := objectMemory noFixupFollowField: MethodArrayIndex ofObject: classDict.
- [methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue:
+ [meth = (objectMemory noFixupFollowField: i ofObject: methodArray) ifTrue:
+ [^(objectMemory noFixupFollowField: i + SelectorStart ofObject: classDict)].
- [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
- [^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)].
i := i + 1]]].
^objectMemory nilObject!
Item was changed:
----- Method: StackInterpreter>>flushBecommedClassesInMethodCache (in category 'object memory support') -----
flushBecommedClassesInMethodCache
"Flush any entries in the cache which refer to a forwarded (becommed) class."
+ <option: #SpurObjectMemory>
0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
[:i | | c s |
c := methodCache at: i + MethodCacheClass.
s := methodCache at: i + MethodCacheSelector.
(c ~= 0 and: [s ~= 0
and: [objectMemory isForwarded: (objectMemory classOrNilAtIndex: c)]]) ifTrue:
[methodCache
at: i + MethodCacheClass put: 0;
+ at: i + MethodCacheSelector put: 0]]!
- at: i + MethodCacheSelector put: 0]].
- self flushAtCache!
Item was removed:
- ----- Method: StackInterpreter>>flushBecommedClassesInMethodZone (in category 'object memory support') -----
- flushBecommedClassesInMethodZone
- "This is just a stub for the CoInterpreter"!
Item was removed:
- ----- Method: StackInterpreter>>followForwardedMethodsInMethodZone (in category 'object memory support') -----
- followForwardedMethodsInMethodZone
- "This is just a stub for the CoInterpreter"!
Item was changed:
----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
followForwardingPointersInStackZone: theBecomeEffectsFlags
"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
probe, since notionally objects' internals are accessed only via sending messages to them,
the exception is primitives that access the internals of the non-receiver argument(s).
To avoid a read barrier on bytecode, literal and inst var fetch and non-local return, we scan
the receivers (including the stacked receiver for non-local return) and method references
in the stack zone and follow any forwarded ones. This is of course way cheaper than
scanning all of memory as in the old become."
| theIPPtr |
<inline: false>
- (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
- [(objectMemory isForwarded: method) ifTrue:
- [theIPPtr := instructionPointer - method.
- method := objectMemory followForwarded: method.
- instructionPointer := method + theIPPtr].
- (objectMemory isOopForwarded: newMethod) ifTrue:
- [newMethod := objectMemory followForwarded: newMethod]].
-
stackPage ifNil: "the system must be snapshotting; nothing to do..."
[self assert: (stackPages mostRecentlyUsedPage isNil or: [stackPages mostRecentlyUsedPage isFree]).
self cCode: [] inSmalltalk: [self assert: stackPages allPagesFree].
^self].
self externalWriteBackHeadFramePointers.
0 to: numStackPages - 1 do:
[:i| | thePage theFP callerFP offset oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
theIPPtr := thePage = stackPage ifFalse: [thePage headSP asUnsignedInteger].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr isNil or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
oop := stackPages longAt: theFP + FoxReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxReceiver
put: (objectMemory followForwarded: oop)].
((self frameHasContext: theFP)
and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory followForwarded: (self frameContext: theFP))].
oop := self frameMethod: theFP.
(objectMemory isForwarded: oop) ifTrue:
[| newOop delta |
newOop := objectMemory followForwarded: oop.
theIPPtr ifNotNil:
[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
delta := newOop - oop.
stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + delta].
stackPages
longAt: theFP + FoxMethod
put: (oop := newOop)].
offset := self frameStackedReceiverOffset: theFP.
oop := stackPages longAt: theFP + offset.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + offset
put: (objectMemory followForwarded: oop)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
theFP := callerFP].
"And finally follow the caller context."
self assert: theFP = thePage baseFP.
oop := self frameCallerContext: theFP.
(objectMemory isForwarded: oop) ifTrue:
[self frameCallerContext: theFP put: (objectMemory followForwarded: oop)]]]!
Item was added:
+ ----- Method: StackInterpreter>>followMethodNewMethodAndInstructionPointer (in category 'object memory support') -----
+ followMethodNewMethodAndInstructionPointer
+ "c.f. mapVMRegisters"
+ <inline: #always>
+ | ipdelta |
+ (objectMemory isForwarded: method) ifTrue:
+ [ipdelta := (self method: method includesAddress: instructionPointer) ifTrue:
+ [instructionPointer - method].
+ method := objectMemory followForwarded: method.
+ ipdelta ifNotNil:
+ [instructionPointer := method + ipdelta]].
+ (objectMemory isOopForwarded: newMethod) ifTrue:
+ [ipdelta := (self method: newMethod includesAddress: instructionPointer) ifTrue:
+ [instructionPointer - newMethod].
+ newMethod := objectMemory followForwarded: newMethod].
+ ipdelta ifNotNil:
+ [instructionPointer := newMethod + ipdelta]!
Item was changed:
----- Method: StackInterpreter>>mapVMRegisters (in category 'object memory support') -----
mapVMRegisters
"Map the oops in the interpreter's vm ``registers'' to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops.
N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
only during message lookup and because createActualMessageTo will not
+ cause a GC these cannot change during message lookup.
+ c.f. followMethodNewMethodAndInstructionPointer"
+ | ipdelta |
- cause a GC these cannot change during message lookup."
(objectMemory shouldRemapObj: method) ifTrue:
+ [ipdelta := (self method: method includesAddress: instructionPointer) ifTrue:
+ [instructionPointer - method].
- [instructionPointer := instructionPointer - method. "*rel to method"
method := objectMemory remapObj: method.
+ ipdelta ifNotNil:
+ [instructionPointer := method + ipdelta]].
- instructionPointer := instructionPointer + method]. "*rel to method"
(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
+ [ipdelta := (self method: newMethod includesAddress: instructionPointer) ifTrue:
+ [instructionPointer - newMethod].
+ newMethod := objectMemory remapObj: newMethod.
+ ipdelta ifNotNil:
+ [instructionPointer := newMethod + ipdelta]]!
- [newMethod := objectMemory remapObj: newMethod]!
Item was added:
+ ----- Method: StackInterpreter>>method:includesAddress: (in category 'utilities') -----
+ method: aMethodAddress includesAddress: anAddress
+ "Used to test for instructionPointer being within method and/or newMethod, which are all usqInt.
+ N.B. Not reliable to use on sqInt typed variables!!!!"
+ <inline: #always>
+ ^(anAddress > aMethodAddress and: [anAddress < (aMethodAddress + (objectMemory sizeBitsOfAny: aMethodAddress))])!
Item was removed:
- ----- Method: StackInterpreter>>preBecomeAction (in category 'object memory support') -----
- preBecomeAction
- "Need to write back the frame pointers unless all pages are free (as in snapshot)"
- stackPage ifNotNil:
- [self externalWriteBackHeadFramePointers]!
Item was added:
+ ----- Method: StackInterpreter>>preBecomeAction: (in category 'object memory support') -----
+ preBecomeAction: theBecomeEffectsFlags
+ "Need to write back the frame pointers unless all pages are free (as in snapshot)"
+ stackPage ifNotNil:
+ [self externalWriteBackHeadFramePointers]!
Item was changed:
----- Method: StackInterpreter>>spurPostBecomeAction: (in category 'object memory support') -----
spurPostBecomeAction: theBecomeEffectsFlags
"Insulate the stack zone from the effects of a become.
All receivers must be unfollowed for two reasons:
1. inst var access is direct with no read barrier
2. super sends (always to the receiver) have no class check and so don't trap
for forwarded receivers. This is an issue for primitives that assume their receiver
is valid and don't validate.
Super sends require an explicit check to ensure receivers in super sends are unforwarded.
e.g. super doSomethingWith: (self become: other) forwards the receiver self pushed on the
stack. So we could avoid following non-pointer receivers. But this is too tricky, Instead, we
always follow receivers.
Methods must be unfollowed since bytecode access is direct with no read barrier.
But this only needs to be done if the becomeEffectsFlags indicate that a
CompiledMethod was becommed.
The scheduler state must be followed, but only if the becomeEffectsFlags indicate
that a pointer object was becommed."
<option: #SpurObjectMemory>
<inline: false> "For VM profiling"
self flushAtCache.
theBecomeEffectsFlags ~= 0 ifTrue:
+ [(theBecomeEffectsFlags anyMask: BecameActiveClassFlag) ifTrue:
+ [self flushBecommedClassesInMethodCache].
- [(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
- [self followForwardedMethodsInMethodCache.
- self followForwardedMethodsInMethodZone]. "for CoInterpreter; must precede followForwardingPointersInStackZone:"
- (theBecomeEffectsFlags anyMask: BecameActiveClassFlag) ifTrue:
- [self flushBecommedClassesInMethodCache.
- self flushBecommedClassesInMethodZone]. "for CoInterpreter"
(theBecomeEffectsFlags anyMask: BecamePointerObjectFlag) ifTrue:
[self followForwardingPointersInScheduler.
self followForwardingPointersInSpecialObjectsArray].
(theBecomeEffectsFlags anyMask: BecamePointerObjectFlag + BecameCompiledMethodFlag) ifTrue:
+ [self followForwardingPointersInProfileState.
+ (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
+ [self followForwardedMethodsInMethodCache.
+ self followMethodNewMethodAndInstructionPointer]]].
- [self followForwardingPointersInProfileState]].
self followForwardingPointersInStackZone: theBecomeEffectsFlags!
Item was removed:
- ----- Method: StackInterpreterSimulator>>preBecomeAction (in category 'object memory support') -----
- preBecomeAction
- "((objectMemory instVarNamed: 'becomeEffectsFlags') anyMask: BecameCompiledMethodFlag) ifTrue:
- [self halt]."
- super preBecomeAction!
Item was changed:
VMObjectProxy subclass: #VMCompiledMethodProxy
instanceVariableNames: 'size numLiterals literals'
classVariableNames: ''
+ poolDictionaries: 'VMObjectIndices'
- poolDictionaries: ''
category: 'VMMaker-Support'!
!VMCompiledMethodProxy commentStamp: 'eem 8/6/2014 14:48' prior: 0!
A VMCompiledMethodProxy is a wrapper for the oop of a CompiledMethod object in the simulator VM's heap that provides accessd to the oop as if it were a CompiledMethod object.!
Item was added:
+ ----- Method: VMCompiledMethodProxy>>methodClass (in category 'accessing') -----
+ methodClass
+ "Answer the methodClass oop or nil."
+ | methodClassAssociation |
+ methodClassAssociation := coInterpreter methodClassAssociationOf: oop.
+ ^((objectMemory isPointers: methodClassAssociation)
+ and: [(objectMemory numSlotsOf: methodClassAssociation) > ValueIndex]) ifTrue:
+ [objectMemory fetchPointer: ValueIndex ofObject: methodClassAssociation]!
Item was changed:
VMBasicConstants subclass: #VMSpurObjectRepresentationConstants
instanceVariableNames: ''
+ classVariableNames: 'BecameActiveClassFlag BecameCompiledMethodFlag BecameJittedCompiledMethodFlag BecamePointerObjectFlag OldBecameNewFlag SpurPrimitiveAccessorDepthShift SpurPrimitiveFlagsMask'
- classVariableNames: 'BecameActiveClassFlag BecameCompiledMethodFlag BecamePointerObjectFlag OldBecameNewFlag SpurPrimitiveAccessorDepthShift SpurPrimitiveFlagsMask'
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
2
1